Private Sub Form_Load() If IsConnected = TRUE Then MsgBox ("您已经连通了Internet!") End If If IsConnected = FALSE Then MsgBox ("您还没有连通 Internet!") End If End Sub Option Explicit /*有关的API声明和定义*/ Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long /*常数和变量的设定*/ Public Const RAS95_MaxEntryName = 256 Public Const RAS95_MaxDeviceType = 16 Public Const RAS95_MaxDeviceName = 32 Public Type RASCONN95 dwSize As Long hRasCon As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Public Type RASCONNSTATUS95 dwSize As Long RasConnState As Long dwError As Long szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type /*函数IsConnected返回连通的状态,如果为True则表示已连通*/ 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 "错误" Exit Function End If Tstatus.dwSize = 160 RetVal = RasGetConnectStatus(TRasCon(0).hRasCon,Tstatus) If Tstatus.RasConnState = &H2000 Then IsConnected = TRUE Else IsConnected = FALSE End If End Function |
Option Explicit /*有关的API声明*/ Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32"(ByVal hKey As Long) As Long /*常数的设定*/ Const HKEY_CURRENT_USER = &H80000001 Const ERROR_SUCCESS = 0 在命令按钮(cmdCallConnect)中加入如下代码: Private Sub cmdCallConnect_Click() /*启动默认拨号连接*/ Shell "rundll rnaui.dll,RnaDial" + GetConnect, vbNormalFocus End Sub /*取得连接的函数(GetConnect)*/ Public Function GetConnect() As String Dim hKey As Long Dim SubKey As String /*主键*/ hKey = HKEY_CURRENT_USER /*子键*/ SubKey = "RemoteAccess" /*取得默认连接名*/ GetConnect=GetRegValue(hKey,SubKey, "Default") End Function /*取得注册的函数(GetRegValue)*/ Public Function GetRegValue(hKey As Long,lpszSubKey As String,szKey As String) As Variant On Error GoTo ErrorRoutineErr: Dim phkResult As Long Dim lResult As Long Dim szBuffer As String Dim lBuffSize As Long /*创建缓冲区*/ szBuffer = Space(255) lBuffSize = Len(szBuffer) /*打开注册键*/ RegOpenKeyEx hKey, lpszSubKey, 0, 1,phkResult /*取得查询结果*/ lResult = RegQueryValueEx(phkResult, szKey, 0, 0, szBuffer, lBuffSize) /*关闭注册键*/ RegCloseKey phkResult /*返回结果*/ If lResult = ERROR_SUCCESS Then GetRegValue = Left(szBuffer, lBuffSize - 1) Else GetRegValue ="" End If Exit Function /*意外处理*/ ErrorRoutineErr: GetRegValue ="" End Function |