调用 AddConnection() 进行拨号连接,拨号过程调用代码谁提供
Option Explicit

Public hRasConn As Long '定义一个指向RAS调用的全局句柄
Public Const APINULL = 0&
Public Const UNLEN = 256
Public Const DNLEN = 15
Public Const PWLEN = 256
Public Const RAS95_MaxPhoneNumber = 128
Public Const RAS95_MaxEntryName = 256
Private Const RAS_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 128
Public Const RAS95_MaxCallbackNumber = RAS95_MaxPhoneNumber
Public Type RASCONN95
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Type RASENTRYNAME95
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type
Public Type RASDIALPARAMS95
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szPhoneNumber(RAS95_MaxPhoneNumber) As Byte
    szCallbackNumber(RAS95_MaxCallbackNumber) As Byte
    szUserName(UNLEN) As Byte
    szPassword(PWLEN) As Byte
    szDomain(DNLEN) As Byte
End Type
'**********************************
'* RAS调用错误代号 *
'**********************************
Public Const NOT_SUPPORTED = 120&
Public Const RASBASEERROR = 600&
Public Const SUCCESS = 0&
Public Const ERROR_PORT_ALREADY_OPEN = (RASBASEERROR + 2)
Public Const ERROR_UNKNOWN = (RASBASEERROR + 35)
Public Const ERROR_REQUEST_TIMEOUT = (RASBASEERROR + 38)
Public Const ERROR_PASSWD_EXPIRED = (RASBASEERROR + 48)
Public Const ERROR_NO_DIALIN_PERMISSION = (RASBASEERROR + 49)
Public Const ERROR_SERVER_NOT_RESPONDING = (RASBASEERROR + 50)
Public Const ERROR_UNRECOGNIZED_RESPONSE = (RASBASEERROR + 52)
Public Const ERROR_NO_RESPONSES = (RASBASEERROR + 60)
Public Const ERROR_DEVICE_NOT_READY = (RASBASEERROR + 66)
Public Const ERROR_LINE_BUSY = (RASBASEERROR + 76)
Public Const ERROR_NO_ANSWER = (RASBASEERROR + 78)
Public Const ERROR_NO_CARRIER = (RASBASEERROR + 79)
Public Const ERROR_NO_DIALTONE = (RASBASEERROR + 80)
Public Const ERROR_AUTHENTICATION_FAILURE = (RASBASEERROR + 91)
Public Const ERROR_PPP_TIMEOUT = (RASBASEERROR + 118)
'**********************************
'* RAS连接状态声明 *
'**********************************
Enum RasConnState
    RASCS_OpenPort = 0
    RASCS_PortOpened             '1
    RASCS_ConnectDevice          '2
    RASCS_DeviceConnected        '3
    RASCS_AllDevicesConnected    '4
    RASCS_Authenticate           '5
    RASCS_AuthNotify             '6
    RASCS_AuthRetry
    RASCS_AuthCallback
    RASCS_AuthChangePassword
    RASCS_AuthProject
    RASCS_AuthLinkSpeed
    RASCS_AuthAck
    RASCS_ReAuthenticate
    RASCS_Authenticated
    RASCS_PrepareForCallback
    RASCS_WaitForModemReset
    RASCS_WaitForCallback
    RASCS_Projected
    RASCS_StartAuthentication  '19
    RASCS_CallbackComplete
    RASCS_LogonNetwork         '21
    RASCS_Interactive = &H1000
    RASCS_RetryAuthentication
    RASCS_CallbackSetByCaller
    RASCS_PasswordExpired
    RASCS_Connected = &H2000
    RASCS_Disconnected
End Enum
'**********************************
'* RAS API 声明 *
'**********************************
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, ByVal lpString2 As String) As Long
Public Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (lpRasDialExtensions As Any, ByVal lpszPhonebook As String, lprasdialparams As Any, ByVal dwNotifierType As Long, ByVal lpvNotifier As Long, lphRasConn As Long) As Long
Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

