Solved

? How to END an INTERNET-Connection ?

Posted on 1998-10-21
1
113 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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
change vba from autofit to 13.5 width? 4 29
MS Date Picker 64 bit 32 bit issue 12 60
VB6 - Convert HH:MM into Decimal 8 62
fso.FolderExists("\\server\HiddenFolder$") 4 78
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…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
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…

860 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