Option Explicit
' Opzioni di protezione per la chiave del registro di configurazione
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' Chiavi principali del registro di configurazione
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Stringa Unicode che termina con un carattere 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
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "Informazioni su " & App.Title
lblVersion.Caption = "Versione " & App.Major & "." & App.Minor & "." & App.Revision
lblTitle.Caption = App.Title
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Tenta di recuperare dal registro di configurazione il percorso e il nome
' del programma che consente di visualizzare le informazioni sul sistema
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Tenta di recuperare dal registro di configurazione solo il percorso
' del programma che consente di visualizzare le informazioni sul sistema
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Convalida l'esistenza di una versione a 32 bit del file conosciuta
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Errore. Il file non è stato trovato.
Else
GoTo SysInfoErr
End If
' Errore. La chiave del registro di configurazione non è stata trovata.
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "Le informazioni sul sistema non sono attualmente disponibili.", 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 per il 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 ' Posizione di memorizzazione temporanea del valore di una chiave del registro di configurazione
Dim KeyValSize As Long ' Dimensioni della variabile della chiave del registro di configurazione
'------------------------------------------------------------
' Apre una chiave del registro di configurazione in una chiave principale {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 ' Gestione degli errori
tmpVal = String$(1024, 0) ' Assegna spazio alla variabile
KeyValSize = 1024 ' Specifica 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 ' Gestione degli errori
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' In Win95 viene aggiunta una stringa che termina con un carattere Null
tmpVal = Left(tmpVal, KeyValSize - 1) ' È stato trovato un carattere Null, che viene estratto dalla stringa
Else ' In WinNT non viene aggiunto un carattere Null al termine della stringa
tmpVal = Left(tmpVal, KeyValSize) ' Non è stato trovato nessun carattere Null, pertanto estrae solo la stringa
End If
'------------------------------------------------------------
' Determina il tipo del 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 ' Restituisce un valore che indica che l'operazione è riuscita
rc = RegCloseKey(hKey) ' Chiude la chiave del registro di configurazione
Exit Function ' Esce dalla routine
GetKeyError: ' Reimposta i dati se viene generato un errore
KeyVal = "" ' Imposta su una stringa vuota il valore restituito
GetKeyValue = False ' Restituisce un valore che indica che l'operazione non è riuscita
rc = RegCloseKey(hKey) ' Chiude la chiave del registro di configurazione
End Function
