VB开发的有拨号状态显示状态栏里,要如何改
'调用方法:
'拨号: temp = AddConnection("连接名", "", "", username, Password, "") 'ADSL
'temp=0 成功,否则失败
'断线: HangUpAll

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
Public Const RAS95_MaxCallbackNumber = RAS95_MaxPhoneNumber

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μ÷ó?′í?ó′úo? *
'**********************************
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)

'//////////////////////////////////////////////////////////////////////
'Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceName = 128
Public Const RAS_MaxDeviceType = 16

Public Type RASCONN95
'set dwsize to 412
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'/////////////////////////////////////////////////////////////////////////////////



'**********************************
'* 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, lpvNotifier As Long, lphRasConn As Long) As Long
Public Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn 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 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
      
    If IsConnectionByName(strNewEntryName) = True Then
        AddConnection = -1: Exit Function   '已连接
    End If
    lprasdialparams.dwSize = 1052
    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 '
    lngRetCode = RasDial(ByVal APINULL, vbNullString, lprasdialparams, APINULL, ByVal APINULL, hRasConn)
    Screen.MousePointer = vbDefault
    If lngRetCode Then
        lngRetHangUp = RasHangUp(hRasConn)
    End If
    AddConnection = lngRetCode
End Function
Public Function GetConnections() As Integer
    '获取所有连接总数
    Dim lngRetCode As Long
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim intArraySize As Integer
      
    ReDim lprasconn95(intArraySize) As RASCONN95
    lprasconn95(0).dwSize = 412
    lpcb = 256 * lprasconn95(0).dwSize
    lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
      
      
      
    ' If lngRetCode = 0 Then
    ' End If
    GetConnections = lpcConnections
End Function
  
Public Function IsConnectionByName(ByVal strEntryName As String) As Boolean
    '判断某名称的连接是否已经存在
    Dim lngRetCode As Long
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim intArraySize As Integer
    Dim intLooper As Long
    Dim bszEntryName() As Byte, i%, bFind As Boolean
      
    ReDim bszEntryName(RAS95_MaxEntryName)
    ReDim lprasconn95(intArraySize) As RASCONN95
    lprasconn95(0).dwSize = 412
    lpcb = 256 * lprasconn95(0).dwSize
    lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
      
    lstrcpy bszEntryName(0), strEntryName
    IsConnectionByName = False
      
    If lngRetCode = 0 Then
        If lpcConnections > 0 Then
            For intLooper = 0 To lpcConnections - 1
                bFind = True
                For i = 0 To RAS95_MaxEntryName
                    If lprasconn95(intLooper).szEntryName(i) <> bszEntryName(i) Then
                        bFind = False
                        Exit For
                    End If
                Next
                If bFind = True Then
                    IsConnectionByName = True
                    Exit For
                End If
            Next
        End If
    End If
End Function
  
'/////////////////////////////////////////////////////
Public Function HangUpAll() As Boolean
    '挂断所有连接
    Dim lngRetCode As Long
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim intArraySize As Integer
    Dim intLooper As Integer
      
    ReDim lprasconn95(intArraySize) As RASCONN95
    lprasconn95(0).dwSize = 412
    lpcb = 256 * lprasconn95(0).dwSize
    lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
      
    If lngRetCode = 0 Then
        If lpcConnections > 0 Then
            For intLooper = 0 To lpcConnections - 1
                RasHangUp lprasconn95(intLooper).hRasConn
                Exit For
            Next
        Else
            HangUpAll = False
            Exit Function
        End If
    End If
    HangUpAll = True
End Function
'/////////////////////////////////////////////////////
Public Function HangUpByName(ByVal strEntryName As String) As Boolean
    '挂断指定名称连接
    Dim lngRetCode As Long
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim intArraySize As Integer
    Dim intLooper As Integer
    Dim bszEntryName() As Byte, i%, bHangUp As Boolean
      
    ReDim bszEntryName(RAS95_MaxEntryName)
      
    ReDim lprasconn95(intArraySize) As RASCONN95
    lprasconn95(0).dwSize = 412
    lpcb = 256 * lprasconn95(0).dwSize
    lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
    lstrcpy bszEntryName(0), strEntryName
      
    If lngRetCode = 0 Then
        If lpcConnections > 0 Then
            For intLooper = 0 To lpcConnections - 1
                bHangUp = True
                For i = 0 To RAS95_MaxEntryName
                    If lprasconn95(intLooper).szEntryName(i) <> bszEntryName(i) Then
                        bHangUp = False
                        Exit For
                    End If
                Next
                If bHangUp = True Then
                    RasHangUp lprasconn95(intLooper).hRasConn
                    HangUpByName = True
                    Exit For
                End If
            Next
        Else
            HangUpByName = False
            Exit Function
        End If
    End If
End Function
  
  
  
'/////////////////////////////////////////////////////////
  
Public Function GetErrMsg(ByVal intErr As Integer)
    '拨号错误码
    Select Case intErr
    Case -1
        GetErrMsg = "已连接，不能再连接一次。你可能需要重启电脑。"
    Case 605
        GetErrMsg = "无法设置端口信息。"
    Case 606
        GetErrMsg = "无法连接端口。"
    Case 617
        GetErrMsg = "端口或设备已断开连接。"
    Case 618
        GetErrMsg = "端口尚未打开。"
    Case 619, 628
        GetErrMsg = "端口已断开连接。"
    Case 621, 622, 623, 624, 625
        GetErrMsg = "不存在的连接！"
    Case 629
        GetErrMsg = "端口已由远程机器断开连接。"
    Case 634
        GetErrMsg = "无法在远程网络上注册您的计算机。"
    Case 642
        GetErrMsg = "您的一个 NetBIOS 名称已在远程网络上注册。"
    Case 646
        GetErrMsg = "不允许本帐户在此时间登录。"
    Case 647
        GetErrMsg = "帐户已禁用。"
    Case 648
        GetErrMsg = "该帐户的密码已过期。"
    Case 649
        GetErrMsg = "帐户没有远程访问权限。"
    Case 676
        GetErrMsg = "线路忙。"
    Case 678
        GetErrMsg = "远程计算机不可到达。"
    Case 691
        GetErrMsg = "由于域上的用户名和/或密码无效而拒绝访问。"
    Case 708
        GetErrMsg = "帐户已过期。"
    Case 709
        GetErrMsg = "在域上更改密码时出错。"
    Case 720
        GetErrMsg = "不能建立到远程计算机的连接。您可能需要更改些连接的网络设置。"
    Case 768
        GetErrMsg = "因为错误的加密数据造成连接请求失败。"
    Case 770
        GetErrMsg = "远程设备拒绝连接请求。"
    Case 771
        GetErrMsg = "因为网络忙造成连接请求失败。"
    Case 756
        GetErrMsg = "拔号连接正在进行。"
    Case 774
        GetErrMsg = "因为临时性错误导致连接请求失败。请再试着连接。"
    Case 775
        GetErrMsg = "连接被远程服务器阻止。"
    Case 800
        GetErrMsg = "不能建立连接。服务器可能不能到达，或者此连接的安全参数没有正确配置。"
    Case Else
        GetErrMsg = "没有更详细的错误信息！"
    End Select
End Function

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