asked on

Internet Info

Hi All! I have a little problem. I need to get some info about the current connection the user might have to the Internet. I already have code to detect an Internet connection over a modem or LAN but what I now need is full code which will detect the bytes transfered over either type of connection both incoming and outgoing.

(In MB ofcourse)

Can anyone provide some code? More points if need be!

PBuck

This is Randy Birch's code from (http://www.mvps.org/vbnet/) - will work with Window98 and higher only!

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" _
(dst As Any, src As Any, ByVal bcount As Long)

Private Declare Function inet_ntoa Lib "wsock32.dll" (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 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

Private Sub Form_Load()

Dim itmx As ListItem

Listview1.ColumnHeaders.Add , , "Information"

With Listview1.ListItems

.View = lvwReport
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

PBuck

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) = GetInetStrFromPtr(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 = 1 To IPInterfaceRow.dwPhysAddrLen
tmp = tmp & IPInterfaceRow.bPhysAddr(n) & " "
Next
Print
Set itmx = .ListItems(6)
itmx.SubItems(cnt) = tmp
tmp = ""

For n = 1 To IPInterfaceRow.dwPhysAddrLen
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

ASKER CERTIFIED SOLUTION

PBuck

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

PaulHews

Post a link to Randy Birch's code instead of reproducing his code (which has the following notice.):

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

hollstar

ASKER

This is just what I need - great stuff PBuck - Another 50 points for your efforts!

PBuck

I appreciate it much. Glad it was useful for you.

See you around EE!

hollstar

ASKER

Just having a little bit more of a look at the info it outputs: I have cable operating over a USB Ethernet Adapter and also have a normal network card as well as modem.. Hence it shows all 3.

It seems to show stuff for my modem as well as cable.. so how can I get this data (always updating ofcourse) into a seperate text box?