声明以下函数变量常量：
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 = "System\CurrentControlSet\Services\RemoteAccess"

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