'Sleep
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function AddConnection(strNewEntryName As String, strNewPhoneNumber As String, strNewCallbackNumber As String, strNewUsername As String, strNewPassword As String, strNewDomain As String) As Integer

    Dim lngRetCode As Long
    Dim lngRetLstrcpy As Long
    Dim lngRetHangUp As Long
    Dim lprasdialparams As RASDIALPARAMS95
    lprasdialparams.dwSize = 1052 '在WINDOWS95/98中必须将dwSize设为1052
    '利用lstrcpy函数将字符串拷贝到BYTE数组
    lngRetLstrcpy = lstrcpy(lprasdialparams.szEntryName(0), strNewEntryName)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szPhoneNumber(0), strNewPhoneNumber)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szCallbackNumber(0), strNewCallbackNumber)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szUserName(0), strNewUsername)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szPassword(0), strNewPassword)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szDomain(0), strNewDomain)
    '我们使用异步通信
     
    Screen.MousePointer = vbHourglass '改变鼠标样式
     
        hRasConn = 0 '
        DoEvents
            lngRetCode = RasDial(ByVal APINULL, vbNullString, lprasdialparams, 0, AddressOf RasDialFunc, hRasConn) '异步通信
            'lngRetCode = RasDial(ByVal APINULL, vbNullString, lprasdialparams, APINULL, ByVal APINULL, hRasConn)
        DoEvents
     
    Screen.MousePointer = vbDefault '改变鼠标样式
     
    '测试有没有错误
    If lngRetCode Then
        lngRetHangUp = RasHangUp(hRasConn)
    End If
    AddConnection = lngRetCode
End Function

Public Function RemoveConnection()
    Dim s As Long, l As Long, ln As Long, a$, RasConn As Long, Ret As Long

    ReDim R(255) As RASCONN95

    R(0).dwSize = 412
    s = 256 * R(0).dwSize
    l = RasEnumConnections(R(0), s, ln)
    For l = 0 To ln - 1
        a$ = StrConv(R(l).szEntryName(), vbUnicode)
        a$ = left$(a$, InStr(a$, Chr$(0)) - 1)
        RasConn = R(l).hRasConn
        '这里将挂断连接
        Ret = RasHangUp(ByVal RasConn)
        Sleep (2000)
    Next
End Function

Public Function RasDialFunc(ByVal unMsg As Long, ByVal ConnState As Long, ByVal dwError As Long)

