Option Explicit

' レジストリ　キー　セキュリティ　オプション...
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
                     
' ﾚｼﾞｽﾄﾘ ｷｰ ROOT 型...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1    ' Null 文字で終わる Unicode 文字列

Const REG_DWORD = 4 ' 32 ビット数値

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
    
    ' レジストリからシステム情報プログラムのパス\名前を取得します...
    If GetKeyValue(HKEY_LOCAL_MACHINE, _
        gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' レジストリからシステム情報プログラムのパス名のみを取得します...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, _
        gREGVALSYSINFOLOC, SysInfoPath) Then
        ' 既に存在するはずの 32 ビット バージョンのファイルを確認します。
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
            ' エラー - ファイルが見つかりません...
        Else
            GoTo SysInfoErr
        End If
    ' エラー - レジストリ エントリが見つかりません...
    Else
        GoTo SysInfoErr
    End If
    
    Call Shell(SysInfoPath, vbNormalFocus)
    
    Exit Sub
SysInfoErr:
    MsgBox "現時点ではシステム情報を使用できません", 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           ' ループカウンタ
    Dim rc As Long          ' 戻り値
    Dim hkey As Long        ' オープンしたレジストリ キーのハンドル
    Dim hDepth As Long      '
    Dim KeyValType As Long  'レジストリ キーのデータ型
    Dim tmpVal As String    ' レジストリ キー値の一時保存用変数
    Dim KeyValSize As Long  ' レジストリ キー変数のサイズ
    '------------------------------------------------------------
    ' ルート キー {HKEY_LOCAL_MACHINE...} にあるレジストリ キーを開きます。
    '------------------------------------------------------------
    ' レジストリ キーを開く
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey)
    
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' ハンドル エラー...
    
    tmpVal = String$(1024, 0)                      ' 変数領域の割り当て
    KeyValSize = 1024                              ' 変数のサイズを記憶

    '------------------------------------------------------------
    ' レジストリ キー値を取得します...
    '------------------------------------------------------------
    ' キー値の取得/作成
    rc = RegQueryValueEx(hkey, SubKeyRef, 0, _
                         KeyValType, tmpVal, KeyValSize)
                        
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError  ' ハンドル エラー
    ' Win95 は Null で終わる文字列を追加します...
    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
        ' Null が見つかったら、文字列から抽出します。
        tmpVal = Left(tmpVal, KeyValSize - 1)
    ' WinNT は Null で終わる文字列を使用しません...
    Else
        ' Null が見つからなかったら、文字列のみを抽出します。
        tmpVal = Left(tmpVal, KeyValSize)
    End If
    '------------------------------------------------------------
    ' 変換のために、キー値の型を調べます...
    '------------------------------------------------------------
    Select Case KeyValType   ' データ型検索...
    Case REG_SZ              ' String レジストリ キー データ型
        KeyVal = tmpVal      ' String 値をコピー
    Case REG_DWORD           ' Double Word レジストリ キー データ型
        For i = Len(tmpVal) To 1 Step -1  ' 各ビットの変換
            ' Char ごとに値を作成
            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
        Next
        KeyVal = Format$("&h" + KeyVal)   ' Double Word を String に変換
    End Select
    
    GetKeyValue = True      ' 正常終了
    rc = RegCloseKey(hkey)  ' レジストリ キーをクローズ
    Exit Function           ' 終了
    
GetKeyError:      ' ｴﾗｰ発生後の後始末...
    KeyVal = ""             ' 戻り値の値を空文字列に設定
    GetKeyValue = False     ' 異常終了
    rc = RegCloseKey(hkey)  ' レジストリ キーをクローズ
End Function


Private Sub Command1_Click()
    Call StartSysInfo
End Sub