Počet RAS záznamů
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BUFFER_TOO_SMALL = 603&
Private 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
'Volitelný argument je jméno knihy se záznamy
'Windows 9x: ignorováno
'Windows NT: je-li vynechán, použije se defaultní kniha
'Windows 2000: je-li vynechán, načtou se záznamy z aktuálního profilu a z profile AllUsers
Private 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
Set EnumRASEntries = New Collection
If Len(PhoneBook) = 0 Then PhoneBook = vbNullString
ReDim lpRasEntryName(0) As RASENTRYNAME
lpRasEntryName(0).dwSize = LenB(lpRasEntryName(0))
cbBuf = lpRasEntryName(0).dwSize
retCode = RasEnumEntries(vbNullString, PhoneBook, _
lpRasEntryName(0), cbBuf, cEntries)
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
If retCode <> ERROR_SUCCESS Then Err.Raise vbObjectError + 512, , _
"RasEnumEntries chyba: " & retCode
For i = 0 To cEntries - 1
EnumRASEntries.Add StrConv(lpRasEntryName(i).szEntryName(),_
vbUnicode)
Next i
End Function