'===================================================================
'以下在模块中
'===================================================================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
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货