VB and VBA Users Source Code: Enumerate all the open RAS connections
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Enumerate all the open RAS connections
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, January 09, 2001
Hits:
686
Category:
Networks
Article:
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 'Author : Andrew Baker 'Date : 03/01/2001 14:57 'Notes : 'Revisions : 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
