Option Strict Off
Option Explicit On
Module Module1
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA"(ByVal hKey As Integer, ByVal lpSubKey As String, ByVal ulOptions As Integer, ByVal samDesired As Integer, ByRef phkResult As Integer) As Integer '打开一个注册表项
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA"(ByVal hKey As Integer, ByVal lpValueName As String, ByVal lpReserved As Integer, ByRef lpType As Integer, ByVal lpData As String, ByRef lpcbData As Integer) As Integer '读取一个注册表项的值
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Integer) As Integer'关闭一个注册表项
Const HKEY_LOCAL_MACHINE As Integer = &H80000002
Const gREGKEYSYSINFOLOC As String = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC As String = "MSINFO"
Const gREGKEYSYSINFO As String = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO As String = "PATH"
Const KEY_ALL_ACCESS As Integer = &H2003F
Const ERROR_SUCCESS As Short = 0
Const REG_SZ As Short = 1
Const REG_DWORD As Short = 4
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Integer
Dim SysInfoPath As String
' 从一个注册表项中获得系统信息的路径
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' 一个有效的32位文件的版本
'UPGRADE_WARNING: Dir 有新行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1041"'
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
'获得MSINFO32.EXE的路径
SysInfoPath = SysInfoPath & "\MSINFO32.EXE "
Else
GoTo SysInfoErr '如果没有找到该文件转到执行子程序
End If
Else
GoTo SysInfoErr ' 如果没有找到注册表
End If
Call Shell(SysInfoPath, AppWinStyle.NormalFocus)
Exit Sub
SysInfoErr:
MsgBox("找不到系统信息浏览器", MsgBoxStyle.OKOnly)
End Sub
Public Function GetKeyValue(ByRef KeyRoot As Integer, ByRef KeyName As String, ByRef SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Integer ' 循环记数
Dim rc As Integer ' 返回注册表函数的值
Dim hKey As Integer ' 装载打开项名字的变量
Dim hDepth As Integer '
Dim KeyValType As Integer ' 装载取回值的数据类型的变量
Dim tmpVal As String ' 装载指定值的一个缓冲区
Dim KeyValSize As Integer ' 返回缓冲区内的实际字节数
'------------------------------------------------------------
' 打开 注册表 子项 {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表子项
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 注册表打开错误...
GetKeyError: '清除之后发生错误
KeyVal = "" ' 设置一个空的字符串
GetKeyValue = False ' 返回失败
rc = RegCloseKey(hKey) ' 关闭注册表子项
End Function
End Module
Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
Call StartSysInfo()
End Sub
在VS.NET2002+WIN2000SERVER测试通过!
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA"(ByVal hWnd As Integer, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Integer) As Integer '调用系统关于窗体