Solved

Inactive Internet Connection

Posted on 1998-10-29
1
217 Views
Last Modified: 2010-04-30
Is there code I can use to tell if an internet connection has been inactive for a certain amount of time then if it has disconnect?
0
Comment
Question by:sear
1 Comment
 
LVL 3

Accepted Solution

by:
fguerreiro_inix earned 10 total points
ID: 1442349

'put in a module

'****************************************************************
'Windows API/Global Declarations for :Detect if there is a Dial up network connection
'****************************************************************
' Registry APIs.

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const MAX_STRING_LENGTH As Integer = 256


Declare Function RegOpenKey Lib "advapi32.dll" Alias _
       RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
       String, phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As _
     Long) As Long
     ' RegQueryValueEx:If you declare the lpData parameter as
     ' String, you must pass it By Value.

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
       ' Remote Access Services (RAS) APIs.

Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Type RasEntryName
       dwSize As Long
       szEntryName(RAS_MAXENTRYNAME) As Byte
End Type


Public Type RasConn
       dwSize As Long
       hRasConn As Long
       szEntryName(RAS_MAXENTRYNAME) As Byte
       szDeviceType(RAS_MAXDEVICETYPE) As Byte
       szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type


Public Declare Function RasEnumConnections Lib "rasapi32.dll" _
      Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As _
      Long, lpcConnections As Long) As Long

Public Declare Function RasHangUp Lib "rasapi32.dll" Alias _
       "RasHangUpA" (ByVal hRasConn As Long) As Long

Public gstrISPName As String
Public ReturnCode As Long


actual code



'****************************************************************
' Name: Detect if there is a Dial up network connection
' Description:Here is how I detect if there is a DUN (ISP)
'
' Inputs:None
' Returns:None
' Assumes:None
' Side Effects:None
'
'****************************************************************


Public Function Connected_To_ISP() 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
       Connected_To_ISP = 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
           ' Not Connected
          Else
           ' Connected
           Connected_To_ISP = True
          End If
        End If

        RegCloseKey (hKey)
    End If

End Function

> 2) Once I determine that I'd like to disconnect, How do I do
> that? It seems like I need some interface to DUN to do it.
Use RasHangUp. In this example I display a splash screen (frmHangupSplash)

while the hangup is in progress. You'll want to set gstrISPName =
Get_ISP_Name() before calling HangUp(), or better yet modify HangUP and pass the DUN connection name (the ISP) as a parameter..

Public Sub HangUp()

       Dim i As Long
       Dim lpRasConn(255) As RasConn
       Dim lpcb As Long
       Dim lpcConnections As Long
       Dim hRasConn As Long
       frmHangupSplash.Show
       frmHangupSplash.Refresh
       lpRasConn(0).dwSize = RAS_RASCONNSIZE
       lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
       lpcConnections = 0
       ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
    ' Drop ALL the connections that match the currect
    ' connections name.

    If ReturnCode = ERROR_SUCCESS Then
        For i = 0 To lpcConnections - 1
          If Trim(ByteToString(lpRasConn(i).szEntryName)) = _
             Trim(gstrISPName) Then
             hRasConn = lpRasConn(i).hRasConn
             ReturnCode = RasHangUp(ByVal hRasConn)
          End If
        Next i
     End If

  ' It takes about 3 seconds to drop the connection.
       Wait (3)

      While Connected_To_ISP
         Wait (1)
      Wend

       Unload frmHangupSplash
End Sub


Public Sub Wait(sngSeconds As Single)

       Dim sngEndTime As Single
       sngEndTime = Timer + sngSeconds

       While Timer < sngEndTime
             DoEvents
       Wend

End Sub

public Function Get_ISP_Name() As String

 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 String
 Dim lpcbData As Long

 Get_ISP_Name = "" 

   If gblnConnectedToISP Then
      lpSubKey = "RemoteAccess"
      ReturnCode = RegOpenKey(HKEY_CURRENT_USER, lpSubKey, _
            phkResult)
      If ReturnCode = ERROR_SUCCESS Then
          hKey = phkResult
          lpValueName = "Default"
          lpReserved = APINULL
          lpType = APINULL
          lpData = APINULL
          lpcbData = APINULL
          ReturnCode = RegQueryValueEx(hKey, lpValueName, _
              lpReserved, lpType, ByVal lpData, lpcbData)
          lpData = String(lpcbData, 0)
          ReturnCode = RegQueryValueEx(hKey, lpValueName, _
             lpReserved, lpType, ByVal lpData, lpcbData)

          If ReturnCode = ERROR_SUCCESS Then
            ' Chop off the end-of-string character.
            Get_ISP_Name = Left(lpData, lpcbData - 1)
          End If

          RegCloseKey (hKey)
       End If

   End If

End Function

'***********************************************************
'     ****************
'     ' Name: ByteToString
'     ' ' Description:* * * THIS IS A FOLLOWUP SUBMISSION * * *
Purpose: Convert a string in byte format (usually from a DLL call) to a string of text.
PLEASE POST THIS AS A FOLLOWUP OR ADD TO THE CODE SAMPLE TITLED "Detect if there is a Dial up network connection" attributed to me J Gerard Olszowiec, entity@ns.sympatico.ca. The newsgroup post that you captured had a followup post that included the ByteToString code. I've been receiving requets for this functions code. Much Thanx. - Gerard
'     ' By: Entity Software
'     '
'     ' Inputs:None
'     ' Returns:None
'     ' Assumes:None
'     ' Side Effects:None
'     '
'     'Code provided by Planet Source Code(tm) 'as is', without
'     ' warranties as to performance, fitness, merchantability,
'     ' and any other warranty (whether expressed or implied).
***********************************************************
'     ****************

Public Function ByteToString(bytString() As Byte) As String

' Convert a string in byte format (usually from a DLL call)
' to a string of text.

 Dim i As Integer

 ByteToString = "" 
 i = 0

 While bytString(i)0&
   ByteToString = ByteToString & Chr(bytString(i))
   i = i + 1
 Wend

End Function



Hope this helps
Regards
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question