Трафик с инетом

[Smith68]

Хелпните, плиз! Как из VB можно узнать мой трафик с инетом.

[GB826]

В предыдущих темах был класс - траффик считал (весь, но если модемщик пойдет, я думаю).

Код нашел (не я писал, копирайт не помню :о(()

Код: Выделить всё

Option Explicit

Public Enum OperationalStates
    MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0
    MIB_IF_OPER_STATUS_UNREACHABLE = 1
    MIB_IF_OPER_STATUS_DISCONNECTED = 2
    MIB_IF_OPER_STATUS_CONNECTING = 3
    MIB_IF_OPER_STATUS_CONNECTED = 4
    MIB_IF_OPER_STATUS_OPERATIONAL = 5
End Enum

Public Enum InterfaceTypes
    MIB_IF_TYPE_OTHER = 1
    MIB_IF_TYPE_ETHERNET = 6
    MIB_IF_TYPE_TOKENRING = 9
    MIB_IF_TYPE_FDDI = 15
    MIB_IF_TYPE_PPP = 23
    MIB_IF_TYPE_LOOPBACK = 24
    MIB_IF_TYPE_SLIP = 28
End Enum

Public Enum AdminStatuses
    MIB_IF_ADMIN_STATUS_UP = 1
    MIB_IF_ADMIN_STATUS_DOWN = 2
    MIB_IF_ADMIN_STATUS_TESTING = 3
End Enum

Private Const MAXLEN_IFDESCR = 256
Private Const MAXLEN_PHYSADDR = 8
Private Const MAX_INTERFACE_NAME_LEN = 256

Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_SUCCESS = 0&


Private Type MIB_IFROW
    wszName(0 To 511) As Byte
    dwIndex As Long             '// Èíäåêñ èíòåðôåéñà
    dwType As Long              '// Òèï èíòåðôåéñà
    dwMtu As Long               '// max transmission unit
    dwSpeed As Long             '// speed of the interface
    dwPhysAddrLen As Long       '// length of physical address
    bPhysAddr(0 To 7) As Byte   '// physical address of adapter
    dwAdminStatus As Long       '// administrative status
    dwOperStatus As Long        '// operational status
    dwLastChange As Long        '// last time operational status changed
    dwInOctets As Long          '// octets received
    dwInUcastPkts As Long       '// unicast packets received
    dwInNUcastPkts As Long      '// non-unicast packets received
    dwInDiscards As Long        '// received packets discarded
    dwInErrors As Long          '// erroneous packets received
    dwInUnknownProtos As Long   '// unknown protocol packets received
    dwOutOctets As Long         '// octets sent
    dwOutUcastPkts As Long      '// unicast packets sent
    dwOutNUcastPkts As Long     '// non-unicast packets sent
    dwOutDiscards As Long       '// outgoing packets discarded
    dwOutErrors As Long         '// erroneous packets sent
    dwOutQLen As Long           '// output queue length
    dwDescrLen As Long          '// length of bDescr member
    bDescr(0 To 255) As Byte    '// interface description
End Type

Private Declare Function GetIfTable Lib "iphlpapi" (ByRef pIfRowTable As Any, ByRef pdwSize As Long, ByVal border As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDest As Any, ByRef pSource As Any, ByVal Length As Long)


Private m_lngBytesReceived  As Long
Private m_lngBytesSent      As Long
Private m_OldBytesReceived  As Long
Private m_OldBytesSent      As Long

Public Property Get BytesReceived() As Long
    If m_OldBytesReceived > 0 Then
        BytesReceived = m_lngBytesReceived - m_OldBytesReceived
    End If
    m_OldBytesReceived = m_lngBytesReceived
End Property

Public Property Get BytesSent() As Long
    If m_OldBytesSent > 0 Then
        BytesSent = m_lngBytesSent - m_OldBytesSent
    End If
    m_OldBytesSent = m_lngBytesSent
End Property

Public Function GetIPStats() As Boolean
    '
    Dim arrBuffer()     As Byte
    Dim lngSize         As Long
    Dim lngRetVal       As Long
    Dim lngRows         As Long
    Dim I               As Integer
    Dim J               As Integer
    Dim IfRowTable      As MIB_IFROW
    '
    lngSize = 0
    '
    'Reset the BytesReceived and BytesSent properties
    '
    m_lngBytesReceived = 0
    m_lngBytesSent = 0
    '
    'Call the GetIfTable just to get the buffer size into the lngSize variable
    lngRetVal = GetIfTable(ByVal 0&, lngSize, 0)
    '
    If lngRetVal = ERROR_NOT_SUPPORTED Then
        '
        'This API works only on Win 98/2000 and NT4 with SP4
        MsgBox "IP Helper is not supported by this system."
        Exit Function
        '
    End If
    '
    'Prepare the buffer
    ReDim arrBuffer(0 To lngSize - 1) As Byte
    '
    'And call the function one more time
    lngRetVal = GetIfTable(arrBuffer(0), lngSize, 0)
    '
    If lngRetVal = ERROR_SUCCESS Then
        '
        'The first 4 bytes (the Long value) contain the quantity of the table rows
        'Get that value into the lngRows variable
        CopyMemory lngRows, arrBuffer(0), 4
        '
        For I = 1 To lngRows
            '
            'Copy the table row data to the IfRowTable structure
            CopyMemory IfRowTable, arrBuffer(4 + (I - 1) * Len(IfRowTable)), Len(IfRowTable)
            '
            With IfRowTable
                '
                'Ñîáîð äâèæåíèå èíôî äëÿ âñåõ èíòåðôåéñîâ
                ' .dwType
                m_lngBytesReceived = m_lngBytesReceived + .dwInOctets
                m_lngBytesSent = m_lngBytesSent + .dwOutOctets
                '
            End With
        Next I
        '
    End If
    '
End Function