Dans le cas où personne trouverait je travaille aussi la dessus (ce n'est pas du PB mais du VB) :
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
)
