PureBasic

Code : Tout sélectionner

Global receive.q , send.q, tempReceive.q, tempSend.q, statReceive.q, statSend.q,TempsDepart.q, Text_0, Text_1

receive = 0
send = 0
tempReceive = 0
tempSend = 0
statReceive = 0
statSend = 0




Procedure InitWindow_0()
  Window_0 = OpenWindow(#PB_Any, 0, 0, 140, 40, "Debit",#PB_Window_Tool | #PB_Window_BorderLess  )
  Text_0 = TextGadget(#PB_Any, 0, 0, 140, 20, "Reception :")
  Text_1 = TextGadget(#PB_Any, 0, 20, 140, 20, "Emission : ")
  StickyWindow(Window_0, 1) 
 AddSysTrayIcon(1, WindowID(Window_0), LoadImage(0, "D:\Informatique\Pure basic\debit.ico"))

EndProcedure


Procedure netstat(*valeur)
 TempsDepart = ElapsedMilliseconds() 
  
requete.l = RunProgram("netstat","-e" ,"", #PB_Program_Open|#PB_Program_Read|#PB_Program_Hide ) 

If requete 

  While ProgramRunning(requete) 

    Output.s = ReadProgramString(requete)
    If FindString(Output,"Octets",1)     
     
      Output = Right(Output,Len(output)-6)
      Output = Trim(Output)
      receive = Val(Output) ; premier nombre (reçu)
      Output = RemoveString(Output, Str(receive),#PB_String_NoCase)        
      send = Val(Trim(Output)) ; envoyé
      
      If tempReceive <> 0
        statReceive = ((receive - tempReceive)/1024) ; debit ko/s
       
        statSend = ((send - tempSend)/1024) ; debit ko/s
       
        tempReceive = receive
        tempSend = send
      Else
        tempReceive = receive
        tempSend = send
      EndIf
      
      receive = (receive/1048576) ; total debit en MO
      send = (send/1048576) ; total debit en MO
    
      Break
   EndIf
    
   
  Wend 
  CloseProgram(requete) 
  EndIf

EndProcedure

Procedure message(*x)
  MessageRequester("Debit", "Debit total en reception : " + Str(receive) + "Mo"+Chr(10) +"Debit total en emission : " + Str(send) + "Mo",0)
  EndProcedure

InitWindow_0()

Repeat
  Delay(50)
 event = WindowEvent()

  Select event
    Case #PB_Event_CloseWindow
      a=1

    Case #PB_Event_SysTray
      Select EventType() 
          Case PB_EventType_LeftDoubleClick
        CreateThread(@message(), 1)
      Case  #PB_EventType_RightDoubleClick
        a=1
     EndSelect
           
 
      EndSelect
  
  
  TempsEcoule = ElapsedMilliseconds()-TempsDepart  
  If TempsEcoule > 1000
    TempsDepart=0
    SetGadgetText(Text_0, "Reception : " + Str(statReceive) + "ko/s")
    SetGadgetText(Text_1, "Emission : " + Str(statSend) + "ko/s")
    

    
  CreateThread(@netstat(), 1)
  EndIf
  
  

  
Until a=1

Code : Tout sélectionner

Attribute VB_Name = "Internet"
' Les API et les types
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 Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpSFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long
Public 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
Public 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
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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

' Pour la version du système d'exploitation
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
  (lpVersionInformation As Any) As Long
Private Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type

Private Stat As RAS_STATS
Private Conn As RASCONN

' UTILISATION :
' c'est très simple, on commence par s'assurer qu'on est connecté avec IsConnected
' puis si on est bien connecté alors on appelle InitConnexionStats
' Ensuite on appelle la fonction qu'on veut
' Puis si on se déconnecte on arrête les relevés (logique), mais si on se
' reconnecte je pense qu'il faut rappeler InitConnexionStats
'                            _______
' Voilà, un module fait par /MadMatt\, j'ai récupérer des bouts de codes
'                           \-~°_°~-/
' sur des sources sur VBfrance et j'ai tout mis en ordre
'  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'  !!! à utiliser LIBREMENT, c'est si simple !!!
'  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

' Détecte si on est connecté ou pas
Public Function IsConnected() As Boolean
    On Error GoTo Fin
    Dim lgLen As Long, lgFlags As Long
    Dim stNomConnexion As String
    Dim blConnected As Boolean
    lgLen = 256
    stNomConnexion = Space$(lgLen)
    IsConnected = InternetGetConnectedStateEx(lgFlags, stNomConnexion, lgLen, 0&)
    Exit Function
Fin:
    IsConnected = False
End Function

' Initialise le relevé des informations
Public Function InitConnexionStats() As Boolean
    If IsWinNT = False Then InitConnexionStats = True: Exit Function
    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)
        InitConnexionStats = True
    End If
End Function

' Renvoie la vitesse de connexion
Public Function ConnexionSpeed() As Long
    On Error GoTo Fin
    ' Pour Windows XP et autres
    If IsWinNT() = True Then
        If RasGetConnectionStatistics(Conn.hRasConn, VarPtr(Stat)) = 0 Then
            ' Pour convertir en octets
            ConnexionSpeed = Stat.dwBps / 8
        Else
            ConnexionSpeed = 0
        End If
    Else
    ' Pour les autres
        ' les variables
        Const REG_DWORD = 4
        Const HKEY_DYN_DATA = &H80000006
        Dim lData, lType, lSize, hKey As Long
        Dim Qry As String
        ' Ouvre la clé
        Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
        ' Si ça ne marche pas
        If Qry <> 0 Then ConnexionSpeed = 0: Exit Function
        ' Définit les paramêtres pour la lecture
        lType = REG_DWORD
        lSize = 4
        ' Lit la clé
        Qry = RegQueryValueEx(hKey, "Dial-Up Adapter\ConnectSpeed", 0, lType, lData, lSize)
        ' Ferme la clé
        RegCloseKey hKey
        ' Renvoie la valeur
        ConnexionSpeed = Int(lData)
    End If
    Exit Function
Fin:
    ConnexionSpeed = 0
End Function

' Renvoie le nombre d'octets reçus (depuis le début de la connexion)
Public Function BytesReceived() As Long
    On Error GoTo Fin
    If IsWinNT() = True Then
        If RasGetConnectionStatistics(Conn.hRasConn, VarPtr(Stat)) = 0 Then
            BytesReceived = Stat.dwBytesRcved
        Else
            BytesReceived = 0
        End If
    Else
        ' les variables
        Const REG_DWORD = 4
        Const HKEY_DYN_DATA = &H80000006
        Dim lData, lType, lSize, hKey As Long
        Dim Qry As String
        ' Ouvre la clé
        Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
        ' Si ça ne marche pas
        If Qry <> 0 Then BytesReceived = 0: Exit Function
        ' Définit les paramêtres pour la lecture
        lType = REG_DWORD
        lSize = 4
        ' Lit la clé
        Qry = RegQueryValueEx(hKey, "Dial-Up Adapter\BytesRecvd", 0, lType, lData, lSize)
        ' Ferme la clé
        RegCloseKey hKey
        ' Renvoie la valeur
        BytesReceived = Int(lData)
    End If
    Exit Function
Fin:
    BytesReceived = 0
End Function
' Renvoie le nombre d'octets émis (depuis le début de la connexion)
Public Function BytesEmited() As Long
    On Error GoTo Fin
    If IsWinNT() = True Then
        If RasGetConnectionStatistics(Conn.hRasConn, VarPtr(Stat)) = 0 Then
            BytesEmited = Stat.dwBytesXmited
        Else
            BytesEmited = 0
        End If
    Else
        ' les variables
        Const REG_DWORD = 4
        Const HKEY_DYN_DATA = &H80000006
        Dim lData, lType, lSize, hKey As Long
        Dim Qry As String
        ' Ouvre la clé
        Qry = RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData", hKey)
        ' Si ça ne marche pas
        If Qry <> 0 Then BytesEmited = 0: Exit Function
        ' Définit les paramêtres pour la lecture
        lType = REG_DWORD
        lSize = 4
        ' Lit la clé
        Qry = RegQueryValueEx(hKey, "Dial-Up Adapter\BytesXmit", 0, lType, lData, lSize)
        ' Ferme la clé
        RegCloseKey hKey
        ' Renvoie la valeur
        BytesEmited = Int(lData)
    End If
    Exit Function
Fin:
    BytesEmited = 0
End Function

' Renvoie le temps depuis lequel l'ordinateur est connecté à internet
Public Function ConnexionDuration() As Long
    If IsWinNT = False Then
        ConnexionDuration = -1
        Exit Function
    End If
    If RasGetConnectionStatistics(Conn.hRasConn, VarPtr(Stat)) = 0 Then
        ConnexionDuration = Stat.dwConnectDuration
    End If
End Function

' Renvoie le temps depuis lequel l'ordinateur est connecté à internet
' sous forme rédigée en chaine de caractère
Public Function ConnexionDurationString() As String
    If IsWinNT = False Then
        ConnexionDurationString = ""
        Exit Function
    End If
    If RasGetConnectionStatistics(Conn.hRasConn, VarPtr(Stat)) = 0 Then
        Dim Hour, Minutes, Seconds As Integer
        Dim Duration As Long
        Duration = Stat.dwConnectDuration
        Hour = Int(Duration / 1000 / 60 / 60)
        Minutes = Int(Duration / 1000 / 60) - (Hour * 60)
        Seconds = Int(Duration / 1000) - (Hour * 60 * 60) - (Minutes * 60)
        ConnexionDurationString = Str(Hour) + " H" + Str(Minutes) + " min" + Str(Seconds) + " s"
    Else
        ConnexionDurationString = ""
    End If
End Function

' Renvoie True si l'OS est Windows NT3.5(1), NT4.0, 2000 ou XP
' (pour le relevé des stats)
Public Function IsWinNT() As Boolean
    Dim OSInfo As OSVERSIONINFO
    OSInfo.OSVSize = Len(OSInfo)
    ' Récupère la version de l'OS
    GetVersionEx OSInfo
    ' renvoie true si on est sous NT
    IsWinNT = (OSInfo.PlatformID = 2)
End Function