?
Solved

? How to END an INTERNET-Connection ?

Posted on 1998-10-21
1
Medium Priority
?
120 Views
Last Modified: 2008-02-20
How can I close an Internet-Connection???
0
Comment
Question by:qwertzu
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 4

Accepted Solution

by:
gencross earned 300 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

Want to be a Web Developer? Get Certified Today!

Enroll in the Certified Web Development Professional course package to learn HTML, Javascript, and PHP. Build a solid foundation to work toward your dream job!

Question has a verified solution.

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

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…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
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…
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…
Suggested Courses
Course of the Month11 days, 7 hours left to enroll

752 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