Info périférique

Soyez le premier à donner votre avis sur cette source.

Vue 7 172 fois - Téléchargée 798 fois

Télécharger le projet

Commenter

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

Télécharger le projet

Codes Sources

Racine
info

A voir également

Ajouter un commentaire Commentaires

Signaler

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.

Signaler

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

Signaler

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 ?

Signaler

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

Signaler

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

S'inscrire maintenant

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.

Info périférique

Description

Source / Exemple :

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

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

Du même auteur (cs_yoman64)

Classe : gestion d'utilisateurs

Géolocalisation de vos visiteurs (revisé)

Récuperer les infos d'un serveur de jeux (beaucoup de jeux supportés!)

Moniteur serveur counterstrike: source (halflife) + message perso msn

Hub dc++ (direct connect)

Source / Exemple :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (cs_yoman64)

Classe : gestion d'utilisateurs

Géolocalisation de vos visiteurs (revisé)

Récuperer les infos d'un serveur de jeux (beaucoup de jeux supportés!)

Moniteur serveur counterstrike: source (halflife) + message perso msn

Hub dc++ (direct connect)

Vous n'êtes pas encore membre ?

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