e 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 "{enter}", 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 "{enter}", 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