/[cvs]/joko/ToolBox/Windows/VpnDial/src/RasGetAllEntries.bas
ViewVC logotype

Contents of /joko/ToolBox/Windows/VpnDial/src/RasGetAllEntries.bas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Wed Sep 28 20:36:46 2005 UTC (18 years, 9 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
+ initial commit

1 Attribute VB_Name = "RasGetAllEntries"
2 Option Explicit
3
4 Public Type VBRasEntryName
5 entryname As String
6 Win2000_SystemPhonebook As Boolean
7 PhonebookPath As String
8 End Type
9
10 Public Declare Function RasEnumEntries _
11 Lib "rasapi32.dll" Alias "RasEnumEntriesA" _
12 (ByVal lpStrNull As String, ByVal lpszPhonebook As String, _
13 lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
14
15 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
16 (Destination As Any, Source As Any, ByVal Length As Long)
17
18
19 Function VBRasGetAllEntries(clsRasEntryName() As VBRasEntryName, _
20 Optional strPhoneBook As String) As Long
21
22 Dim rtn As Long, i As Long
23 Dim lpcb As Long 'count of bytes
24 Dim lpcEntries As Long 'count of entries
25 Dim b() As Byte
26 Dim strTemp As String
27 Dim dwSize As Long 'size of each entry
28 Dim lngLen As Long
29 Dim lngBLen As Variant
30 ReDim b(3)
31
32 'determine appropiate size for b()
33
34 lngBLen = Array(532&, 264&, 28&)
35 For i = 0 To 2
36 CopyMemory b(0), CLng(lngBLen(i)), 4
37 rtn = RasEnumEntries(vbNullString, strPhoneBook, _
38 b(0), lpcb, lpcEntries)
39 If rtn <> 632 Then Exit For
40 Next i
41
42 VBRasGetAllEntries = lpcEntries
43
44 If lpcEntries = 0 Then Exit Function
45
46 dwSize = lpcb \ lpcEntries
47
48 ReDim b(lpcb - 1)
49
50 CopyMemory b(0), dwSize, 4
51
52 rtn = RasEnumEntries(vbNullString, strPhoneBook, _
53 b(0), lpcb, lpcEntries)
54
55 If rtn <> 0 Then MsgBox VBRasErrorHandler(rtn)
56
57 strTemp = String(dwSize - 4, 0)
58
59 ReDim clsRasEntryName(lpcEntries - 1)
60
61 If dwSize = 28 Then lngLen = 21 Else lngLen = 257
62 For i = 0 To lpcEntries - 1
63 CopyMemory ByVal strTemp, b((i * dwSize) + 4), lngLen
64 clsRasEntryName(i).entryname = _
65 Left(strTemp, InStr(strTemp, Chr$(0)) - 1)
66 Next i
67 If dwSize > 264 Then
68 For i = 0 To lpcEntries - 1
69 CopyMemory clsRasEntryName(i).Win2000_SystemPhonebook, _
70 b((i * dwSize) + 264), 2&
71 CopyMemory ByVal strTemp, b((i * dwSize) + 268), 260&
72 clsRasEntryName(i).PhonebookPath = _
73 Left(strTemp, InStr(strTemp, Chr$(0)) - 1)
74 Next i
75 Else
76 For i = 0 To lpcEntries - 1
77 clsRasEntryName(i).PhonebookPath = strPhoneBook
78 Next i
79 End If
80 End Function
81

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed