Подготовте проект, добавив в него форму. На форму поместите:
- Таймер с именем Timer1 (Enabled.True; Interval = 1)
- Лэйбл с именем Label1
Добавте в форму:
'Working with registry declarations and constants
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 lpSubKey _
As String, phkResult As Long) As Long
Private 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
Private Const ERROR_SUCCESS = 0&
Private Const APINULL = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
'Working with wininet.dll declarations and constants
Private Declare Function InternetGetConnectedStateEx Lib _
"wininet.dll" Alias "InternetGetConnectedStateExA" _
(ByRef lpdwFlags As Long, _
ByVal lpszConnectionName As String, ByVal dwNameLen As Long, _
ByVal dwReserved As Long) As Long 'Private Declare _
Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef lpdwFlags As Long, ByVal dwReserved As Long) _
As Long 'this function used with IE4
'Private Declare Function InternetGetConnectedState Lib _
"wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved _
As Long) As Long 'this function used with IE4
Private Const INTERNET_CONNECTION_MODEM = &H1&
Private Const INTERNET_CONNECTION_LAN = &H2&
Private Const INTERNET_CONNECTION_PROXY = &H4&
Private Const INTERNET_RAS_INSTALLED = &H10&
Private Const INTERNET_CONNECTION_OFFLINE = &H20&
Private Const INTERNET_CONNECTION_CONFIGURED = &H40&
'Declares for direct ping
Private Declare Function InternetOpen Lib "wininet.dll" _
Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal _
dwAccessType As Long, ByVal lpszProxyName As String, ByVal _
lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" _
Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl _
As String, ByVal lpszHeaders As String, ByVal dwHeadersLength _
As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Long
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Sub Timer1_Timer()
Dim ReturnCode As Long
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
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" & Chr$(0)
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Отмена подключения!"
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
Label1.Caption = "Отключен"
Else
Label1.Caption = "Влкючен"
End If
Else
Label1.Caption = "Отключен"
End If
End If
RegCloseKey (hKey)
End Sub
