[VBnet Registry] RegQueryValueEx: Determine Active Internet Dialup Connections


	Visual Basic Registry Routines RegQueryValueEx: Determine Active Internet Dialup Connections

Posted:	Friday September 17, 1999
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows 98
OS restrictions:	Windows 95, Windows 98
Author:	Jorge Flores

Related:	InternetGetConnectedState: Determine Network Connection Type IsNetworkAlive: Determine Network Connection State IsDestinationReachable: Determine Network QOC Info gethostbyaddr: Obtain Host Name from IP Address IcmpSendEcho: Ping a Machine by IP Address IcmpSendEcho: Ping a Machine by Host Name

Prerequisites

Windows 95, Windows 98. The registry key used in this demo does not exist under NT-based systems. For post Windows 98 OS versions try the related items above.

A popular newsgroup question is how to determine, at a given moment, if the computer has an active internet dialup connection. While this information is available when using the internet controls in your project, the method detailed here adds no control overhead.

When an active dialup connection is made, Windows stores the connection info in the registry. By retrieving the appropriate data determining the active connection state is easily accomplished. As this is a simple routine, it is presented as a function callable from any module or form.

This code is based on a newsgroup posting by Jorge Flores.

BAS Module Code

Place the following code into the general declarations area of a bas module:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_USERS As Long = &H80000003

'Return codes from Registration functions
Public Const ERROR_SUCCESS As Long = 0
Public Const ERROR_BADDB As Long = 1009
Public Const ERROR_BADKEY As Long = 1010
Public Const ERROR_CANTOPEN As Long = 1011
Public Const ERROR_CANTREAD As Long = 1012
Public Const ERROR_CANTWRITE As Long = 1013
Public Const ERROR_OUTOFMEMORY As Long = 14
Public Const ERROR_INVALID_PARAMETER As Long = 87
Public Const ERROR_ACCESS_DENIED As Long = 5
Public Const ERROR_MORE_DATA As Long = 234
Public Const ERROR_NO_MORE_ITEMS As Long = 259
Public Const KEY_ALL_ACCESS As Long = &HF003F
Public Const REG_OPTION_NON_VOLATILE As Long = 0

Private Declare Function RegCloseKey Lib "advapi32" _
  (ByVal hKey As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32" _
   Alias "RegOpenKeyA" _
  (ByVal hKey As Long, _
   ByVal sSubKey As String, _
   hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" _
   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


Public Sub Main()

   Dim msg As String
   
   Select Case ActiveConnection()
      Case True
         msg = "You have an active internet connection."
      Case Else
         msg = "Not connect to the internet."
   End Select

   MsgBox msg
   
End Sub


Public Function ActiveConnection() As Boolean
   
  'function checks registry for
  'an active connection
   
   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

Comments

Save the project, set Sub Main as the startup item, and run. The message box will reflect your current dialup connection.

PayPal Link