Info périférique

Soyez le premier à donner votre avis sur cette source.

Vue 7 257 fois - Téléchargée 802 fois

Description

Sa sert a afficher certaine information de bas niveau sur votre ordinateur
vitesse et modèle du processeur,frabriquant
Identifiant du bios et sa date de création
disque Fat actuellement monter par windows
memoire virtuelle et ram
version de windows
carte de son présente ou pas
Connection reseau active ou pas
nombre de couleurs de l'écran et résolution de l'écran

Source / Exemple :


'Un treeview:Tvw
'Ds la form:

Const DRIVE_CDROM = 5
Const DRIVE_FIXED = 3
Const DRIVE_RAMDISK = 6
Const DRIVE_REMOTE = 4
Const DRIVE_REMOVABLE = 2
Const DRIVE_UNKNOW = 0
Const NO_DRIVE = 1
Const BITSPIXEL = 12
Const PLANES = 14

Private Sub Form_Load()
Dim NodX As Node, Txt As String

lpBuffer.dwLength = Len(lpBuffer)
GlobalMemoryStatus lpBuffer
Largeur% = Screen.Width \ Screen.TwipsPerPixelX
Hauteur% = Screen.Height \ Screen.TwipsPerPixelY
res = Str$(Largeur%) + " x" + Str$(Hauteur%)
Set r = CreateObject("WScript.Shell")
v = r.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\~MHz")
vendor = r.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\VendorIdentifier")
typep = r.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\Identifier")
biosdate = r.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\SystemBiosDate")
identbios = r.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\Identifier")

Dim lgDC As Long, lgRep As Long, lgNb As Double
lgDC = GetDC(GetDesktopWindow)
lgNb = GetDeviceCaps(lgDC, PLANES) * 2 ^ GetDeviceCaps(lgDC, BITSPIXEL)
lgRep = ReleaseDC(GetDesktopWindow, lgDC)
If lgNb = 65536 Then NbCouleurs = " (16 bits)"
If lgNb = 4294967296# Then NbCouleurs = " (32 bits)"
clr = CStr(lgNb) & " Couleurs" & NbCouleurs

Dim Lecteur As String
Dim i As Integer
Set NodX = Tvw.Nodes.Add(, , "Racine", "Ordinateur")
Set NodX = Tvw.Nodes.Add("Racine", tvwChild, "Cpu", "Processeur")
Set NodX = Tvw.Nodes.Add("Cpu", tvwChild, "", "Horloge:" & v & " mhz")
Set NodX = Tvw.Nodes.Add("Cpu", tvwChild, "", "Type:" & typep)
Set NodX = Tvw.Nodes.Add("Cpu", tvwChild, "", "Vendeur:" & vendor)
Set NodX = Tvw.Nodes.Add("Racine", tvwChild, "Bios", "Bios")
Set NodX = Tvw.Nodes.Add("Bios", tvwChild, "", "Identifiant:" & identbios)
Set NodX = Tvw.Nodes.Add("Bios", tvwChild, "", "Date de Création:" & biosdate)
Set NodX = Tvw.Nodes.Add("Racine", tvwChild, "Ram", "Mémoire")
Set NodX = Tvw.Nodes.Add("Ram", tvwChild, "", "Vive:" & lpBuffer.dwTotalPhys / 1024 / 1024 & " Mo")
Set NodX = Tvw.Nodes.Add("Ram", tvwChild, "", "Virtuel:" & lpBuffer.dwTotalVirtual / 1024 / 1024 & " Mo")
Set NodX = Tvw.Nodes.Add("Racine", tvwChild, "win", "Windows")
Set NodX = Tvw.Nodes.Add("win", tvwChild, "", "Version:" & ver)
Set NodX = Tvw.Nodes.Add("win", tvwChild, "", "Utilisateur Actif:" & user)
Set NodX = Tvw.Nodes.Add("Racine", tvwChild, "inter", "Réseau et Internet")
Set NodX = Tvw.Nodes.Add("inter", tvwChild, "", "Connection:" & IsConnected)
Set NodX = Tvw.Nodes.Add("Racine", tvwChild, "per", "Périphérique")
Set NodX = Tvw.Nodes.Add("per", tvwChild, "sndd", "Carte de Son")
Set NodX = Tvw.Nodes.Add("sndd", tvwChild, "", snd)
Set NodX = Tvw.Nodes.Add("per", tvwChild, "ec", "Écran")
Set NodX = Tvw.Nodes.Add("ec", tvwChild, "", "Résolution:" & res)
Set NodX = Tvw.Nodes.Add("ec", tvwChild, "", "Couleur:" & clr)
Set NodX = Tvw.Nodes.Add("per", tvwChild, "disk", "Disques")

For i = 0 To 25
Lecteur = Chr$(i + 65) & ":\"
r = GetDriveType(Lecteur)
If r <> NO_DRIVE Then
If r = 5 Then r = "CDROM"
If r = 3 Then r = "Disque Dur"
If r = 6 Then r = "Disque Ram"
If r = 4 Then r = "Lecteur Réseau"
If r = 2 Then r = "Disque Amovible"
Set NodX = Tvw.Nodes.Add("disk", tvwChild, "", Lecteur & " : " & r)
End If
Next i
End Sub

'Module:
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
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 Type MEMORYSTATUS
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
End Type

