Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0& Public Const HKEY_LOCAL_MACHINE = &H80000002 Public ReturnCode As Long Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey 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 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 'Code 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, ByVal lpData, lpcbData) lpcbData = Len(lpData) 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 'Use 'Here is an example of how to use the ActiveConnection 'function. If ActiveConnection = True then Call MsgBox("You have an active connection.",vbInformation) Else Call MsgBox("You have no active connections.", vbInformation) End If |