Solved

Inactive Internet Connection

Posted on 1998-10-29
1
212 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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now