自动拨号、自动挂断以及自动处理中途掉线参考方法算法：
Option Explicit
' 有关 wininet 的全局定义
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
Private Const INTERNET_CONNECTION_MODEM = 1
Private Declare Function InternetAutodial Lib "wininet.dll" _
(ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodialHangup Lib _
"wininet.dll" (ByVal dwReserved As Long) As Long
Private Declare Function InternetGetConnectedState Lib _
"wininet.dll" (ByRef lpdwFlags As Long, ByVal _
dwReserved As Long) As Long
' 有关“窗口查找”的全局定义
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOW = 5
' 有关 RAS 的全局定义
Private Const RASCS_DONE = &H2000&
Private Const RAS_MaxEntryName = 256
Private Const RAS_MaxDeviceType = 16
Private Const RAS_MaxDeviceName = 128
Private 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 Type RASCONNSTATUS
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Ras_Buf(255) As RASCONN
Private Ras_Status As RASCONNSTATUS
Private lpcb As Long
Private lpcConnections As Long
Private Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn _
As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectStatus Lib _
"rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal _
hRasConn As Long, lpRASCONNSTATUS As Any) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" _
Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
' 有关“注册表”的全局定义
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias _
"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal lpReserved As Long, lpType _
As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Dim ret As Long
'自动拨号
Private Sub wininet拨号测试_Click()
If InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) _
Then MsgBox "已连接（wininet法）"
End Sub
Private Sub rnaui拨号测试_Click()
ret = Shell("rundll32.exe rnaui.dll,RnaDial " + Text1, 1): DoEvents
SendKeys "", True: DoEvents
End Sub
'检查是否断线
Private Sub wininet方法_Click() ' wininet法检查是否断线
If InternetGetConnectedState(INTERNET_CONNECTION_MODEM, 0) Then
MsgBox "在线．"
Else
MsgBox "当前未连接。"
End If
End Sub
Private Sub 查找窗口法_Click() ' 查找窗口法检查是否断线
ret = FindWindow("#32770", "重新连接")
If ret <> 0 Then
Call ShowWindow(ret, SW_SHOW)
SendKeys "", True: Exit Sub
End If
ret = FindWindow("#32770", "连接到 The95963")
If ret <> 0 Then
MsgBox "在线．"
Else
MsgBox "当前未连接。"
End If
End Sub
Private Sub RAS方法_Click() ' RAS方法检查是否断线
Ras_Buf(0).dwSize = Len(Ras_Buf(0)) + 1
lpcb = 256 * Ras_Buf(0).dwSize
ret = RasEnumConnections(Ras_Buf(0), lpcb, lpcConnections)
If ret Then
MsgBox "出错！": Exit Sub
End If
Ras_Status.dwSize = Len(Ras_Status) + 2
ret = RasGetConnectStatus(Ras_Buf(0).hRasConn, Ras_Status)
If ret = 0 And Ras_Status.RasConnState = RASCS_DONE Then
MsgBox "在线．"
Else
MsgBox "当前未连接。"
End If
End Sub
Private Sub 注册表法_Click() ' 注册表法检查是否断线
Dim SubKey As String, ValueName As String
Dim Data As Long, Result As Long
SubKey = "System\CurrentControlSet\Services\RemoteAccess"
ret = RegOpenKey(HKEY_LOCAL_MACHINE, SubKey, Result)
If ret = 0& Then
ValueName = "Remote Connection"
ret = RegQueryValueEx(Result, ValueName, 0&, 0&, ByVal Data, 0&)
ret = RegQueryValueEx(Result, ValueName, 0&, 0&, Data, Len(Data))
If ret = 0& And Data <> 0 Then
MsgBox "在线！"
Else
MsgBox "当前未连接。"
End If
RegCloseKey (Result)
End If
End Sub
'自动挂断
Private Sub wininet法_Click() ' wininet法自动挂断
If InternetAutodialHangup(0) Then MsgBox "已挂断（wininet法）"
End Sub
Private Sub 窗口查找法_Click() ' 窗口查找法自动挂断
ret = FindWindow("#32770", "连接到 The95963")
If ret <> 0 Then
Call ShowWindow(ret, SW_SHOW)
SendKeys "%c", True
MsgBox "已挂断（窗口查找法）"
End If
End Sub
Private Sub RAS法_Click() ' RAS法自动挂断
Ras_Buf(0).dwSize = Len(Ras_Buf(0)) + 1
lpcb = 256 * Ras_Buf(0).dwSize
ret = RasEnumConnections(Ras_Buf(0), lpcb, lpcConnections)
If ret Then
MsgBox "出错！": Exit Sub
End If
Ras_Status.dwSize = Len(Ras_Status) + 2
ret = RasGetConnectStatus(Ras_Buf(0).hRasConn, Ras_Status)
If ret = 0 And Ras_Status.RasConnState = RASCS_DONE Then
If RasHangUp(Ras_Buf(0).hRasConn) = 0 Then _
MsgBox "已挂断（RAS法）"
End If
End Sub
自动拨号、自动挂断以及自动处理中途掉线
更多DotNet好文章www.zdexe.com
