Модераторы: gambit, Partizan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Подсчёт трафика, как ??? 
:(
    Опции темы
Spawn™Production®
Дата 16.8.2005, 10:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Тестер ПО, VB.NET Developer
**


Профиль
Группа: Участник
Сообщений: 398
Регистрация: 12.4.2005
Где: Зеленоград

Репутация: 1
Всего: 12



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

Код

Option Explicit

'Created by SCINER: [email protected]

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



--------------------
ОС: WinXP SP2 Rus
Frameworks: v1.0.3705, v1.1.4322, v2.0.50215, v2.0.50727
Сам кодю на VB (6.0 (почти забросил), 7.1, 8.0)
PM WWW   Вверх
USDmitriy
Дата 31.1.2007, 03:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 3
Регистрация: 31.1.2007

Репутация: нет
Всего: нет



 а че именно не понятно smile 
pic.cls - можно переименовать в form1.cls
timer1- таймер на форме 
еще чето не понятно? 
PM MAIL   Вверх
USDmitriy
Дата 31.1.2007, 04:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 3
Регистрация: 31.1.2007

Репутация: нет
Всего: нет



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 хранится в оперативной памяти для других приложений
PM MAIL   Вверх
Сергiй
Дата 18.12.2018, 14:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 1
Регистрация: 18.12.2018

Репутация: нет
Всего: нет



Const MIB_IF_TYPE_SLIP As Long = 28,
а я встретил "=131", то єто что?
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Прежде чем создать тему, посмотрите сюда:
mr.DUDA
THandle

Используйте теги [code=csharp][/code] для подсветки кода. Используйтe чекбокс "транслит" если у Вас нет русских шрифтов.
Что делать если Вам помогли, но отблагодарить помощника плюсом в репутацию Вы не можете(не хватает сообщений)? Пишите сюда, или отправляйте репорт. Поставим :)
Так же не забывайте отмечать свой вопрос решенным, если он таковым является :)


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, mr.DUDA, THandle.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Разработка Windows Forms | Следующая тема »


 




[ Время генерации скрипта: 0.1178 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.