Public lpBuffer As MEMORYSTATUS

Public RetVal As Long

Type OSVERSIONINFO
                dwOSVersionInfoSize As Long
                dwMajorVersion As Long
                dwMinorVersion As Long
                dwBuildNumber As Long
                dwPlatformId As Long
                szCSDVersion As String * 128
End Type
Global MonOs As OSVERSIONINFO

Public Const VER_PLATFORM_WIN32_NT = 2
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32s = 0
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
 

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" ( _
             ByVal lpRootPathName As String, _
             ByVal lpVolumeNameBuffer As String, _
             ByVal nVolumeNameSize As Long, _
             lpVolumeSerialNumber As Long, _
             lpMaximumComponentLength As Long, _
             lpFileSystemFlags As Long, _
             ByVal lpFileSystemNameBuffer As String, _
             ByVal nFileSystemNameSize As Long) As Long

Public Function user()
 Dim Ch As String
        Dim a As Long
        Dim b As Long
        Dim Utilisateur As String

        a = 199
        Ch = String$(200, 0)
        b = GetUserName(Ch, a)
        If b <> 0 Then Utilisateur = Left$(Ch, a) Else Utilisateur = ""
user = Utilisateur
End Function
Public Function ver()
Dim msg As String
Dim L As Long
MonOs.dwOSVersionInfoSize = Len(MonOs)
L = GetVersionEx(MonOs)
msg$ = ""
Select Case MonOs.dwPlatformId
     Case VER_PLATFORM_WIN32_NT
            msg$ = msg$ & "NT "
     Case VER_PLATFORM_WIN32_WINDOWS
            msg$ = msg$ & "9x "
     Case VER_PLATFORM_WIN32s
            msg$ = msg$ & "Win32S sous Windows 3.x (!)"
End Select
msg$ = msg$ & Str$(MonOs.dwMajorVersion) & "."
msg$ = msg$ & Str$(MonOs.dwMinorVersion) & "."
msg$ = msg$ & Str$(MonOs.dwBuildNumber) & "."
msg$ = msg$ & MonOs.szCSDVersion
ver = msg$
End Function

Public Function IsConnected()
' Cette fonction vérifie si une connexion réseau est active
Dim lgLen As Long, lgFlags As Long
Dim stNomConnexion As String
Dim blConnected As Boolean
lgLen = 256
stNomConnexion = Space$(lgLen)
blConnected = InternetGetConnectedStateEx(lgFlags, stNomConnexion, lgLen, 0&)
If blConnected = True Then IsConnected = "Active"
If blConnected = False Then IsConnected = "Non Active"
End Function

Function snd()
        Dim Carte As Integer

        Carte = waveOutGetNumDevs()

        If Carte > 0 Then
                snd = "Carte Son Présente."
        Else
                snd = "Pas de Carte Son Présente."
        End If
End Function

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_PROGRAMMIX Messages postés 1133 Date d'inscription mercredi 2 octobre 2002 Statut Membre Dernière intervention 24 juillet 2011 3
26 sept. 2004 à 22:45
Lorsque je lance l'application, j'ai le message d'erreur suivant :
"La méthode 'RegRead' de l'objet 'IWshSehll' a échoué" et pointe sur la ligne "v = r.RegRead("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\~MHz")" de la procédure Form_Load.
cs_heine Messages postés 58 Date d'inscription jeudi 19 décembre 2002 Statut Membre Dernière intervention 15 novembre 2006
21 déc. 2003 à 15:31
pffff un zip ca serai mieu qd meme.. ;p
soldier8514 Messages postés 295 Date d'inscription vendredi 20 décembre 2002 Statut Membre Dernière intervention 24 janvier 2014 1
4 juin 2003 à 13:56
c bizarre j'ai un zip qui contient ce source ... tu l'aurais pas pompé ailleurs ?
phoenix2003 Messages postés 5 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 12 février 2003
15 janv. 2003 à 21:19
Genial Trop cool
cs_TheDjinn Messages postés 10 Date d'inscription dimanche 5 mai 2002 Statut Membre Dernière intervention 10 novembre 2002
1 nov. 2002 à 19:10
excelent ce code !
je me permet de recommander de changer la fin du form_load
en remplacant :
r = GetDriveType(Lecteur)
If r <> NO_DRIVE Then
If r 5 Then r "CDROM"
If r 3 Then r "Disque Dur"
If r 6 Then r "Disque Ram"
If r 4 Then r "Lecteur Réseau"
If r 2 Then r "Disque Amovible"
Set NodX = Tvw.Nodes.Add("disk", tvwChild, "", Lecteur & " : " & r)
End If

par :

If r <> NO_DRIVE Then
Select Case r
Case 5: r = "CDROM"
Case 3: r = "Disque Dur"
Case 6: r = "Disque Ram"
Case 4: r = "Lecteur Réseau"
Case 2: r = "Disque Amovible"
End Select
Set NodX = Tvw.Nodes.Add("disk", tvwChild, "", Lecteur & " : " & r)
End If

car sinon il me sort un type incorect :
si le lecteur est un cdrom il transforme r de 6 a une chaine de caractere
puis au if suivant il compare un nombre (3) a une chaine donc type incorrect c'est tout aller je met 9 c bien merite ! ;)

@+++
TheDjinn
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.