|
|
|
|
|
|
|
|
|
|
|
 |
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Network Services GetIfTable: Local Machine Network Interface Table |
|
| Posted: | Sunday February 11, 2001 |
| Updated: | Monday December 26, 2011 |
| Applies to: | VB4-32, VB5, VB6 |
| Developed with: | VB6, Windows 2000 |
| OS restrictions: | Windows 98, NT4 SP4+, Windows 2000, Windows XP |
| Author: | VBnet - Randy Birch |
|
Related: |
gethostbyname: Determine Network Host Name and IP Address gethostbyname: Resolve Host Name to IP Address gethostbyaddr: Obtain Host Name from IP Address IcmpSendEcho: Ping a Machine by Host Name |
| Prerequisites |
| One of the operating systems listed under OS Restrictions above. |
|
|
The GetIfTable function returns a table of MIB_IFROW entries, one for each interface on the computer. Note: The demo uses the VB6 FormatNumber function, which is not available in VB4-32 or VB5. Users of these versions should use Format$() instead, i.e. Format$(value, "###,###,###). |
| BAS Module Code |
| None. |
|
|
| Form Code |
|
| To a form add a command button (Command1), and a listview (Listview1). The code creates the required columns. Add the following to the form: |
|
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Const MAX_INTERFACE_NAME_LEN As Long = 256
Private Const ERROR_SUCCESS As Long = 0
Private Const MAXLEN_IFDESCR As Long = 256
Private Const MAXLEN_PHYSADDR As Long = 8
Private Const MIB_IF_OPER_STATUS_NON_OPERATIONAL As Long = 0
Private Const MIB_IF_OPER_STATUS_UNREACHABLE As Long = 1
Private Const MIB_IF_OPER_STATUS_DISCONNECTED As Long = 2
Private Const MIB_IF_OPER_STATUS_CONNECTING As Long = 3
Private Const MIB_IF_OPER_STATUS_CONNECTED As Long = 4
Private Const MIB_IF_OPER_STATUS_OPERATIONAL As Long = 5
Private Const MIB_IF_TYPE_OTHER As Long = 1
Private Const MIB_IF_TYPE_ETHERNET As Long = 6
Private Const MIB_IF_TYPE_TOKENRING As Long = 9
Private Const MIB_IF_TYPE_FDDI As Long = 15
Private Const MIB_IF_TYPE_PPP As Long = 23
Private Const MIB_IF_TYPE_LOOPBACK As Long = 24
Private Const MIB_IF_TYPE_SLIP As Long = 28
Private Const MIB_IF_ADMIN_STATUS_UP As Long = 1
Private Const MIB_IF_ADMIN_STATUS_DOWN As Long = 2
Private Const MIB_IF_ADMIN_STATUS_TESTING As Long = 3
Private Type MIB_IFROW
wszName(0 To (MAX_INTERFACE_NAME_LEN - 1) * 2) As Byte
dwIndex As Long
dwType As Long
dwMtu As Long
dwSpeed As Long
dwPhysAddrLen As Long
bPhysAddr(0 To MAXLEN_PHYSADDR - 1) As Byte
dwAdminStatus As Long
dwOperStatus As Long
dwLastChange As Long
dwInOctets As Long
dwInUcastPkts As Long
dwInNUcastPkts As Long
dwInDiscards As Long
dwInErrors As Long
dwInUnknownProtos As Long
dwOutOctets As Long
dwOutUcastPkts As Long
dwOutNUcastPkts As Long
dwOutDiscards As Long
dwOutErrors As Long
dwOutQLen As Long
dwDescrLen As Long
bDescr(0 To MAXLEN_IFDESCR - 1) As Byte
End Type
Private Declare Function GetIfTable Lib "iphlpapi.dll" _
(ByRef pIfTable As Any, _
ByRef pdwSize As Long, _
ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
Private Declare Function inet_ntoa Lib "wsock32" _
(ByVal addr As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, _
ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(ByVal Ptr As Any) As Long
Private Declare Function GetFriendlyIfIndex Lib "iphlpapi" _
(ByVal IfIndex As Long) As Long
Private Sub Form_Load()
Dim itmx As ListItem
ListView1.View = lvwReport
Listview1.ColumnHeaders.Add , , "Information"
With Listview1.ListItems
Set itmx = .Add(, "bDescr", "description of interface")
Set itmx = .Add(, , "interface index")
Set itmx = .Add(, , "interface type")
Set itmx = .Add(, , "Maximum Transmission Unit")
Set itmx = .Add(, , "interface speed (bps)")
Set itmx = .Add(, , "physical address (decimal)")
Set itmx = .Add(, , "physical address (hex)")
Set itmx = .Add(, , "admin enabled or disabled")
Set itmx = .Add(, , "interface operational status")
Set itmx = .Add(, , "last time op status changed")
Set itmx = .Add(, , "data received (octets)")
Set itmx = .Add(, , "packets received (unicast)")
Set itmx = .Add(, , "packets received (non-unicast)")
Set itmx = .Add(, , "packets discarded")
Set itmx = .Add(, , "discarded with errors")
Set itmx = .Add(, , "discarded, unknown protocol")
Set itmx = .Add(, , "data sent (octets)")
Set itmx = .Add(, , "packets sent (unicast)")
Set itmx = .Add(, , "packets sent (non-unicast)")
Set itmx = .Add(, , "packets discarded, no errors")
Set itmx = .Add(, , "packets discarded with errors")
Set itmx = .Add(, , "output queue length")
End With
End Sub
Public Function GetInetStrFromPtr(ByVal Address As Long) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
End Function
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Sub Command1_Click()
Dim IPInterfaceRow As MIB_IFROW
Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim nRows As Long
Dim cnt As Long
Dim n As Long
Dim itmx As ListItem
Dim tmp As String
Call GetIfTable(ByVal 0&, cbRequired, 1)
If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetIfTable(buff(0), cbRequired, 1) = ERROR_SUCCESS Then
'saves using LenB in the CopyMemory calls below
nStructSize = LenB(IPInterfaceRow)
'first 4 bytes is a long indicating the
'number of entries in the table
CopyMemory nRows, buff(0), 4
For cnt = 1 To nRows
'moving past the four bytes obtained
'above, get one chunk of data and cast
'into an IPInterfaceRow type
CopyMemory IPInterfaceRow, buff(4 + (cnt - 1) * nStructSize), nStructSize
With Listview1
.ColumnHeaders.Add , , "Adapter " & CStr(cnt)
Set itmx = .ListItems(1)
itmx.SubItems(cnt) = TrimNull(StrConv(IPInterfaceRow.bDescr, vbUnicode))
Set itmx = .ListItems(2)
itmx.SubItems(cnt) = GetFriendlyIfIndex(IPInterfaceRow.dwIndex)
Select Case IPInterfaceRow.dwType
Case MIB_IF_TYPE_ETHERNET: tmp = "Ethernet"
Case MIB_IF_TYPE_TOKENRING: tmp = "TokenRing"
Case MIB_IF_TYPE_FDDI: tmp = "FDDI"
Case MIB_IF_TYPE_PPP: tmp = "Point-to-Point"
Case MIB_IF_TYPE_LOOPBACK: tmp = "Loopback"
Case MIB_IF_TYPE_SLIP: tmp = "Slip"
Case MIB_IF_TYPE_OTHER: tmp = "Other"
End Select
Set itmx = .ListItems(3)
itmx.SubItems(cnt) = IPInterfaceRow.dwType & " " & tmp
tmp = ""
Set itmx = .ListItems(4)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwMtu, 0)
Set itmx = .ListItems(5)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwSpeed, 0)
For n = 0 To IPInterfaceRow.dwPhysAddrLen -1
tmp = tmp & IPInterfaceRow.bPhysAddr(n) & " "
Next
Print
Set itmx = .ListItems(6)
itmx.SubItems(cnt) = tmp
tmp = ""
For n = 0 To IPInterfaceRow.dwPhysAddrLen -1
tmp = tmp & Hex(IPInterfaceRow.bPhysAddr(n)) & " "
Next
Print
Set itmx = .ListItems(7)
itmx.SubItems(cnt) = tmp
tmp = ""
Select Case IPInterfaceRow.dwAdminStatus
Case MIB_IF_ADMIN_STATUS_UP: tmp = "Enabled"
Case MIB_IF_ADMIN_STATUS_DOWN: tmp = "Disabled"
Case MIB_IF_ADMIN_STATUS_TESTING: tmp = "Testing"
End Select
Set itmx = .ListItems(8)
itmx.SubItems(cnt) = IPInterfaceRow.dwAdminStatus & " " & tmp
tmp = ""
Select Case IPInterfaceRow.dwOperStatus
Case MIB_IF_OPER_STATUS_NON_OPERATIONAL: tmp = "Non-operational"
Case MIB_IF_OPER_STATUS_UNREACHABLE: tmp = "Unreachable"
Case MIB_IF_OPER_STATUS_DISCONNECTED: tmp = "Disconnected"
Case MIB_IF_OPER_STATUS_CONNECTING: tmp = "Connecting"
Case MIB_IF_OPER_STATUS_CONNECTED: tmp = "Connected"
Case MIB_IF_OPER_STATUS_OPERATIONAL: tmp = "Operational"
End Select
Set itmx = .ListItems(9)
itmx.SubItems(cnt) = IPInterfaceRow.dwOperStatus & " " & tmp
tmp = ""
Set itmx = .ListItems(10)
itmx.SubItems(cnt) = IPInterfaceRow.dwLastChange
Set itmx = .ListItems(11)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwInOctets, 0)
Set itmx = .ListItems(12)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwInUcastPkts, 0)
Set itmx = .ListItems(13)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwInNUcastPkts, 0)
Set itmx = .ListItems(14)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwInDiscards, 0)
Set itmx = .ListItems(15)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwInErrors, 0)
Set itmx = .ListItems(16)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwInUnknownProtos, 0)
Set itmx = .ListItems(17)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwOutOctets, 0)
Set itmx = .ListItems(18)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwOutUcastPkts, 0)
Set itmx = .ListItems(19)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwOutNUcastPkts, 0)
Set itmx = .ListItems(20)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwOutDiscards, 0)
Set itmx = .ListItems(21)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwOutErrors, 0)
Set itmx = .ListItems(22)
itmx.SubItems(cnt) = FormatNumber(IPInterfaceRow.dwOutQLen, 0)
End With 'Listview1
Next cnt
End If 'If GetIfTable( ...
End If 'If cbRequired > 0
End Sub
Private Function TrimNull(item As String)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function |
| Comments |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
 |
