Здравствуйте.
Нужно измерить входящий/исходящий трафик - (для нета)..
Я так понимаю, что это можно сделать с помощью WinAPI - не подскажете функцию???
Private Declare Function GetIfTable Lib "iphlpapi.dll" _
(ByRef pIfTable As Any, _
ByRef pdwSize As Long, _
ByVal bOrder As Long) As Long
Денис писал(а):Вот каспер для анализа трафика ставит свой драйвер в сетевые подключения. весь трафик направляется на локальный порт, где сидит сканер каспера, потом проверенный трафик направляется по своим адресам
Option Explicit
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 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
Dim first As Boolean
Dim cnt As Long
Private Sub Get_traf()
Dim IPInterfaceRow As MIB_IFROW
Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim nRows As Long
Dim n As Long
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
nStructSize = LenB(IPInterfaceRow)
CopyMemory nRows, buff(0), 4
If first Then
lst1.Clear
For cnt = 1 To nRows
CopyMemory IPInterfaceRow, buff(4 + (cnt - 1) * nStructSize), nStructSize
Listbox1.AddItem TrimNull(StrConv(IPInterfaceRow.bDescr, vbUnicode))
Next cnt
first = False
cnt = 3
End If
CopyMemory IPInterfaceRow, buff(4 + (cnt - 1) * nStructSize), nStructSize
Label1.Caption = "In: " & FormatNumber(IPInterfaceRow.dwInOctets, 0) & " Out: " & FormatNumber(IPInterfaceRow.dwOutOctets, 0)
End If
End If
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
Private Sub Form_Load()
first = True
End Sub
Private Sub Listbox1_Click()
cnt = Listbox1.ListIndex + 1
End Sub
Private Sub Timer1_Timer()
Call Get_traf
End Sub
Сейчас этот форум просматривают: AhrefsBot, Google-бот и гости: 73