Интернет трафик

[VAngel]

Как узнать трафик текущего соединения с инетом?

[Ramzes]

Поставить TMeter

[Sirik]

Ramzes, это точно. только надо правильно фильтры настроить.
У меня один юзер настроил, у него инет за день вылелся в 1 Гб.

[VAngel]

Можно было просто ничего не писать, если не знаеш как

[Ramzes]

Можно было просто ничего не писать, если не знаеш как

2 афтар топика
Сори но мы без флуда как без воды и не туды, и не сюды

[Sebas]

Чтото, типа, GetNetworkStatistic или вру?

Можно через WMI

но это всё показания счётчиков, тоесть после переподключения будет сброс.

[VAngel]

А можно немного по подробнее

[Шнурок]

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

Option Explicit
Private Declare Function RasGetConnectionStatistics Lib "rasapi32.dll" (ByVal hRasConn As Long, lpStatistics As RASSTATS2000) As Long
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasconn As Any, lpcb As Long, lpcConnections As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type OSVERSIONINFO             ' Версия виндовоськи
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Public Type RASSTATS2000
    dwSize                  As Long
    dwBytesXmited           As Long ' The number of bytes transmitted through this connection or link.
    dwBytesRcved            As Long ' The number of bytes received through this connection or link.
    dwFramesXmited          As Long ' The number frames transmitted through this connection or link.
    dwFramesRcved           As Long ' The number of frames received through this connection or link.
    dwCrcErr                As Long ' The number of cyclic redundancy check (CRC) errors on this connection or link.
    dwTimeoutErr            As Long ' The number of timeout errors on this connection or link.
    dwAlignmentErr          As Long ' The number of alignment errors on this connection or link.
    dwHardwareOverrunErr    As Long ' The number of hardware overrun errors on this connection or link.
    dwFramingErr            As Long ' The number of framing errors on this connection or link.
    dwBufferOverrunErr      As Long ' The number of buffer overrun errors on this connection or link.
    dwCompressionRatioIn    As Long ' The compression ratio for the data being received on this connection or link.
    dwCompressionRatioOut   As Long ' The compression ratio for the data being transmitted on this connection or link.
    dwBps                   As Long ' The speed of the connection or link, in bits per second.
    dwConnectDuration       As Long ' The amount of time, in milliseconds, that the connection or link has been connected.
End Type
'Public Type VBRasStats95           ' для 95/98/Me, если понадобится...
'   BytesXmited As Long
'   BytesRcved As Long
'   FramesXmited As Long
'   FramesRcved As Long
'   CrcErr As Long
'   TimeoutErr As Long
'   AlignmentErr As Long
'   HardwareOverrunErr  As Long
'   FramingErr As Long
'   BufferOverrunErr As Long
'   Runts As Long
'   TotalBytesXmited As Long
'   TotalBytesRcved As Long
'   ConnectSpeed As Long
'End Type

Private Const HKEY_DYN_DATA As Long = &H80000006

Private Function VBRasGetStat2000(ByVal hRasConn As Long, _
                         Optional ByRef dwError As Long) As RASSTATS2000

    VBRasGetStat2000.dwSize = Len(VBRasGetStat2000)
    dwError = RasGetConnectionStatistics(hRasConn, VBRasGetStat2000)
End Function

