Visual Basic Programming Code Examples
Visual Basic > Other Code Examples
Enumerate all the open RAS connections
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Enumerate all the open RAS connections
To enumerate the open RAS connections use the following routine. Note, a sample routine can be found at the bottom of this post:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Type VBRASCONN
HwndRASConn As Long
EntryName As String
DeviceType As String
DeviceName As String
Phonebook As String
SubEntry As Long
GuidEntry(15) As Byte
End Type
'Purpose : Enumerates the RAS names
'Inputs : atRASConns See Outputs
'Outputs : atRASConns An array of type VBRASCONN containing information
' about the active connections
' Returns the number of active RAS conections
Function RASGetConnections(atRASConns() As VBRASCONN) As Long
Dim lRet As Long, lpcb As Long, lpConns As Long, lSize As Long, lThisLen As Long
Dim abRASCons() As Byte
Erase atRASConns
ReDim abRASCons(0 To 3)
For lThisLen = 0 To 3
lSize = Choose(lThisLen + 1, 692, 676, 412, 32)
CopyMemory abRASCons(0), lSize, 4
lpcb = 4
lRet = RasEnumConnections(abRASCons(0), lpcb, lpConns)
If lRet <> 632 And lRet <> 610 Then
Exit For
End If
Next
RASGetConnections = lpConns
If lpConns Then
'resize byte array to hold structure
lpcb = lSize * lpConns
ReDim abRASCons(lpcb - 1)
'Copy pointer to RAS structure
CopyMemory abRASCons(0), lSize, 4
lRet = RasEnumConnections(abRASCons(0), lpcb, lpConns)
'Copy the results into the atRasConns array
ReDim atRASConns(1 To lpConns)
For lThisLen = 1 To lpConns
With atRASConns(lThisLen)
CopyMemory .HwndRASConn, abRASCons((lThisLen - 1) * lSize + 4), 4
If lSize = 32 Then
.EntryName = zByteToString(abRASCons((lThisLen - 1) * lSize + 8), 21&)
Else
.EntryName = zByteToString(abRASCons((lThisLen - 1) * lSize + 8), 257)
.DeviceType = zByteToString(abRASCons((lThisLen - 1) * lSize + 265), 17)
.DeviceName = zByteToString(abRASCons((lThisLen - 1) * lSize + 282), 129)
If lSize > 412 Then
.Phonebook = zByteToString(abRASCons((lThisLen - 1) * lSize + 411), 260)
CopyMemory .SubEntry, abRASCons((lThisLen - 1) * lSize + 672), 4
If lSize > 676 Then
CopyMemory .GuidEntry(0), abRASCons((lThisLen - 1) * lSize + 676), 16
End If
End If
End If
End With
Next
End If
End Function
Private Function zByteToString(bPos As Byte, lMaxLen As Long) As String
Dim sBuffer As String, lLen As Long
sBuffer = String(lMaxLen + 1, 0)
CopyMemory ByVal sBuffer, bPos, lMaxLen
lLen = InStr(sBuffer, Chr$(0)) - 1
zByteToString = Left$(sBuffer, lLen)
End Function
'Demonstration routine
Sub Test()
Dim lConnections As Long, lThisCon As Long
Dim tRASConnections() As VBRASCONN
lConnections = RASGetConnections(tRASConnections)
For lThisCon = 1 To lConnections
Debug.Print "-------------------------------------------"
Debug.Print "Details of open RAS connection number " & lThisCon
Debug.Print "DeviceName " & vbTab & vbTab & tRASConnections(lThisCon).DeviceName
Debug.Print "DeviceType " & vbTab & vbTab & tRASConnections(lThisCon).DeviceType
Debug.Print "EntryName " & vbTab & vbTab & tRASConnections(lThisCon).EntryName
Debug.Print "HwndRasConn " & vbTab & tRASConnections(lThisCon).HwndRASConn
Debug.Print "-------------------------------------------"
Next
End Sub
