Info périférique

Soyez le premier à donner votre avis sur cette source.

Vue 7 172 fois - Téléchargée 798 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
Messages postés
1133
Date d'inscription
mercredi 2 octobre 2002
Statut
Membre
Dernière intervention
24 juillet 2011
3
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.
Messages postés
58
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 novembre 2006

pffff un zip ca serai mieu qd meme.. ;p
Messages postés
295
Date d'inscription
vendredi 20 décembre 2002
Statut
Membre
Dernière intervention
24 janvier 2014
1
c bizarre j'ai un zip qui contient ce source ... tu l'aurais pas pompé ailleurs ?
Messages postés
5
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
12 février 2003

Genial Trop cool
Messages postés
10
Date d'inscription
dimanche 5 mai 2002
Statut
Membre
Dernière intervention
10 novembre 2002

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.