Visual Basic Codes
Visual Basic > Other sample source codes

Enumerate the available RAS connections

Enumerate the available RAS connections

To enumerate all the Remote Access Servers available on a computer use the following routine. Note, a demonstration routine can be found at the end of this article:

Option Explicit

Private Const RAS_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 128
Private Const RAS95_MaxEntryName = 256
Private Type RASCONN95
    lSize As Long
    hRasConn As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Type RASENTRYNAME95
    lSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasEnumEntries Lib "RasApi32.DLL" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long

'Purpose     :  Enumerates all the RAS (Remote Access Server) names
'Inputs      :  asRASNames          See Outputs
'Outputs     :  asRASNames          A string array of RAS names from 1 to Number of RAS's


Sub RASGetNames(asRASNames() As String)
    Dim lLenType, lThisRAS As Long, lNumRAS As Long, sRASName
    Dim atRASInfo() As RASENTRYNAME95
    
    'Initialise Variables
    Erase asRASNames
    ReDim atRASInfo(255) As RASENTRYNAME95
    atRASInfo(0).lSize = 264
    lLenType = 256 * atRASInfo(0).lSize
    
    'Call API to get RAS Entries
    Call RasEnumEntries(vbNullString, vbNullString, atRASInfo(0), lLenType, lNumRAS)
    
    If lNumRAS Then
        ReDim asRASNames(1 To lNumRAS)
        For lThisRAS = 0 To lNumRAS - 1
            sRASName = StrConv(atRASInfo(lThisRAS).szEntryName(), vbUnicode)
            asRASNames(lThisRAS + 1) = Left$(sRASName, InStr(sRASName, Chr$(0)) - 1)
        Next
    End If
End Sub

'Demonstration Routine
Sub Test()
    Dim asRASNames() As String, vThisRas As Variant
    RASGetNames asRASNames
    For Each vThisRas In asRASNames
        Debug.Print vThisRas
    Next
End Sub