Solved

? How to END an INTERNET-Connection ?

Posted on 1998-10-21
1
110 Views
Last Modified: 2008-02-20
How can I close an Internet-Connection???
0
Comment
Question by:qwertzu
1 Comment
 
LVL 4

Accepted Solution

by:
gencross earned 150 total points
ID: 1440971
Check out this code it has a few procedures in it you might like.  Copy it into a BAS module.  You might have to modify it a little to work with your calls to connect to an ISP, or you can just use the ones here.  There are calls for Connecting to ISP, checking if you are connected, hang up and all that.  Let me know it this answers your question.

'****************************************************************
'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


'****************************************************************
' Name: Detect if there is a Dial up network connection
' Description:Here is how I detect if there is a DUN (ISP) connection. You want to take a look at the Remote Access
' Services (RAS) APIs. They are fully documented at the Microsoft site.
' "J Gerard Olszowiec" entity@ns.sympatico.ca
' By: Newsgroup Posting
'
' 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 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


Public Sub StartConnection(dunName As String)

    Dim X As String
    X = Shell("rundll32.exe rnaui.dll,RnaDial " & dunName, 1)
   
    '*******************************************************************
    'As far as I can tell you do not need to wait for a process to end
    'For this to work correctly, but we will see
   
    'X = "rundll32.exe rnaui.dll,RnaDial " & "Test" 'Added by Chris
   
    'Call WaitForProcessToEnd(X, 1)
    '*******************************************************************
   
    DoEvents
   
    SendKeys "{enter}", True

    DoEvents
   
End Sub

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 In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

707 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

18 Experts available now in Live!

Get 1:1 Help Now