Visual Basic > Other sample source codes

Visual Basic Code > Enumerate all the open RAS connections

Enumerate all the open RAS connections

To enumerate the open RAS connections use the following routine. Note, a sample routine can be found at the bottom of this post:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long

Private Type VBRASCONN
   HwndRASConn As Long
   EntryName As String
   DeviceType As String
   DeviceName As String
   Phonebook  As String
   SubEntry As Long
   GuidEntry(15) As Byte
End Type

'Purpose     :  Enumerates the RAS names
'Inputs      :  atRASConns          See Outputs
'Outputs     :  atRASConns          An array of type VBRASCONN containing information
'                                   about the active connections
'               Returns the number of active RAS conections


Function RASGetConnections(atRASConns() As VBRASCONN) As Long
    Dim lRet As Long, lpcb As Long, lpConns As Long, lSize As Long, lThisLen As Long
    Dim abRASCons() As Byte
    
    Erase atRASConns
    ReDim abRASCons(0 To 3)
    
    For lThisLen = 0 To 3
        lSize = Choose(lThisLen + 1, 692, 676, 412, 32)
        CopyMemory abRASCons(0), lSize, 4
        lpcb = 4
        lRet = RasEnumConnections(abRASCons(0), lpcb, lpConns)
        If lRet <> 632 And lRet <> 610 Then
            Exit For
        End If
    Next
   
    RASGetConnections = lpConns
    If lpConns Then
        'resize byte array to hold structure
        lpcb = lSize * lpConns
        ReDim abRASCons(lpcb - 1)
        'Copy pointer to RAS structure
        CopyMemory abRASCons(0), lSize, 4
        lRet = RasEnumConnections(abRASCons(0), lpcb, lpConns)
        'Copy the results into the atRasConns array
        ReDim atRASConns(1 To lpConns)
        For lThisLen = 1 To lpConns
            With atRASConns(lThisLen)
                CopyMemory .HwndRASConn, abRASCons((lThisLen - 1) * lSize + 4), 4
                If lSize = 32 Then
                    .EntryName = zByteToString(abRASCons((lThisLen - 1) * lSize + 8), 21&)
                Else
                    .EntryName = zByteToString(abRASCons((lThisLen - 1) * lSize + 8), 257)
                    .DeviceType = zByteToString(abRASCons((lThisLen - 1) * lSize + 265), 17)
                    .DeviceName = zByteToString(abRASCons((lThisLen - 1) * lSize + 282), 129)
                    If lSize > 412 Then
                        .Phonebook = zByteToString(abRASCons((lThisLen - 1) * lSize + 411), 260)
                        CopyMemory .SubEntry, abRASCons((lThisLen - 1) * lSize + 672), 4
                        If lSize > 676 Then
                            CopyMemory .GuidEntry(0), abRASCons((lThisLen - 1) * lSize + 676), 16
                        End If
                    End If
                End If
            End With
        Next
    End If
End Function

Private Function zByteToString(bPos As Byte, lMaxLen As Long) As String
   Dim sBuffer As String, lLen As Long
   
   sBuffer = String(lMaxLen + 1, 0)
   CopyMemory ByVal sBuffer, bPos, lMaxLen
   lLen = InStr(sBuffer, Chr$(0)) - 1
   zByteToString = Left$(sBuffer, lLen)
End Function


'Demonstration routine
Sub Test()
    Dim lConnections As Long, lThisCon As Long
    Dim tRASConnections() As VBRASCONN
    
    lConnections = RASGetConnections(tRASConnections)
    For lThisCon = 1 To lConnections
        Debug.Print "-------------------------------------------"
        Debug.Print "Details of open RAS connection number " & lThisCon
        Debug.Print "DeviceName " & vbTab & vbTab & tRASConnections(lThisCon).DeviceName
        Debug.Print "DeviceType " & vbTab & vbTab & tRASConnections(lThisCon).DeviceType
        Debug.Print "EntryName " & vbTab & vbTab & tRASConnections(lThisCon).EntryName
        Debug.Print "HwndRasConn " & vbTab & tRASConnections(lThisCon).HwndRASConn
        Debug.Print "-------------------------------------------"
    Next
End Sub