Comment obtenir des informations sur l'ordinateur qui travaille pour nous ? Du genre : Pentium4, 1000 Mgh, 250 de Ram.

 Const KEY_ALL_ACCESS = &H2003F           ' Reg Key - Options de sécurité ...
 Const HKEY_LOCAL_MACHINE = &H80000002  ' Reg Key - Types de ROOT...
 Const ERROR_SUCCESS = 0
 Const REG_SZ = 1                            '
 Chaîne Unicode terminée par 0
 Const REG_DWORD = 4                       ' 32 bit
 number
 Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
 Const gREGVALSYSINFOLOC = "MSINFO"
 Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
 Const gREGVALSYSINFO = "PATH"
 Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA"
 (ByVal hKey As Long, ByVal lp
subKey As String, ByVal ulOptions As Long,
 ByVal samDesired As Long, ByRef phkResult As Long) As Long
 Private Declare Function RegQueryValueEx Lib "advapi32" Alias
 "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
 lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef
 lpcbData As Long) As Long
 Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As
 Long
 
 sub StartSysInfo()
 Dim rc As Long
 Dim SysInfoPath As String
 
 On Error GoTo SysInfoBug
 'Lecture dans la base de registres du chemin\
 om du programme d'info
 système...
 If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO,
 SysInfoPath) Then
 'Lecture dans la base de registres du chemin du programme d'info
 système...
 ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC,
 gREGVALSYSINFOLOC, SysInfoPath) Then
  ' Valider l'existence d'une version du fichier 32 bits connue
  If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
   SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
   ' Erreur - Fichier introuvable ...
  Else
   GoTo SysInfoBug
  End If
  ' Erreur - Entrée de la base de registres introuvable ...
 Else
  GoTo SysInfoBug
 End If
 Call Shell(SysInfoPath, vbNormalFocus)
 exit sub
 SysInfoBug:
 MsgBox "Les informations sur le système ne" & Chr(10) _
 & "sont pas disponibles pour l'instant", vbOKOnly
 end sub
 
Public Function GetKeyValue(KeyRoot As Long, KeyName As StringsubKeyRef As
 String, ByRef KeyVal As String) As Boolean
 Dim i As Long            ' Compteur de boucle
 Dim rc As Long           ' Code retour
 Dim hKey As Long        ' Pointeur vers une clé de registre ouverte
 Dim hDepth As Long
 Dim KeyValType As Long     ' Type de données clé de registre
 Dim tmpVal As String      ' Stockage temporaire valeur clé de registre
 Dim KeyValSize As Long     ' Taille de la variable clé de registre
 ' Ouvrir RegKey sous KeyRoot {HKEY_LOCAL_MACHINE...}
 rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Ouvrir clé de registre
 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError        ' Gérer les erreurs...
 ' Allouer l'espace pour la variable
 tmpVal = String$(1024, 0)
 ' Marquer la taille de la variable
 KeyValSize = 1024
 ' Extraire la valeur de clé de registre...
 ' Lire / créer validation de clé
 rc = RegQueryValueEx(hKey,
subKeyRef, 0, KeyValType, tmpVal, KeyValSize)
 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError  ' Gérer les erreurs
 If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then   ' Win95 termine les chaînes par 0...
  tmpVal = Left(tmpVal, KeyValSize - 1)      ' Null atteint, extraire de la chaîne
 Else                       ' WinNT ne termine pas les chaînes par 0...
  tmpVal = Left(tmpVal, KeyValSize)    ' 0 non trouvé, extraire chaîne uniquement
 End If
 ' Determiner le type de la valeur de la clé pour la convertir...
 Select Case KeyValType              ' Rechercher types de données...
 Case REG_SZ            ' Type de données de clé de registre String
  KeyVal = tmpVal          ' Copier valeur de la chaîne
 Case REG_DWORD          ' Type de données de clé de registre Double Word
  For i = Len(tmpVal) To 1 Step -1    ' Convertir chaque bit
   KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Construire valeur caractère par caractère
  Next i
  KeyVal = Format$("&h" + KeyVal)  ' Convertir Double Word en String
 End Select
 GetKeyValue = True        ' Renvoyer Réussite
 rc = RegCloseKey(hKey)    ' Fermer la clé de registre
 Exit Function             ' Sortir
 GetKeyError:              'Nettoyage si erreur...
 KeyVal = ""               ' Affecter chaîne vide à la valeur de
 retour
 GetKeyValue = False       ' Renvoyer Échec
 rc = RegCloseKey(hKey)     ' Fermer la clé de registre
 End Function