Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Счетчик интернет соеинений Добавлено: 14.06.04 14:30  

Автор вопроса:  Barsik | Web-сайт: barsik.newmail.ru | ICQ: 343368641 

Ответить

  Ответы Всего ответов: 24  

Номер ответа: 16
Автор ответа:
 Barsik



Разработчик Offline Client

ICQ: 343368641 

Вопросов: 17
Ответов: 686
  Web-сайт: barsik.newmail.ru
 Профиль | | #16 		Добавлено: 17.06.04 15:04

2sne: а как тады счет вести???

Ответить

Номер ответа: 17
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #17 		Добавлено: 17.06.04 16:55
бери и используй таймер, проверяющий соединение с нетом через каждую секунду... можно еще эти данные брать из св-в соединения... но это, по-моему, только для Win на платформе NT...

Ответить

Номер ответа: 18
Автор ответа:
 Alexandrus



ICQ: 496782368 

Вопросов: 18
Ответов: 312
  Web-сайт: starsorion.com
 Профиль | | #18 		Добавлено: 18.06.04 00:46
sne:
>2alexandrus
> Ну и в тему о соединениях !
> Подскажите в какую сторону копать , чтобы узнать скорость соединения, количество отправленных/полученных данных и т.д. и т.п.

>см. форум, тоже три раза кидал я этот код...

Смотрел 40 раз назад .
Увы тяжко это ( поиск только сниться ... ).
Буду очень признателен ,если скинешь на мыло
Alexus@yugorsk.ru

Ты будешь единственный кто откликнулся , или единстенный кто обладает таким кодом , именно по этой теме! Я забодался его искать !

С ув. Mizin Alex .

Ответить

Номер ответа: 19
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #19 		Добавлено: 18.06.04 12:46
На я прямо из своего проекта модуль вырву... чистить не стал, так что разбираться - тебе...


Option Explicit

'********************************************************************
'* Написано 10.08.2003 году (Team HomeWork) *
'* e-mail: sne_pro@mail.ru *
'********************************************************************

Private Declare Function RasGetConnectionStatistics Lib "rasapi32.dll" (ByVal hRasConn As Long, lpStatistics As RASSTATS2000) As Long
Private Declare Function RasHangUp Lib "rasapi32" Alias "RasHangUpA" (ByVal hRasConn As Long) 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 Type RasEntryName
    dwSize As Long
    szEntryName(256) As Byte
End Type
Private Type RasConn
    dwSize As Long
    hRasConn As Long
    szEntryName(256) As Byte
    szDeviceType(16) As Byte
    szDeviceName(128) As Byte
End Type
Private 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
Private Type VBRasStats95
    BytesXmited As Long ' The number of bytes transmitted through this connection or link.
    BytesRcved As Long ' The number of bytes received through this connection or link.
    ConnectSpeed As Long
End Type

Private Const HKEY_DYN_DATA As Long = &H80000006

Public OldDay As Integer
Public StartTrafData As VBRasStats95 ' Начальный трафик, с которого мы начали слежку ...

Public Function VBRasGetStat2000(hRasConn As Long, myStats As RASSTATS2000) As Long
    myStats.dwSize = Len(myStats)
    VBRasGetStat2000 = RasGetConnectionStatistics(hRasConn, myStats)
End Function

Public Function VBRasGetStat9x(clsVBRasStats As VBRasStats95) As Long
   ;Dim hKey As Long
   Const dUp As String = ";Dial-Up Adapter\"

   On Error GoTo er
   Call RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0&, &H7, hKey)
   With clsVBRasStats
      'Call RegQueryValueEx(hKey, dUp & "Buffer", 0&, ByVal 0&, .BufferOverrunErr, &H4)
      Call RegQueryValueEx(hKey, dUp & "BytesRecvd", 0&, ByVal 0&, .BytesRcved, &H4)
      Call RegQueryValueEx(hKey, dUp & "BytesXmit", 0&, ByVal 0&, .BytesXmited, &H4)
      Call RegQueryValueEx(hKey, dUp & "ConnectSpeed", 0&, ByVal 0&, .ConnectSpeed, &H4)
