Слежение за трафиком

[transfusion]

Как в VB6 можно организовать слежение за интернет трафиком? (Время в инете, отправленные байты, принятые байты).

[Alexander N. Samarin]

Поставить сервер, а к нему подключиться через винсок

[transfusion]

А по-проще организовать нельзя? Может какая апишная функция есть?

[Jenizix]

Есть! RasGetConnectionStatistics вот пример:

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

Private Declare Function RasEnumConnections Lib "rasapi32" Alias "RasEnumConnectionsA" (ByVal lprasconn As Long, ByVal lpcb As Long, ByVal lpcConnections As Long) As Long
Private Declare Function RasGetConnectionStatistics Lib "rasapi32" (ByVal hRasConn As Long, ByVal lpStatistics As Long) As Long
Private Type RASCONN
    dwSize As Long
    hRasConn As Long
    szEntryName(0 To 256) As Byte
    szDeviceType(0 To 16) As Byte
    szDeviceName(0 To 128) As Byte
    pad As Byte
End Type
Private Type RAS_STATS
    dwSize As Long
    dwBytesXmited As Long
    dwBytesRcved As Long
    dwFramesXmited As Long
    dwFramesRcved As Long
    dwCrcErr As Long
    dwTimeoutErr As Long
    dwAlignmentErr As Long
    dwHardwareOverrunErr As Long
    dwFramingErr As Long
    dwBufferOverrunErr As Long
    dwCompressionRatioIn As Long
    dwCompressionRatioOut As Long
    dwBps As Long
    dwConnectDuration As Long
End Type

Private Sub Form_Load()
Me.Show
    Dim conn As RASCONN
    Dim stat As RAS_STATS
    Dim y As Long, z As Long
       
    conn.dwSize = Len(conn)
    y = conn.dwSize
   
   
    If RasEnumConnections(VarPtr(conn), VarPtr(y), VarPtr(z)) = 0 Then
        stat.dwSize = Len(stat)
        If RasGetConnectionStatistics(conn.hRasConn, VarPtr(stat)) = 0 Then
            Print "Скорость: " & stat.dwBps
            Print "Принято: " & stat.dwBytesRcved
            Print "Отправлено :" & stat.dwBytesXmited
            Print "Сжатие (принято): " & stat.dwCompressionRatioIn
            Print "Сжатие (послено): " & stat.dwCompressionRatioOut
            Print "Время: " & stat.dwConnectDuration
            Print stat.dwBufferOverrunErr
            Print stat.dwAlignmentErr
            Print stat.dwCrcErr
            Print stat.dwFramesRcved
            Print stat.dwFramesXmited
            Print stat.dwFramingErr
            Print stat.dwTimeoutErr
        End If
    End If
   
End Sub


[transfusion]

Jenizix
Спасибо

Может теперь кто подскажет, как окна полупрозрачные делать?

[Jenizix]

Вот так:

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

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const SW_SHOW = 5
Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Private Const WS_EX_TRANSPARENT = &H20&
Private Const LWA_ALPHA = &H2&

Private Sub Form_Load()
    Dim procent as Integer
    procent = 80 ' 80 процентов

    NormalWindowStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    SetWindowLong Me.hWnd, GWL_EXSTYLE, NormalWindowStyle Or WS_EX_LAYERED
    SetLayeredWindowAttributes Me.hWnd, 0, 255, LWA_ALPHA

    Transparency = (255 * procent) / 100
    SetLayeredWindowAttributes Me.hWnd, 0, Transparency, LWA_ALPHA
   
End Sub

В win98 не работает...

[transfusion]

Jenizix
Спасибо!

Тему можна закрыть

[transfusion]

Неее. Тему рано еще закрывать.

А если я подключен к интернету через локалку. Как тогда это сделать?

[Sebas]

-sniffer
-счётчик NT на кажое подключение

[transfusion]

А подробнее можно? Как это сделать?

[Alexander N. Samarin]

А у меня не работает, т.к.
RasGetConnectionStatistics(conn.hRasConn, VarPtr(stat)) = 0
Что делать????? [/quote]