好简单，怎样调用“系统信息”和“计算器”!!!

Question

计算器程序可以直接用shell调用。
以下是系统信息程序：
' 注册键安全选项...
Const KEY_ALL_ACCESS = &H2003F
                                          ' 注册键根类型...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' 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 LongPrivate Sub command1_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          ' 错误处理
              tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
        '------------------------------------------------------------
        ' 决定转换的键值类型...
        '------------------------------------------------------------
        Select Case KeyValType                                  ' 搜索数据类型...
        Case REG_SZ                                             ' 字符串注册表键数据类型
                KeyVal = tmpVal                                     ' 复制字符串值
        Case REG_DWORD                                          ' 双精度注册表键数据类型
                For i = Len(tmpVal) To 1 Step -1                    ' 转换每一页
                        KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' 一个字符一个字符地生成值
                Next
                KeyVal = Format$("&h" + KeyVal)                     ' 转换双精度为字符串
        End Select
                GetKeyValue = True                                      ' 返回成功
        rc = RegCloseKey(hKey)                                  ' 关闭注册表键
        Exit Function                                           ' 退出
        GetKeyError:    ' Cleanup After An Error Has Occured...
        KeyVal = ""                                             ' 设返回值为空字符串
        GetKeyValue = False                                     ' 返回失败
        rc = RegCloseKey(hKey)                                  ' 关闭注册表键
End Function

Answer 1

Private Sub cmdSysInfo_Click()
        Call StartSysInfo   '调用显示系统信息
End Sub
Public Sub StartSysInfo()
    On Error GoTo SysInfoErr
        Dim rc As Long
        Dim SysInfoPath As String
                ' Try To Get System Info Program Path\Name From Registry...
        If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
        ' Try To Get System Info Program Path Only From Registry...
        ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
                ' Validate Existance Of Known 32 Bit File Version
                If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
                        SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
                                        ' Error - File Can Not Be Found...
                Else
                        GoTo SysInfoErr
                End If
        ' Error - Registry Entry Can Not Be Found...
        Else
                GoTo SysInfoErr
        End If
                Call Shell(SysInfoPath, vbNormalFocus)
                Exit Sub
SysInfoErr:
        MsgBox "System Information Is Unavailable At This Time", 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                                           ' Loop Counter
        Dim rc As Long                                          ' Return Code
        Dim hKey As Long                                        ' Handle To An Open Registry Key
        Dim hDepth As Long                                      '
        Dim KeyValType As Long                                  ' Data Type Of A Registry Key
        Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
        Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
        '------------------------------------------------------------
        ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
        '------------------------------------------------------------
        rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
                If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
                tmpVal = String$(1024, 0)                             ' Allocate Variable Space
        KeyValSize = 1024                                       ' Mark Variable Size
                '------------------------------------------------------------
        ' Retrieve Registry Key Value...
        '------------------------------------------------------------
        rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
                                                        If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
                tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
        '------------------------------------------------------------
        ' Determine Key Value Type For Conversion...
        '------------------------------------------------------------
        Select Case KeyValType                                  ' Search Data Types...
        Case REG_SZ                                             ' String Registry Key Data Type
                KeyVal = tmpVal                                     ' Copy String Value
        Case REG_DWORD                                          ' Double Word Registry Key Data Type
                For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
                        KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
                Next
                KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
        End Select
                GetKeyValue = True                                      ' Return Success
        rc = RegCloseKey(hKey)                                  ' Close Registry Key
        Exit Function                                           ' Exit
        GetKeyError:    ' Cleanup After An Error Has Occured...
        KeyVal = ""                                             ' Set Return Val To Empty String
        GetKeyValue = False                                     ' Return Failure
        rc = RegCloseKey(hKey)                                  ' Close Registry Key
End Function

Answer 2

呵呵加上这个声明吧' Reg Key Security Options...
Const KEY_ALL_ACCESS = &H2003F
                                          ' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' Unicode nul terminated string
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 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