Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB5,VB6
Expertise: Intermediate
Aug 7, 2000

EnumRASEntries - Enumerate all available RAS phone-book entries

Const ERROR_SUCCESS = 0&
Const ERROR_BUFFER_TOO_SMALL = 603&
Const RAS_MaxEntryName = 256

Private Type RASENTRYNAME
    dwSize As Long
    szEntryName(RAS_MaxEntryName) As Byte
End Type
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

' 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 i

End Function

Alberto Falossi
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date