' Call RegQueryValueEx(hKey, dUp & "CRC", 0&, ByVal 0&, .CrcErr, &H4)
' Call RegQueryValueEx(hKey, dUp & "Alignment", 0&, ByVal 0&, .AlignmentErr, &H4)
' Call RegQueryValueEx(hKey, dUp & "FramesRecvd", 0&, ByVal 0&, .FramesRcved, &H4)
' Call RegQueryValueEx(hKey, dUp & "FramesXmit", 0&, ByVal 0&, .FramesXmited, &H4)
' Call RegQueryValueEx(hKey, dUp & "Framing", 0&, ByVal 0&, .FramingErr, &H4)
' Call RegQueryValueEx(hKey, dUp & "Overrun", 0&, ByVal 0&, .HardwareOverrunErr, &H4)
' Call RegQueryValueEx(hKey, dUp & "Runts", 0&, ByVal 0&, .Runts, &H4)
' Call RegQueryValueEx(hKey, dUp & "Timeout", 0&, ByVal 0&, .TimeoutErr, &H4)
' Call RegQueryValueEx(hKey, dUp & "TotalBytesRecvd", 0&, ByVal 0&, .TotalBytesRcved, &H4)
' Call RegQueryValueEx(hKey, dUp & "TotalBytesXmit", 0&, ByVal 0&, .TotalBytesXmited, &H4)
   End With
Exit Function
er:
    Call RegCloseKey(hKey)
    Call MsgBox(mIniEx.IniGetValue(LngPath, "Msg", "m14", vbNullString), , "VBRasGetStat9x";)
End Function

' §§§§§§§§§§§§§§§§§§§§§§§§§§ Всякая всячина по работе с соединениями и трафиком §§§§§§§§§§§§§§§§§§§§§§§§§§

Public Sub UpdateData() ' Обновление данных (ежесекундное)
    On Error GoTo er
    ;Dim RasData() As VBRASCONN, RasStat2k As RASSTATS2000, RasStat95 As VBRasStats95

    If VBRasEnumConnections(RasData) = &H0 Then ' Если подключение отсутствует
        With PubStat
            If .lBytesReserved Or .lBytesXmited Then ' И имеются отправл. / получ. данные
                PlugSet.CurDayStat.dReserved = PlugSet.CurDayStat.dReserved + .lBytesReserved
                PlugSet.CurDayStat.dXmited = PlugSet.CurDayStat.dXmited + .lBytesXmited ' Мы их добавляем к статистике
                PlugSet.dTrafficStat = PlugSet.dTrafficStat + .lBytesRsXm
                                                                                        ' Потом очищаем, приравнивая их к нулю, дабы еще раз не посчитать
                .lCurrentSpeed = 0: .lCurrentSpeedR = 0: .lCurrentSpeedX = 0
                .lBytesReserved = 0: .lBytesRsXm = 0: .lBytesXmited = 0

                Call SavePlugSet ' Сохраняем статистику и настройки ...
            End If
        End With

        bNetState = False ' Сообщаем всему плагину - соединения нет...
        Exit Sub
    End If

    If Not bNetState Then ' Если тока коннекта небыло, а вот он появился
        ;Dim tmpTraffic As gbHWPlugStat ' Запоминаем трафик, дабы небыло трафика за весь сеанс ...
        tmpTraffic = GetTrafficData

        StartTrafData.BytesRcved = tmpTraffic.lBytesReserved ' Узнаем начальный трафик
        StartTrafData.BytesXmited = tmpTraffic.lBytesXmited
        bNetState = True
    End If
    Call UpdateTrafficData

    If Not vbGetTime.wDay = OldDay Then
        With PlugSet.CurDayStat ' Сохраненяем статистику в файл (за прошедший день)
            If PlugSet.Log_bWrite Then
                If .dXmited Or .dReserved Or .lMaxSpeed Then
                    Call mIniEx.IniSetValue(PlugSet.Log_sFileName, "Statistics", Date - 1, .dXmited & ";" & .dReserved & ";" & .lMaxSpeed)
                End If
            End If
        End With

        PlugSet.CurDayStat.dReserved = 0&
        PlugSet.CurDayStat.dXmited = 0&
        PlugSet.CurDayStat.lMaxSpeed = 0&
    End If

Exit Sub
er: Call MsgBox(mIniEx.IniGetValue(LngPath, "Msg", "m13", vbNullString) & vbCrLf & LngPath, , "UpdateData";)
End Sub

Private Sub UpdateTrafficData()
    ;Dim tmpTraffic As gbHWPlugStat

    tmpTraffic = GetTrafficData
                                                ' Считаем не абсолютный трафик, а как сумму по скорости за каждую секунду
    With tmpTraffic
        PubStat.lBpS = .lBpS
        PubStat.lBytesReserved = tmpTraffic.lBytesReserved - StartTrafData.BytesRcved
        PubStat.lBytesXmited = tmpTraffic.lBytesXmited - StartTrafData.BytesXmited
        PubStat.lBytesRsXm = PubStat.lBytesReserved + PubStat.lBytesXmited
        PubStat.lCurrentSpeed = .lCurrentSpeed
        PubStat.lCurrentSpeedR = .lCurrentSpeedR
        PubStat.lCurrentSpeedX = .lCurrentSpeedX
    End With

    If PubStat.lCurrentSpeed > PlugSet.CurDayStat.lMaxSpeed Then PlugSet.CurDayStat.lMaxSpeed = PubStat.lCurrentSpeed
