devxlogo

EnumRASEntries – Enumerate all available RAS phone-book entries

EnumRASEntries – Enumerate all available RAS phone-book entries

Const ERROR_SUCCESS = 0&Const ERROR_BUFFER_TOO_SMALL = 603&Const RAS_MaxEntryName = 256Private Type RASENTRYNAME    dwSize As Long    szEntryName(RAS_MaxEntryName) As ByteEnd TypePrivate 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' Enumerate available RAS phone-book entries' returns their name in a collection.'' the optional argument is the phonebook name' Windows 9x: this argument is always ignored' Windows NT, if omitted it uses the default phonebook' Windows 2000, if omitted entries are enumerated from all'    the remote access phone-book files in the AllUsers profile'    and the user's profile.Function EnumRASEntries(Optional ByVal PhoneBook As String) As Collection    Dim lpRasEntryName() As RASENTRYNAME    Dim retCode As Long    Dim cbBuf As Long    Dim cEntries As Long    Dim i As Integer    ' prepare the result    Set EnumRASEntries = New Collection        ' NULL is different from an empty string    If Len(PhoneBook) = 0 Then PhoneBook = vbNullString        ' only one entry, just to check how many entries are there    ReDim lpRasEntryName(0) As RASENTRYNAME    lpRasEntryName(0).dwSize = LenB(lpRasEntryName(0))    cbBuf = lpRasEntryName(0).dwSize    retCode = RasEnumEntries(vbNullString, PhoneBook, lpRasEntryName(0), cbBuf, _        cEntries)    ' read all entries, if more than just one    If retCode = ERROR_BUFFER_TOO_SMALL Then        ReDim lpRasEntryName(cEntries - 1) As RASENTRYNAME        lpRasEntryName(0).dwSize = LenB(lpRasEntryName(0))        cbBuf = cEntries * lpRasEntryName(0).dwSize        retCode = RasEnumEntries(vbNullString, PhoneBook, lpRasEntryName(0), _            cbBuf, cEntries)    End If    ' an error occurred    If retCode  ERROR_SUCCESS Then Err.Raise vbObjectError + 512, , _        "RasEnumEntries returnet " & retCode    ' fill the result collection with entry names    For i = 0 To cEntries - 1        EnumRASEntries.Add StrConv(lpRasEntryName(i).szEntryName(), vbUnicode)    Next iEnd Function

devx-admin

Share the Post: