Soyez le premier à donner votre avis sur cette source.
Vue 7 257 fois - Téléchargée 802 fois
'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.