home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 6 Unleashed…sional Reference Edition) / Visual_Basic_6_Unleashed_Professional_Reference_Edition_Sams_1999.iso / Source / CHAP05 / LBABOUT.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-05-27  |  9.6 KB  |  228 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About LightButton"
  5.    ClientHeight    =   3015
  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     =   2081.007
  14.    ScaleMode       =   0  'User
  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         =   "LBAbout.frx":0000
  23.       ScaleHeight     =   337.12
  24.       ScaleMode       =   0  'User
  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            =   4245
  36.       TabIndex        =   0
  37.       Top             =   2040
  38.       Width           =   1260
  39.    End
  40.    Begin VB.CommandButton cmdSysInfo 
  41.       Caption         =   "&System Info..."
  42.       Height          =   345
  43.       Left            =   4260
  44.       TabIndex        =   2
  45.       Top             =   2520
  46.       Width           =   1245
  47.    End
  48.    Begin VB.Line Line1 
  49.       BorderColor     =   &H00808080&
  50.       BorderStyle     =   6  'Inside Solid
  51.       Index           =   1
  52.       X1              =   84.515
  53.       X2              =   5309.398
  54.       Y1              =   1325.218
  55.       Y2              =   1325.218
  56.    End
  57.    Begin VB.Label lblDescription 
  58.       Caption         =   "From the Sams Publishing book, ""Visual Basic 6 Unleashed""."
  59.       BeginProperty Font 
  60.          Name            =   "MS Sans Serif"
  61.          Size            =   9.75
  62.          Charset         =   0
  63.          Weight          =   700
  64.          Underline       =   0   'False
  65.          Italic          =   0   'False
  66.          Strikethrough   =   0   'False
  67.       EndProperty
  68.       ForeColor       =   &H00000000&
  69.       Height          =   690
  70.       Left            =   1050
  71.       TabIndex        =   3
  72.       Top             =   1125
  73.       Width           =   3885
  74.    End
  75.    Begin VB.Label lblTitle 
  76.       Caption         =   "LightButton"
  77.       BeginProperty Font 
  78.          Name            =   "MS Sans Serif"
  79.          Size            =   18
  80.          Charset         =   0
  81.          Weight          =   700
  82.          Underline       =   0   'False
  83.          Italic          =   -1  'True
  84.          Strikethrough   =   0   'False
  85.       EndProperty
  86.       ForeColor       =   &H00000000&
  87.       Height          =   480
  88.       Left            =   1050
  89.       TabIndex        =   5
  90.       Top             =   240
  91.       Width           =   3885
  92.    End
  93.    Begin VB.Line Line1 
  94.       BorderColor     =   &H00FFFFFF&
  95.       BorderWidth     =   2
  96.       Index           =   0
  97.       X1              =   98.6
  98.       X2              =   5309.398
  99.       Y1              =   1325.218
  100.       Y2              =   1325.218
  101.    End
  102.    Begin VB.Label lblVersion 
  103.       Caption         =   "Version 1.0"
  104.       Height          =   225
  105.       Left            =   1050
  106.       TabIndex        =   6
  107.       Top             =   780
  108.       Width           =   3885
  109.    End
  110.    Begin VB.Label lblDisclaimer 
  111.       Caption         =   "If you want a copy of the control, just buy the book!"
  112.       ForeColor       =   &H00000000&
  113.       Height          =   345
  114.       Left            =   240
  115.       TabIndex        =   4
  116.       Top             =   2280
  117.       Width           =   3870
  118.    End
  119. Attribute VB_Name = "frmAbout"
  120. Attribute VB_GlobalNameSpace = False
  121. Attribute VB_Creatable = False
  122. Attribute VB_PredeclaredId = True
  123. Attribute VB_Exposed = False
  124. Option Explicit
  125. ' Reg Key Security Options...
  126. Const READ_CONTROL = &H20000
  127. Const KEY_QUERY_VALUE = &H1
  128. Const KEY_SET_VALUE = &H2
  129. Const KEY_CREATE_SUB_KEY = &H4
  130. Const KEY_ENUMERATE_SUB_KEYS = &H8
  131. Const KEY_NOTIFY = &H10
  132. Const KEY_CREATE_LINK = &H20
  133. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  134.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  135.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  136.                      
  137. ' Reg Key ROOT Types...
  138. Const HKEY_LOCAL_MACHINE = &H80000002
  139. Const ERROR_SUCCESS = 0
  140. Const REG_SZ = 1                         ' Unicode nul terminated string
  141. Const REG_DWORD = 4                      ' 32-bit number
  142. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  143. Const gREGVALSYSINFOLOC = "MSINFO"
  144. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  145. Const gREGVALSYSINFO = "PATH"
  146. 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
  147. 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
  148. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  149. Private Sub cmdSysInfo_Click()
  150.   Call StartSysInfo
  151. End Sub
  152. Private Sub cmdOK_Click()
  153.   Unload Me
  154. End Sub
  155. Private Sub Form_Load()
  156.     Me.Caption = "About " & App.Title
  157.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  158.     lblTitle.Caption = App.Title
  159. End Sub
  160. Public Sub StartSysInfo()
  161.     On Error GoTo SysInfoErr
  162.     Dim rc As Long
  163.     Dim SysInfoPath As String
  164.     ' Try To Get System Info Program Path\Name From Registry...
  165.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  166.     ' Try To Get System Info Program Path Only From Registry...
  167.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  168.         ' Validate Existance Of Known 32 Bit File Version
  169.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  170.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  171.             
  172.         ' Error - File Can Not Be Found...
  173.         Else
  174.             GoTo SysInfoErr
  175.         End If
  176.     ' Error - Registry Entry Can Not Be Found...
  177.     Else
  178.         GoTo SysInfoErr
  179.     End If
  180.     Call Shell(SysInfoPath, vbNormalFocus)
  181.     Exit Sub
  182. SysInfoErr:
  183.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  184. End Sub
  185. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  186.     Dim i As Long                                           ' Loop Counter
  187.     Dim rc As Long                                          ' Return Code
  188.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  189.     Dim hDepth As Long                                      '
  190.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  191.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  192.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  193.     '------------------------------------------------------------
  194.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  195.     '------------------------------------------------------------
  196.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  197.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  198.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  199.     KeyValSize = 1024                                       ' Mark Variable Size
  200.     '------------------------------------------------------------
  201.     ' Retrieve Registry Key Value...
  202.     '--------------------------------------------------
  203.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  204.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  205.                         
  206.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  207.     tmpVal = Left(tmpVal, InStr(tmpVal, Chr(0)) - 1)
  208.     '------------------------------------------------------------
  209.     ' Determine Key Value Type For Conversion...
  210.     '------------------------------------------------------------
  211.     Select Case KeyValType                                  ' Search Data Types...
  212.     Case REG_SZ                                             ' String Registry Key Data Type
  213.         KeyVal = tmpVal                                     ' Copy String Value
  214.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  215.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  216.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  217.         Next
  218.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  219.     End Select
  220.     GetKeyValue = True                                      ' Return Success
  221.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  222.     Exit Function                                           ' Exit
  223. GetKeyError:      ' Cleanup After An Error Has Occured...
  224.     KeyVal = ""                                             ' Set Return Val To Empty String
  225.     GetKeyValue = False                                     ' Return Failure
  226.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  227. End Function
  228.