Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


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