Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Разработка Windows Forms > Подсчёт трафика

Автор: Spawn™Production® 16.8.2005, 10:51

Нужно отлавливать входящий интернет трафик (Ethernet).
В инете глухо, но есть код на VB 6.0, но вот перевести его не особо получается...

Код


Option Explicit

'Created by SCINER: lenar2003@mail.ru

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()
  Call Timer1_Timer
End Sub

Private Sub Timer1_Timer()

   Dim IPInterfaceRow As MIB_IFROW
   Dim buff() As Byte
   Dim cbRequired As Long
   Dim nStructSize As Long
   Dim nRows As Long
   Dim i As Long

   Call GetIfTable(ByVal 0&, cbRequired, 1)

   Pic.Cls
   If cbRequired > 0 Then
      ReDim buff(0 To cbRequired - 1) As Byte
      If GetIfTable(buff(0), cbRequired, 1) = ERROR_SUCCESS Then
         nStructSize = LenB(IPInterfaceRow)
         CopyMemory nRows, buff(0), 4
         For i = 1 To nRows
            CopyMemory IPInterfaceRow, buff(4 + (i - 1) * nStructSize), nStructSize
            Pic.Print "Тип:        " & GetConnectType(IPInterfaceRow.dwType)
            Pic.Print "Статус:     " & GetConnectStatus(IPInterfaceRow.dwOperStatus)
            Pic.Print "Входящий:   " & (IPInterfaceRow.dwInOctets \ 1000) & " Кб"
            Pic.Print "Исходящий:  " & (IPInterfaceRow.dwOutOctets \ 1000) & " Кб"
            Pic.Print "Скорость:   " & (IPInterfaceRow.dwSpeed \ 1000) & " Кбит/Сек"
            Pic.Print String(256, "-")
          Next
      End If
    End If
  
End Sub

Function GetConnectType(ByVal index As Long) As String
  Select Case index
  Case MIB_IF_TYPE_OTHER: GetConnectType = "OTHER"
  Case MIB_IF_TYPE_ETHERNET: GetConnectType = "ETHERNET"
  Case MIB_IF_TYPE_TOKENRING: GetConnectType = "TOKENRING"
  Case MIB_IF_TYPE_FDDI: GetConnectType = "FDDI"
  Case MIB_IF_TYPE_PPP: GetConnectType = "PPP"
  Case MIB_IF_TYPE_LOOPBACK: GetConnectType = "LOOPBACK"
  Case MIB_IF_TYPE_SLIP: GetConnectType = "SLIP"
  Case Else
  End Select
End Function


Function GetConnectStatus(ByVal index As Long) As String
  Select Case index
  Case MIB_IF_OPER_STATUS_NON_OPERATIONAL: GetConnectStatus = "NON_OPERATIONAL"
  Case MIB_IF_OPER_STATUS_UNREACHABLE: GetConnectStatus = "UNREACHABLE"
  Case MIB_IF_OPER_STATUS_DISCONNECTED: GetConnectStatus = "DISCONNECTED"
  Case MIB_IF_OPER_STATUS_CONNECTING: GetConnectStatus = "CONNECTING"
  Case MIB_IF_OPER_STATUS_CONNECTED: GetConnectStatus = "CONNECTED"
  Case MIB_IF_OPER_STATUS_OPERATIONAL: GetConnectStatus = "OPERATIONAL"
  Case Else
  End Select
End Function

Автор: USDmitriy 31.1.2007, 03:42

а че именно не понятно smile

pic.cls - можно переименовать в form1.cls
timer1- таймер на форме
еще чето не понятно?

Автор: USDmitriy 31.1.2007, 04:42

wszName - Указатель на строку содержащую имя интерфейса
  dwIndex - Определяет индекс интерфейса
  dwType - Определяет тип интерфейса (см. MSDN)
  dwMtu - Определяет максимальную скорость передачи
  dwSpeed - Определяет текущую скорость передачи в битах в секунду
  dwPhysAddrLen - Определяет длину адреса содержащегося в bPhysAddr
  bPhysAddr - Содержит физический адрес интерфейса (если проще то его, немного видоизмененный, МАС адрес)
  dwAdminStatus - Определяет активность интерфейса
  dwOperStatus - Содержит текущий статус интерфейса (см. MSDN)
  dwLastChange - Содержит последний измененный статус
  dwInOctets - Содержит количество байт принятых через интерфейс
  dwInUcastPkts - Содержит количество направленных пакетов принятых интерфейсом
  dwInNUCastPkts - Содержит количество ненаправленных пакетов принятых интерфейсом (включая Броадкаст и т.п.)
  dwInDiscards - Содержит количество забракованных входящих пакетов (даже если они не содержали ошибки)
  dwInErrors - Содержит количество входящих пакетов содержащих ошибки
  dwInUnknownProtos - Содержит количество забракованных входящих пакетов со структурой неизвестного протокола
  dwOutOctets - Содержит количество байт отправленных интерфейсом
  dwOutUCastPkts - Содержит количество направленных пакетов отправленных интерфейсом
  dwOutNUCastPkts- Содержит количество ненаправленных пакетов отправленных интерфейсом (включая Броадкаст и т.п.)
  dwOutDiscards- Содержит количество забракованных исходящих пакетов (даже если они не содержали ошибки)
  dwOutErrors- Содержит количество исходящих пакетов содержащих ошибки
  dwOutQLen - Содержит длину очереди данных
  dwDescrLen - Содержит размер массива bDescr
  bDescr - Содержит описание интерфейса

cbRequired-определяет размерность массива представленного вторым параметром

pIfTable - должен содержать указатель на структуру
  pdwSize - должен содержать размер структуры
  bOrder - указывает, нужна ли сортировка в возвращаемом массиве

CopyMemory копирует строку по адресу buff(0) на место cтроки nRows длиной 4
MIB_IFROW хранится в оперативной памяти для других приложений

Автор: Сергiй 18.12.2018, 14:51

Const MIB_IF_TYPE_SLIP As Long = 28,
а я встретил "=131", то єто что?