Private Function VBRasGetStat9x(Optional ByRef dwError As Long) As RASSTATS2000
    Dim hKey As Long
    Const dUp As String = "Dial-Up Adapter\"

    Call RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0&, &H7, hKey)
    dwError = IIf(hKey = 0&, False, True)

    With VBRasGetStat9x
        Call RegQueryValueEx(hKey, dUp & "BytesRecvd", 0&, ByVal 0&, .dwBytesXmited, &H4)
        Call RegQueryValueEx(hKey, dUp & "BytesXmit", 0&, ByVal 0&, .dwBytesRcved, &H4)
        Call RegQueryValueEx(hKey, dUp & "FramesXmit", 0&, ByVal 0&, .dwFramesXmited, &H4)
        Call RegQueryValueEx(hKey, dUp & "FramesRecvd", 0&, ByVal 0&, .dwFramesRcved, &H4)
        Call RegQueryValueEx(hKey, dUp & "CRC", 0&, ByVal 0&, .dwCrcErr, &H4)
        Call RegQueryValueEx(hKey, dUp & "Timeout", 0&, ByVal 0&, .dwTimeoutErr, &H4)
        Call RegQueryValueEx(hKey, dUp & "Alignment", 0&, ByVal 0&, .dwAlignmentErr, &H4)
        Call RegQueryValueEx(hKey, dUp & "Overrun", 0&, ByVal 0&, .dwHardwareOverrunErr, &H4)
        Call RegQueryValueEx(hKey, dUp & "Framing", 0&, ByVal 0&, .dwFramingErr, &H4)
        Call RegQueryValueEx(hKey, dUp & "Buffer", 0&, ByVal 0&, .dwBufferOverrunErr, &H4)
        Call RegQueryValueEx(hKey, dUp & "ConnectSpeed", 0&, ByVal 0&, .dwBps, &H4)
       
'        Call RegQueryValueEx(hKey, dUp & "TotalBytesXmit", 0&, ByVal 0&, .BytesRcved, &H4)     ' Не поддерживается 2000/XP...
'        Call RegQueryValueEx(hKey, dUp & "TotalBytesRecvd", 0&, ByVal 0&, .BytesXmited, &H4)   ' Если понадобится, можно использовать
'        Call RegQueryValueEx(hKey, dUp & "Runts", 0&, ByVal 0&, .Runts, &H4)                   ' два разных UDT (VBRasStats95), я предпочел - одну (RASSTATS2000)

        .dwCompressionRatioIn = &HFFFF              ' Не поддерживается 95/98/Me
        .dwCompressionRatioOut = &HFFFF             ' Не поддерживается 95/98/Me
        .dwConnectDuration = &HFFFF                 ' connection duration can be calculated if you use a connection notification event or enumerate connections on a regular basis, providing your app starts before the connection starts.
   End With
End Function

Private Function OS_Version() As OSVERSIONINFO                ' dwPlatformId 0-Unknown; 1-9x; 2-NT
    OS_Version.dwOSVersionInfoSize = Len(OS_Version)
    Call GetVersionEx(OS_Version)
End Function

Public Function VBGetDUPStat(Optional ByRef dwIsError As Long) As RASSTATS2000
    Dim btRasConn() As Byte, lng As Long, dwConnNum As Long

    lng = 32&
    ReDim btRasConn(lng - vbNull)                                       ' Массив с будующими данными

    Call CopyMemory(btRasConn(0), lng, 4&)                              ' Ставим у структуры dwSize = lng
    Call RasEnumConnections(btRasConn(0), lng, dwConnNum)               ' Вызов функции
    Call CopyMemory(lng, btRasConn(4), 4&)                              ' Берем хэндл соединения

    If OS_Version.dwPlatformId = &H2 Then                            ' В зависимости от типа OS берем данные
        VBGetDUPStat = VBRasGetStat2000(lng, dwIsError)                 ' Из реестра или RAS

    ElseIf OS_Version.dwPlatformId = &H1 Then
        VBGetDUPStat = VBRasGetStat9x(dwIsError)
    End If
End Function


вотъ...

[Шнурок]

з.ы. выше - модуль...

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

Option Explicit
Dim prevStat As RASSTATS2000
Dim st As RASSTATS2000

Private Sub Timer2_Timer()
    st = mConnections.VBGetDUPStat() ' mConnections - имя модуля...см. пред. пост
    Text1.Caption = st.dwBytesRcved
    Text2.Caption = st.dwBytesXmited
    'Me.Caption = st.dwBps
End Sub


[VAngel]

Да.... очень подробно, спасибо, пошол пробывать

[Шнурок]

фсегда пожалуйста

[tyomitch]

Я правильно понял, что этот код работает только для диалапа?