|
|
VERSION 5.00Begin VB.Form frmAbout BorderStyle = 3 'Fixed Dialog Caption = "About Project1" ClientHeight = 3630 ClientLeft = 45 ClientTop = 330 ClientWidth = 5655 ClipControls = 0 'False LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3630 ScaleWidth = 5655 ShowInTaskbar = 0 'False StartUpPosition = 1 'CenterOwner Tag = "1059" Begin VB.PictureBox picIcon AutoSize = -1 'True BackColor = &H00C0C0C0& ClipControls = 0 'False Height = 540 Left = 240 Picture = "frmAbout.frx":0000 ScaleHeight = 480 ScaleMode = 0 'User ScaleWidth = 480 TabIndex = 2 TabStop = 0 'False Top = 240 Width = 540 End Begin VB.CommandButton cmdOK Cancel = -1 'True Caption = "OK" Default = -1 'True Height = 345 Left = 4245 TabIndex = 0 Tag = "1061" Top = 2625 Width = 1260 End Begin VB.CommandButton cmdSysInfo Caption = "&System Info..." Height = 345 Left = 4260 TabIndex = 1 Tag = "1060" Top = 3075 Width = 1245 End Begin VB.Label lblDescription Caption = "App Description" ForeColor = &H00000000& Height = 1170 Left = 1050 TabIndex = 6 Tag = "1065" Top = 1125 Width = 3885 End Begin VB.Label lblTitle Caption = "Visual Basic MetaEdit" ForeColor = &H00000000& Height = 480 Left = 1050 TabIndex = 5 Tag = "1064" Top = 240 Width = 3885 End Begin VB.Line Line1 BorderColor = &H00808080& BorderStyle = 6 'Inside Solid Index = 1 X1 = 225 X2 = 5450 Y1 = 2430 Y2 = 2430 End Begin VB.Line Line1 BorderColor = &H00FFFFFF& BorderWidth = 2 Index = 0 X1 = 240 X2 = 5450 Y1 = 2445 Y2 = 2445 End Begin VB.Label lblVersion Caption = "Version 1.0" Height = 225 Left = 1050 TabIndex = 4 Tag = "1063" Top = 780 Width = 3885 End Begin VB.Label lblDisclaimer Caption = "Warning: ..." ForeColor = &H00000000& Height = 825 Left = 255 TabIndex = 3 Tag = "1062" Top = 2625 Width = 3870 EndEndAttribute VB_Name = "frmAbout"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False' Reg Key Security Options...Const KEY_ALL_ACCESS = &H2003F
' Reg Key ROOT Types...Const HKEY_LOCAL_MACHINE = &H80000002Const ERROR_SUCCESS = 0Const REG_SZ = 1 ' Unicode nul terminated stringConst 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 LongPrivate 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 LongPrivate Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub Form_Load() LoadResStrings Me lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision lblTitle.Caption = App.TitleEnd Sub
Private Sub cmdSysInfo_Click() Call StartSysInfoEnd Sub
Private Sub cmdOK_Click() Unload MeEnd 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 SubSysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnlyEnd 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
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '------------------------------------------------------------ ' 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 KeyEnd Function
|
