Zjištění aktivního připojení k Internetu

Postup:
Založte nový projekt s modulem.

V modulu definujte:
Option Explicit

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_NONE = 0
Public Const ERROR_SUCCESS = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0

Private Declare Function RegCloseKey _ Lib "advapi32.dll" _ (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey _ Lib "advapi32.dll" Alias "RegOpenKeyA" _ (ByVal hKey As Long, _ ByVal sSubKey As String, _ hKey As Long) As Long
Private Declare Function RegQueryValueEx _ Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal hKey As Long, _ ByVal sKeyValue As String, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Any, _ nSizeData As Long) As Long

*Každá deklarace musí být celá na samostatném řádku

Připojte následující proceduru:
Public Sub Main()

   Dim msg As String

   Select Case ActiveConnection()
   
     Case True: msg = "Momentálně jste připojeni k Internetu."
        Case Else: msg = "Nejste k Internetu připojeni."
    End Select

   MsgBox msg

End Sub

Public Function ActiveConnection() As Boolean

   'Funkce testující registr pro aktivní spojení
   Dim hKey As Long
   Dim lpData As Long
   Dim nSizeData As Long

   Const sSubKey = "System\CurrentControlSet\Services\RemoteAccess"
   Const sKeyValue = "Remote Connection"

   If RegOpenKey(HKEY_LOCAL_MACHINE, _ sSubKey, _ hKey) = ERROR_SUCCESS Then
        lpData = 0&
        nSizeData = Len(lpData)
        If RegQueryValueEx(hKey, _ sKeyValue, _ 0&, _ 0&, _ lpData, _ nSizeData) = ERROR_SUCCESS Then
            ActiveConnection = lpData <> 0
        End If
        Call RegCloseKey(hKey)
    End If

End Function

Uložte projekt, nastavte jeho startovací routinu na sub Main a spusťte jej.

Zpět

Autor: The Bozena