'===================================================================
'以下在模块中
'===================================================================Option ExplicitPublic Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_RASCONNSIZE As Integer = 412Public Type RASCONN95
    'set dwsize to 412
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Type RASENTRYNAME95
    'set dwsize to 264
    dwSize As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
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 RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Public Type RasEntryName
    dwSize As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
End TypePublic Type RasConn
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type'===================================================================
'以下在窗体中
'===================================================================Private Sub Command3_Click()
Unload Me
End SubPrivate Sub Command1_Click()
    Dim A$
    Dim X
   A$ = "rundll rnaui.dll,RnaDial " & List1.List(List1.ListIndex)
    On Error GoTo E
    X = Shell(A$, vbNormalFocus)
    On Error GoTo 0
    Unload Me
Exit Sub
E:
    MsgBox "没有找到文件rundll和rnaui.dll", vbExclamation, "网络拨号"
End SubPublic Sub Command2_Click()
If IsConnected() = True Then
  MsgBox "已经连接或正在连接!", , "网络拨号"
Else
  MsgBox "没有连接上网络!", , "网络拨号"
End If
End SubPrivate Sub Form_Load()
    Dim s As Long, l As Long, ln As Long, A$
    ReDim R(255) As RASENTRYNAME95
    
    R(0).dwSize = 264
    s = 256 * R(0).dwSize
    l = RasEnumEntries(vbNullString, vbNullString, R(0), s, ln)
    For l = 0 To ln - 1
        A$ = StrConv(R(l).szEntryName(), vbUnicode)
        List1.AddItem Left$(A$, InStr(A$, Chr$(0)) - 1)
    Next
    On Error GoTo E
    List1.ListIndex = 0
    Exit Sub
E:
    MsgBox "你可能没安装拨号网络!", , "网络拨号"
    Command1.Enabled = False
    Command2.Enabled = False
End Sub
Public Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
'
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
    MsgBox "ERROR"
    Exit Function
End If
'
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasConn, Tstatus)
If Tstatus.RasConnState = &H2000 Then
    IsConnected = True
Else
    IsConnected = False
End IfEnd Function