jockos
Messages postés321Date d'inscriptiondimanche 22 octobre 2000StatutMembreDernière intervention14 mai 2005
-
16 févr. 2003 à 12:15
cs_Humphrey
Messages postés22Date d'inscriptionsamedi 25 janvier 2003StatutMembreDernière intervention16 février 2003
-
16 févr. 2003 à 16:24
Dans beaucoup de soft, il y a un bouton "Infos Systèmes" dans la fenetre About qui sert à lancer la fenetre Windows des informations systèmes.
L'exécutable est MSINFO32.EXE mais je suppose qu'il doit y avoir une API pour le lancer...
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey 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
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Essaie d'obtenir le chemin et le nom du programme Infos système dans la base de registre...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Essaie d'obtenir uniquement le chemin du programme Infos système dans la base de registre...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Valide l'existence de la version du fichier 32 bits connu.
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Erreur - Impossible de trouver le fichier...
Else
GoTo SysInfoErr
End If
' Erreur - Impossible de trouver l'entrée de la base de registre...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "Les informations système ne sont pas disponibles actuellement", vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Integer
Dim i As Long ' Compteur de boucle.
Dim rc As Long ' Code de retour.
Dim hkey As Long ' Descripteur d'une clé de base de registres ouverte.
Dim hDepth As Long '
Dim KeyValType As Long ' Type de données d'une clé de base de registres.
Dim tmpVal As String ' Stockage temporaire pour une valeur de clé de base de registres.
Dim KeyValSize As Long ' Taille de la variable de la clé de base de registres.
'------------------------------------------------------------
' Ouvre la clé de base de registres sous la racine clé {HKEY_LOCAL_MACHINE...}.
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey) ' Ouvre la clé de base de registres.
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur...
tmpVal = String$(1024, 0) ' Alloue de l'espace pour la variable.
KeyValSize = 1024 ' Définit la taille de la variable.
'------------------------------------------------------------
' Extrait la valeur de la clé de base de registres...
'------------------------------------------------------------
rc = RegQueryValueEx(hkey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Obtient/Crée la valeur de la clé.
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur.
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 ajoute une chaîne terminée par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Caractère nul trouvé, extrait de la chaîne.
Else ' WinNT ne termine pas la chaîne par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize) ' Caractère nul non trouvé, extrait la chaîne uniquement.
End If
'------------------------------------------------------------
' Détermine le type de valeur de la clé pour la conversion...
'------------------------------------------------------------
Select Case KeyValType ' Recherche les types de données...
Case REG_SZ ' Type de données chaîne de la clé de la base de registres.
KeyVal = tmpVal ' Copie la valeur de la chaîne.
Case REG_DWORD ' Type de données double mot de la clé de base de registres.
For i = Len(tmpVal) To 1 Step -1 ' Convertit chaque bit.
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Construit la valeur caractère par caractère.
Next
KeyVal = Format$("&h" + KeyVal) ' Convertit le mot double en chaîne.
End Select
GetKeyValue = True ' Retour avec succès.
rc = RegCloseKey(hkey) ' Ferme la clé de base de registres
Exit Function ' Quitte.
GetKeyError: ' Réinitialise après qu'une erreur s'est produite...
KeyVal = "" ' Affecte une chaîne vide à la valeur de retour.
GetKeyValue = False ' Retour avec échec.
rc = RegCloseKey(hkey) ' Ferme la clé de base de registres.
End Function