home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1999 February / VPR9902A.BIN / Vpr_data / Program / vb / prog / frmAbout.frm (.txt) < prev    next >
Visual Basic Form  |  1998-11-17  |  9KB  |  215 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  '
  4.    Caption         =   "
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2453.724
  14.    ScaleMode       =   0  '
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.PictureBox picIcon 
  18.       AutoSize        =   -1  'True
  19.       ClipControls    =   0   'False
  20.       Height          =   540
  21.       Left            =   240
  22.       Picture         =   "frmAbout.frx":0000
  23.       ScaleHeight     =   337.12
  24.       ScaleMode       =   0  '
  25.       ScaleWidth      =   337.12
  26.       TabIndex        =   1
  27.       Top             =   240
  28.       Width           =   540
  29.    End
  30.    Begin VB.CommandButton cmdOK 
  31.       Cancel          =   -1  'True
  32.       Caption         =   "OK"
  33.       Default         =   -1  'True
  34.       Height          =   345
  35.       Left            =   4260
  36.       TabIndex        =   0
  37.       Top             =   2625
  38.       Width           =   1310
  39.    End
  40.    Begin VB.CommandButton cmdSysInfo 
  41.       Caption         =   "
  42. (&S)..."
  43.       Height          =   345
  44.       Left            =   4260
  45.       TabIndex        =   2
  46.       Top             =   3075
  47.       Width           =   1310
  48.    End
  49.    Begin VB.Line Line1 
  50.       BorderColor     =   &H00808080&
  51.       BorderStyle     =   6  '
  52.       Index           =   1
  53.       X1              =   84.515
  54.       X2              =   5309.398
  55.       Y1              =   1687.583
  56.       Y2              =   1687.583
  57.    End
  58.    Begin VB.Label lblDescription 
  59.       Caption         =   "
  60.       ForeColor       =   &H00000000&
  61.       Height          =   1170
  62.       Left            =   1050
  63.       TabIndex        =   3
  64.       Top             =   1125
  65.       Width           =   3885
  66.    End
  67.    Begin VB.Label lblTitle 
  68.       Caption         =   "
  69.       ForeColor       =   &H00000000&
  70.       Height          =   480
  71.       Left            =   1050
  72.       TabIndex        =   5
  73.       Top             =   240
  74.       Width           =   3885
  75.    End
  76.    Begin VB.Line Line1 
  77.       BorderColor     =   &H00FFFFFF&
  78.       BorderWidth     =   2
  79.       Index           =   0
  80.       X1              =   98.6
  81.       X2              =   5309.398
  82.       Y1              =   1697.936
  83.       Y2              =   1697.936
  84.    End
  85.    Begin VB.Label lblVersion 
  86.       Caption         =   "
  87.       Height          =   225
  88.       Left            =   1050
  89.       TabIndex        =   6
  90.       Top             =   780
  91.       Width           =   3885
  92.    End
  93.    Begin VB.Label lblDisclaimer 
  94.       Caption         =   "
  95. : ..."
  96.       ForeColor       =   &H00000000&
  97.       Height          =   825
  98.       Left            =   255
  99.       TabIndex        =   4
  100.       Top             =   2625
  101.       Width           =   3870
  102.    End
  103. Attribute VB_Name = "frmAbout"
  104. Attribute VB_GlobalNameSpace = False
  105. Attribute VB_Creatable = False
  106. Attribute VB_PredeclaredId = True
  107. Attribute VB_Exposed = False
  108. Option Explicit
  109. Const READ_CONTROL = &H20000
  110. Const KEY_QUERY_VALUE = &H1
  111. Const KEY_SET_VALUE = &H2
  112. Const KEY_CREATE_SUB_KEY = &H4
  113. Const KEY_ENUMERATE_SUB_KEYS = &H8
  114. Const KEY_NOTIFY = &H10
  115. Const KEY_CREATE_LINK = &H20
  116. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  117.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  118.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  119.                      
  120.  ROOT 
  121. Const HKEY_LOCAL_MACHINE = &H80000002
  122. Const ERROR_SUCCESS = 0
  123. Const REG_SZ = 1                         ' Unicode Null 
  124. Const REG_DWORD = 4                      ' 32 
  125. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  126. Const gREGVALSYSINFOLOC = "MSINFO"
  127. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  128. Const gREGVALSYSINFO = "PATH"
  129. 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
  130. 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
  131. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  132. Private Sub cmdSysInfo_Click()
  133.   Call StartSysInfo
  134. End Sub
  135. Private Sub cmdOK_Click()
  136.   Unload Me
  137. End Sub
  138. Private Sub Form_Load()
  139.     Me.Caption = App.Title & "
  140.     lblVersion.Caption = "
  141.  " & App.Major & "." & App.Minor & "." & App.Revision
  142.     lblTitle.Caption = App.Title
  143. End Sub
  144. Public Sub StartSysInfo()
  145.     On Error GoTo SysInfoErr
  146.     Dim rc As Long
  147.     Dim SysInfoPath As String
  148.     ' 
  149.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  150.     ' 
  151.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  152.         ' 
  153.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  154.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  155.             
  156.         ' 
  157.         Else
  158.             GoTo SysInfoErr
  159.         End If
  160.     ' 
  161.     Else
  162.         GoTo SysInfoErr
  163.     End If
  164.     Call Shell(SysInfoPath, vbNormalFocus)
  165.     Exit Sub
  166. SysInfoErr:
  167.     MsgBox "
  168. ", vbOKOnly
  169. End Sub
  170. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  171.     Dim i As Long                                           ' 
  172.     Dim rc As Long                                          ' 
  173.     Dim hKey As Long                                        ' 
  174.     Dim hDepth As Long                                      '
  175.     Dim KeyValType As Long                                  ' 
  176.     Dim tmpVal As String                                    ' 
  177.     Dim KeyValSize As Long                                  ' 
  178.     '------------------------------------------------------------
  179.     ' 
  180.  {HKEY_LOCAL_MACHINE...} 
  181.     '------------------------------------------------------------
  182.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 
  183.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 
  184.     tmpVal = String$(1024, 0)                             ' 
  185.     KeyValSize = 1024                                       ' 
  186.     '------------------------------------------------------------
  187.     ' 
  188.     '------------------------------------------------------------
  189.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  190.                          KeyValType, tmpVal, KeyValSize)    ' 
  191.                         
  192.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 
  193.     tmpVal = Left(tmpVal, InStr(tmpVal, Chr(0)) - 1)
  194.     '------------------------------------------------------------
  195.     ' 
  196.     '------------------------------------------------------------
  197.     Select Case KeyValType                                  ' 
  198.     Case REG_SZ                                             ' String 
  199.         KeyVal = tmpVal                                     ' String 
  200.     Case REG_DWORD                                          ' Double Word 
  201.         For i = Len(tmpVal) To 1 Step -1                    ' 
  202.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Char 
  203.         Next
  204.         KeyVal = Format$("&h" + KeyVal)                     ' Double Word 
  205.  String 
  206.     End Select
  207.     GetKeyValue = True                                      ' 
  208.     rc = RegCloseKey(hKey)                                  ' 
  209.     Exit Function                                           ' 
  210. GetKeyError:      ' 
  211.     KeyVal = ""                                             ' 
  212.     GetKeyValue = False                                     ' 
  213.     rc = RegCloseKey(hKey)                                  ' 
  214. End Function
  215.