| Вопрос: Как считать входящий трафик в Mb | Добавлено: 24.09.05 14:48 |
Автор вопроса:  Mag | ICQ: 289414238 |
| Нужна код который считывает входящий трафик в Mb с определенного устройства |
| Ответы | Всего ответов: 2 |
|
Номер ответа: 1 Автор ответа:  Barsik Разработчик Offline Client ICQ: 343368641 Вопросов: 17 Ответов: 686 |
Web-сайт: Профиль | | #1 | Добавлено: 26.09.05 12:06 |
| ras | ||
|
Номер ответа: 2 Автор ответа: HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #2 | Добавлено: 26.09.05 19:45 |
|
насчёт определённого устройства незнаю, возможно самому дорабатывать придётся, но в целом идея такова:
UserControl '------------------------------------------------------------------------------------- ' 88888888 88888 8888 8888888 | Автор и програмер : Ракочий Назар | ' 88 88 8 88 88 88 | Ник : DaSharm | ' 88 88888 888888 8888 | Сайт : localhost.co.nr | ' 88 88 88 88 88 88 | E-mail : dasharm@mail.ru | ' 88 88 88 88 88 88 MON | ICQ : 2068093 | '------------------------------------------------------------------------------------- ' 100% Украинский продукт ' 30.04.2004 - Украина - Тернополь Private Type WSAData wVersion As Integer wHighVersion As Integer szDescription As String * 257 szSystemStatus As String * 129 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As Long End Type Private Type sockaddr_in sin_family As Integer sin_port As Integer sin_addr As Long sin_zero As String * 8 End Type Private Type hostent hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As Long End Type Event Monitor(Value As Long) Private Declare Function gethostname Lib "ws2_32.dll" (ByVal MyName As String, ByVal MyName_len As Long) As Long Private Declare Function gethostbyname Lib "wsock32" (ByVal hostname As String) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nbytes As Long) Private Declare Function bind Lib "wsock32.dll" (ByVal s As Integer, addr As sockaddr_in, ByVal namelen As Integer) As Integer Private Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long Private Declare Function WSACleanup Lib "wsock32.dll" () As Long Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSAData) As Long Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Private Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long Private Const FD_READ = &H1& Private Const FD_WRITE = &H2& Private Const FD_CONNECT = &H10& Private Const FD_CLOSE = &H20& Dim s As Long, BindIP As String Public Function StartMonitor() As Boolean Dim Timing As Long, so As sockaddr_in so.sin_family = 2 so.sin_port = htons(8054) so.sin_addr = inet_addr(GetReal) s = socket(2, 3, 0) Timing = 5000 If setsockopt(s, &HFFFF&, &H1006, (Timing), 4) = -1 Then MsgBox "Setsock failed": GoTo ExxLabel If bind(s, so, Len(so)) = -1 Then MsgBox "Bind failed": GoTo ExxLabel Dim lngInBuffer As Long Dim lngBytesReturned As Long Dim lngOutBuffer As Long lngInBuffer = 1 If WSAIoctl(s, &H98000001, lngInBuffer, Len(lngInBuffer), lngOutBuffer, Len(lngOutBuffer), lngBytesReturned, ByVal 0, ByVal 0) = -1 Then MsgBox "Iotcl failed": GoTo ExxLabel If WSAAsyncSelect(s, UserControl.hwnd, &H202, FD_READ) = -1 Then MsgBox "WS failed": GoTo ExxLabel StartMonitor = True Exit Function ExxLabel: StartMonitor = False End Function Private Function GetIPfromNetName(NetName As String) As String Dim gv As Long Dim an As hostent Dim IPaddr As Long gv = gethostbyname(Trim(NetName)) If gv = 0 Then Exit Function CopyMemory an, ByVal gv, Len(an) CopyMemory IPaddr, ByVal an.hAddrList, 4 Dim tmpIPAddr() As Byte ReDim tmpIPAddr(1 To an.hLength) Dim sIPAddr As String CopyMemory tmpIPAddr(1), ByVal IPaddr, an.hLength For i = 1 To an.hLength sIPAddr = sIPAddr & tmpIPAddr(i) & "." Next If Right(sIPAddr, 1) = "." Then sIPAddr = Left(sIPAddr, Len(sIPAddr) - 1) GetIPfromNetName = sIPAddr End Function Private Sub UserControl_Initialize() Dim ws As WSAData WSAStartup &H101, ws End Sub Private Function GetReal() As String Dim MyName As String * 255 gethostname MyName, 255 GetReal = GetIPfromNetName(MyName) End Function Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim ReadBuffer(1498) As Byte Dim Bytes As Long Bytes = recv(s, ReadBuffer(0), 1498, 0) If Bytes > 0 Then RaiseEvent Monitor(Bytes) End Sub Private Sub UserControl_Resize() Height = 465 Width = 465 End Sub Form1 ' DaSharm (www.localhost.co.nr) ' не пытайтесь запустить этот пример когда вы не подключены к сети. ' Дело в том, что контрол не может быть привязан к интерфейсу 127.0.0.1 ' и будет показывть ошибку iotcl failed Private Sub Form_Load() TrafMon1.StartMonitor End Sub Private Sub TrafMon1_Monitor(Value As Long) ' смотрим на caption формы, там будет число принятых байт Caption = Val(Caption) + Value End Sub ссылку не нашёл |
||
Страница: 1 |