End Sub

Private Function GetTrafficData() As gbHWPlugStat ' Обновление данных по трафику
    On Error Resume Next ' Тут простое присваивание данных трафика не подходит, т.к.
                                                                                ' если выгрузить статиста, а потом запустить, то данные в лог
    ;Dim RasData() As VBRASCONN ' запишутся двойные :(
    If VBRasEnumConnections(RasData) = &H0 Then Exit Function ' Поэтому используем нашу статистику (рпичем двойнуя, т.к.
                                                                                ' статистика за текущую секунду все время стирается, см frmMain)
    If OS_Version.dwPlatformId = &H2 And Not OS_Version.dwMajorVersion < 5 Then
        ;Dim RasStat2k As RASSTATS2000
        Call VBRasGetStat2000(RasData(0).hRasConn, RasStat2k)
        
        With RasStat2k
            GetTrafficData.lCurrentSpeed = (.dwBytesRcved + .dwBytesXmited) - (PubStat.lBytesRsXm + StartTrafData.BytesRcved + StartTrafData.BytesXmited)
            GetTrafficData.lCurrentSpeedR = .dwBytesRcved - (PubStat.lBytesReserved + StartTrafData.BytesRcved)
            GetTrafficData.lCurrentSpeedX = .dwBytesXmited - (PubStat.lBytesXmited + StartTrafData.BytesXmited)
            
            GetTrafficData.lBytesReserved = .dwBytesRcved
            GetTrafficData.lBytesXmited = .dwBytesXmited
            GetTrafficData.lBytesRsXm = .dwBytesXmited + .dwBytesRcved
            
            GetTrafficData.lBpS = .dwBps
        End With
    ElseIf OS_Version.dwPlatformId = &H1 Then
        ;Dim RasStat95 As VBRasStats95
        Call mConnections.VBRasGetStat9x(RasStat95)
        
        With RasStat95
            GetTrafficData.lCurrentSpeed = (.BytesRcved + .BytesXmited) - (PubStat.lBytesRsXm + StartTrafData.BytesRcved + StartTrafData.BytesXmited)
            GetTrafficData.lCurrentSpeedR = .BytesRcved - (PubStat.lBytesReserved + StartTrafData.BytesRcved)
            GetTrafficData.lCurrentSpeedX = .BytesXmited - (PubStat.lBytesXmited + StartTrafData.BytesXmited)
            
            GetTrafficData.lBytesReserved = .BytesRcved
            GetTrafficData.lBytesXmited = .BytesXmited
            GetTrafficData.lBytesRsXm = .BytesXmited + .BytesRcved

            GetTrafficData.lBpS = .ConnectSpeed
        End With
    End If
End Function

Ответить

Номер ответа: 20
Автор ответа:
 Alexandrus



ICQ: 496782368 

Вопросов: 18
Ответов: 312
  Web-сайт: starsorion.com
 Профиль | | #20 		Добавлено: 18.06.04 17:30
sne:
Большое спасибо за код! Спать сегодня не буду !
Завтра тоже! Если буксану где-то , то ... . Еще раз большое спасибо (10..120...150 раз ... )!

С ув. Alexandrus.

Ответить

Номер ответа: 21
Автор ответа:
 User Unknown



Вечный Юзер!

ICQ: uu@jabber.cz 

Вопросов: 120
Ответов: 3302
  Профиль | | #21 Добавлено: 18.06.04 17:42
2sne, давай-ка оформим и в примеры засунем;)
2alexandrus, Еще раз большое спасибо (2..4.. 8..16.........1024 раз ... )!:))))))))))))))Чтобы уж как истинный программер:)

Ответить

Номер ответа: 22
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | | #22 Добавлено: 18.06.04 19:14
Вот моя программа счёта статистики с учётом времени суток. Обязательно должно быть создано диалап соединения! CrateLinks программа для создания ярлыков к этой программе статистики, токо она должна бысть скомпилирована в NetTime.exe
Скачать программу можно сдесь:

webfile.ru/22040

Ответить

Номер ответа: 23
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #23 		Добавлено: 19.06.04 01:46
ладно, завтра у мня экзамен, если сильно не напьюсь, будет пример...

Ответить

Номер ответа: 24
Автор ответа:
 Alexandrus



ICQ: 496782368 

Вопросов: 18
Ответов: 312
  Web-сайт: starsorion.com
 Профиль | | #24 		Добавлено: 19.06.04 14:05
sne:
С твоим кодом разобрался , все работает.
Спасибо за твое участие 1,2,4,8,16,32,...,2048 раз .(User Unknown надоумил ) >:-))))))))

С ув. Alexandrus

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам