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
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
26 sept. 2004 à 22:45
"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.
21 déc. 2003 à 15:31
4 juin 2003 à 13:56
15 janv. 2003 à 21:19
1 nov. 2002 à 19:10
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
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.