声明以下函数变量常量:

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

 

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

 

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

 

Public Const ERROR_SUCCESS = 0&

 

Public Const APINULL = 0&

 

Public Const HKEY_LOCAL_MACHINE = &H80000002

 

Public ReturnCode As Long

 

代码:

 

Public Function ActiveConnection() As Boolean

 

Dim hKey As Long

 

Dim lpSubKey As String

 

Dim phkResult As Long

 

Dim lpValueName As String

 

Dim lpReserved As Long

 

Dim lpType As Long

 

Dim lpData As Long

 

Dim lpcbData As Long

 

ActiveConnection = False

 

lpSubKey = "SystemCurrentControlSetServicesRemoteAccess"

 

ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)

 

If ReturnCode = ERROR_SUCCESS Then

 

hKey = phkResult

 

lpValueName = "Remote Connection"

 

lpReserved = APINULL

 

lpType = APINULL

 

lpData = APINULL

 

lpcbData = APINULL

 

ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)

 

lpcbData = Len(lpData)

 

ReturnCode = ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)

 

If ReturnCode = ERROR_SUCCESS Then

 

If lpData = 0 Then

 

ActiveConnection = False

 

Else

 

ActiveConnection = True

 

End If

 

End If

 

RegCloseKey (hKey)

 

End If

 

End Function

 

下面是使用以上代码的例子:

 

If ActiveConnection = True then

 

Call MsgBox("现在处于链结状态。",vbInformation)

 

Else

 

Call MsgBox("现在处于断开状态。", vbInformation)

 

End If