Select Case ConnState

    Case RASCS_OpenPort
        StatusBar1.Panels(1).Text = "正在打开端口……"
    Case RASCS_PortOpened
        StatusBar1.Panels(1).Text = "端口已打开。"
    Case RASCS_ConnectDevice
        StatusBar1.Panels(1).Text = "正在连接设备"
    Case RASCS_DeviceConnected
        StatusBar1.Panels(1).Text = "设备已连接。"
    Case RASCS_AllDevicesConnected
        StatusBar1.Panels(1).Text = "所有设备均已连接。"
    Case RASCS_Authenticate
        StatusBar1.Panels(1).Text = "验证用户名及密码……"
    Case RASCS_AuthNotify
        StatusBar1.Panels(1).Text = "RASCS_AuthNotify"
    Case RASCS_AuthRetry
        StatusBar1.Panels(1).Text = "RASCS_AuthRetry"
    Case RASCS_AuthCallback
        StatusBar1.Panels(1).Text = "RASCS_AuthCallback"
    Case RASCS_AuthChangePassword
        StatusBar1.Panels(1).Text = "RASCS_AuthChangePassword"
    Case RASCS_AuthProject
        StatusBar1.Panels(1).Text = "RASCS_AuthProject"
    Case RASCS_AuthLinkSpeed
        StatusBar1.Panels(1).Text = "RASCS_AuthLinkSpeed"
    Case RASCS_AuthAck
        StatusBar1.Panels(1).Text = "RASCS_AuthAck"
    Case RASCS_ReAuthenticate
        StatusBar1.Panels(1).Text = "RASCS_ReAuthenticate"
    Case RASCS_Authenticated
        StatusBar1.Panels(1).Text = "RASCS_Authenticated"
    Case RASCS_PrepareForCallback
        StatusBar1.Panels(1).Text = "RASCS_PrepareForCallback"
    Case RASCS_WaitForModemReset
        StatusBar1.Panels(1).Text = "RASCS_WaitForModemReset"
    Case RASCS_WaitForCallback
        StatusBar1.Panels(1).Text = "RASCS_WaitForCallback"
    Case RASCS_Projected
        StatusBar1.Panels(1).Text = "RASCS_Projected"
    Case RASCS_StartAuthentication
        StatusBar1.Panels(1).Text = "RASCS_StartAuthentication"
    Case RASCS_CallbackComplete
        StatusBar1.Panels(1).Text = "RASCS_CallbackComplete"
    Case RASCS_LogonNetwork
        StatusBar1.Panels(1).Text = "RASCS_LogonNetwork"
    Case RASCS_Interactive
        StatusBar1.Panels(1).Text = "RASCS_Interactive"
    Case RASCS_RetryAuthentication
        StatusBar1.Panels(1).Text = "RASCS_RetryAuthentication"
    Case RASCS_CallbackSetByCaller
        StatusBar1.Panels(1).Text = "RASCS_CallbackSetByCaller"
    Case RASCS_PasswordExpired
        StatusBar1.Panels(1).Text = "RASCS_PasswordExpired"
    Case RASCS_Connected
        StatusBar1.Panels(1).Text = "连接成功！"
        FrmMain.Visible = False
        FrmMain.Timer1.Enabled = True
        Exit Function
    Case RASCS_Disconnected
        StatusBar1.Panels(1).Text = "连接已断开！"
         
End Select

Select Case dwError
     
    Case ERROR_PORT_ALREADY_OPEN
        StatusBar1.Panels(1).Text = "错误，端口已经打开！"
    Case ERROR_UNKNOWN
        StatusBar1.Panels(1).Text = "未知的错误！"
    Case ERROR_REQUEST_TIMEOUT
        StatusBar1.Panels(1).Text = "错误，请求超时！"
    Case ERROR_PASSWD_EXPIRED
        StatusBar1.Panels(1).Text = "错误，您的密码错误！"
    Case ERROR_NO_DIALIN_PERMISSION
        StatusBar1.Panels(1).Text = "错误，没有拨号音！"
    Case ERROR_SERVER_NOT_RESPONDING
        StatusBar1.Panels(1).Text = "错误，拨入的远程计算机没有响应！"
    Case ERROR_UNRECOGNIZED_RESPONSE
        StatusBar1.Panels(1).Text = "错误，未知的响应！"
    Case ERROR_NO_RESPONSES
        StatusBar1.Panels(1).Text = "错误，没有响应！"
    Case ERROR_DEVICE_NOT_READY
        StatusBar1.Panels(1).Text = "错误，设备没有准备好！"
    Case ERROR_LINE_BUSY
        StatusBar1.Panels(1).Text = "错误，占线！"
    Case ERROR_NO_ANSWER
        StatusBar1.Panels(1).Text = "错误，服务器无应答！"
    Case ERROR_NO_CARRIER
        StatusBar1.Panels(1).Text = "错误，没有载波信号！"
    Case ERROR_NO_DIALTONE
        StatusBar1.Panels(1).Text = "错误，没有拨号音！"
    Case ERROR_AUTHENTICATION_FAILURE
        StatusBar1.Panels(1).Text = "用户名密码出错！"
    Case ERROR_PPP_TIMEOUT
        StatusBar1.Panels(1).Text = "PPP接入超时。"
    Case 633
        StatusBar1.Panels(1).Text = "错误，网络设备不存在或没打开电源！"
    Case 623
        StatusBar1.Panels(1).Text = "错误，请建立新连接！"
    Case Else
        If dwError <> 0 Then StatusBar1.Panels(1).Text = "拨号失败,重拨!"
         
End Select

End Function

[此贴子已经被作者于2016-2-23 17:24编辑过]