Ciao Paolo,
posto le Api che si occupano del System Info:
codice:
'Opzioni di protezione delle chiavi del registro di configurazione:
Const KEY_ALL_ACCESS = &H2003F
'Chiavi di primo livello del registro di configurazione.
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Stringa Unicode a terminazione Null
Const REG_DWORD = 4 ' Numero a 32 bit.
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 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
----------------------------------------------------
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
-----------------------------------------------------
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Tenta di recuperare il percorso\nome del programma System Info dal
' registro di configurazione.
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Tenta di recuperare solo il percorso del programma System Info dal
' registro di configurazione.
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Convalida l'esistenza di una versione nota a 32 bit del file.
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Errore - Impossibile trovare il file.
Else
GoTo SysInfoErr
End If
' Errore - Impossibile trovare la voce del registro di configurazione.
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "Informazioni sul sistema non disponibili in questa fase.", vbOKOnly
End Sub
------------------------------------------------------------------
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Contatore del ciclo.
Dim rc As Long ' Codice restituito.
Dim hKey As Long ' Handle a una chiave del registro di configurazione aperta.
Dim hDepth As Long '
Dim KeyValType As Long ' Tipo di dati di una chiave del registro di configurazione.
Dim tmpVal As String ' Variabile per la memorizzazione temporanea del valore di una chiave del registro di configurazione.
Dim KeyValSize As Long ' Dimensioni della variabile della chiave del registro di configurazione.
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Apre la chiave del registro di configurazione.
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gestisce l'errore.
tmpVal = String$(1024, 0) ' Assegna spazio per la variabile.
KeyValSize = 1024 ' Imposta le dimensioni della variabile.
'----------------------------------------------------------------
' Recupera il valore della chiave del registro di configurazione.
'----------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize) ' Recupera/crea il valore della chiave.
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gestisce gli errori.
tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
'------------------------------------------------------------
' Determina il tipo di valore della chiave per la conversione.
'------------------------------------------------------------
Select Case KeyValType ' Cerca i tipi di dati.
Case REG_SZ ' Tipo di dati String per la chiave del registro di configurazione.
KeyVal = tmpVal ' Copia il valore String.
Case REG_DWORD ' Tipo di dati Double Word per la chiave del registro di configurazione.
For i = Len(tmpVal) To 1 Step -1 ' Converte ogni bit.
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Crea il valore carattere per carattere.
Next
KeyVal = Format$("&h" + KeyVal) ' Converte Double Word in String.
End Select
GetKeyValue = True ' Esito positivo.
rc = RegCloseKey(hKey) ' Chiude la chiave del registro di configurazione.
Exit Function ' Esce.
GetKeyError: ' Svuota in seguito a un errore.
KeyVal = "" ' Imposta il valore restituito su una stringa vuota.
GetKeyValue = False ' Esito negativo.
rc = RegCloseKey(hKey) ' Chiude la chiave del registro di configurazione.
End Function
Per avere un programma di raccolta delle API ti consiglio Api Guide che potrai scaricarlo a questo indirizzo
http://www.mentalis.org/agnet/appdown.shtml
Rispondi quotando
