home *** CD-ROM | disk | FTP | other *** search
/ Total C++ 2 / TOTALCTWO.iso / vb5.0 / tools / unsupprt / calendar / about.frm (.txt) next >
Visual Basic Form  |  1997-01-16  |  10KB  |  217 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About MyApp"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   4215
  7.    ClientTop       =   1920
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    Icon            =   "About.frx":0000
  11.    LinkTopic       =   "Form2"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   2453.724
  16.    ScaleMode       =   0  'User
  17.    ScaleWidth      =   5380.766
  18.    ShowInTaskbar   =   0   'False
  19.    StartUpPosition =   2  'CenterScreen
  20.    Begin VB.PictureBox picIcon 
  21.       AutoSize        =   -1  'True
  22.       BackColor       =   &H00C0C0C0&
  23.       ClipControls    =   0   'False
  24.       Height          =   540
  25.       Left            =   240
  26.       Picture         =   "About.frx":030A
  27.       ScaleHeight     =   337.12
  28.       ScaleMode       =   0  'User
  29.       ScaleWidth      =   337.12
  30.       TabIndex        =   1
  31.       Top             =   240
  32.       Width           =   540
  33.    End
  34.    Begin VB.CommandButton cmdOK 
  35.       Cancel          =   -1  'True
  36.       Caption         =   "OK"
  37.       Default         =   -1  'True
  38.       Height          =   345
  39.       Left            =   4245
  40.       TabIndex        =   0
  41.       Top             =   2625
  42.       Width           =   1260
  43.    End
  44.    Begin VB.CommandButton cmdSysInfo 
  45.       Caption         =   "&System Info..."
  46.       Height          =   345
  47.       Left            =   4260
  48.       TabIndex        =   2
  49.       Top             =   3075
  50.       Width           =   1245
  51.    End
  52.    Begin VB.Line Line1 
  53.       BorderColor     =   &H00808080&
  54.       BorderStyle     =   6  'Inside Solid
  55.       Index           =   1
  56.       X1              =   84.515
  57.       X2              =   5309.398
  58.       Y1              =   1687.583
  59.       Y2              =   1687.583
  60.    End
  61.    Begin VB.Label lblDescription 
  62.       Caption         =   $"About.frx":0614
  63.       ForeColor       =   &H00000000&
  64.       Height          =   1170
  65.       Left            =   1050
  66.       TabIndex        =   3
  67.       Top             =   1125
  68.       Width           =   3885
  69.    End
  70.    Begin VB.Label lblTitle 
  71.       Caption         =   "Microsoft Visual Basic Calendar Control"
  72.       ForeColor       =   &H00000000&
  73.       Height          =   480
  74.       Left            =   1050
  75.       TabIndex        =   5
  76.       Top             =   240
  77.       Width           =   3885
  78.    End
  79.    Begin VB.Line Line1 
  80.       BorderColor     =   &H00FFFFFF&
  81.       BorderWidth     =   2
  82.       Index           =   0
  83.       X1              =   98.6
  84.       X2              =   5309.398
  85.       Y1              =   1697.936
  86.       Y2              =   1697.936
  87.    End
  88.    Begin VB.Label lblVersion 
  89.       Caption         =   "Version"
  90.       Height          =   225
  91.       Left            =   1050
  92.       TabIndex        =   6
  93.       Top             =   780
  94.       Width           =   3885
  95.    End
  96.    Begin VB.Label lblDisclaimer 
  97.       Caption         =   $"About.frx":06E1
  98.       ForeColor       =   &H00000000&
  99.       Height          =   825
  100.       Left            =   255
  101.       TabIndex        =   4
  102.       Top             =   2625
  103.       Width           =   3870
  104.    End
  105. Attribute VB_Name = "frmAbout"
  106. Attribute VB_GlobalNameSpace = False
  107. Attribute VB_Creatable = False
  108. Attribute VB_PredeclaredId = True
  109. Attribute VB_Exposed = False
  110. Option Explicit
  111. ' Reg Key Security Options...
  112. Const READ_CONTROL = &H20000
  113. Const KEY_QUERY_VALUE = &H1
  114. Const KEY_SET_VALUE = &H2
  115. Const KEY_CREATE_SUB_KEY = &H4
  116. Const KEY_ENUMERATE_SUB_KEYS = &H8
  117. Const KEY_NOTIFY = &H10
  118. Const KEY_CREATE_LINK = &H20
  119. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  120.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  121.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  122.                      
  123. ' Reg Key ROOT Types...
  124. Const HKEY_LOCAL_MACHINE = &H80000002
  125. Const ERROR_SUCCESS = 0
  126. Const REG_SZ = 1                         ' Unicode nul terminated string
  127. Const REG_DWORD = 4                      ' 32-bit number
  128. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  129. Const gREGVALSYSINFOLOC = "MSINFO"
  130. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  131. Const gREGVALSYSINFO = "PATH"
  132. 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
  133. 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
  134. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  135. Private Sub cmdSysInfo_Click()
  136.   Call StartSysInfo
  137. End Sub
  138. Private Sub cmdOK_Click()
  139.   Unload Me
  140. End Sub
  141. Private Sub Form_Load()
  142.     Me.Caption = "About the VB Calendar Control"
  143.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  144. End Sub
  145. Public Sub StartSysInfo()
  146.     On Error GoTo SysInfoErr
  147.     Dim rc As Long
  148.     Dim SysInfoPath As String
  149.     ' Try To Get System Info Program Path\Name From Registry...
  150.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  151.     ' Try To Get System Info Program Path Only From Registry...
  152.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  153.         ' Validate Existance Of Known 32 Bit File Version
  154.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  155.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  156.             
  157.         ' Error - File Can Not Be Found...
  158.         Else
  159.             GoTo SysInfoErr
  160.         End If
  161.     ' Error - Registry Entry Can Not Be Found...
  162.     Else
  163.         GoTo SysInfoErr
  164.     End If
  165.     Call Shell(SysInfoPath, vbNormalFocus)
  166.     Exit Sub
  167. SysInfoErr:
  168.     MsgBox "System Information Is Unavailable At This Time", 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                                           ' Loop Counter
  172.     Dim rc As Long                                          ' Return Code
  173.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  174.     Dim hDepth As Long                                      '
  175.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  176.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  177.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  178.     '------------------------------------------------------------
  179.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  180.     '------------------------------------------------------------
  181.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  182.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  183.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  184.     KeyValSize = 1024                                       ' Mark Variable Size
  185.     '------------------------------------------------------------
  186.     ' Retrieve Registry Key Value...
  187.     '------------------------------------------------------------
  188.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  189.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  190.                         
  191.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  192.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  193.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  194.     Else                                                    ' WinNT Does NOT Null Terminate String...
  195.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  196.     End If
  197.     '------------------------------------------------------------
  198.     ' Determine Key Value Type For Conversion...
  199.     '------------------------------------------------------------
  200.     Select Case KeyValType                                  ' Search Data Types...
  201.     Case REG_SZ                                             ' String Registry Key Data Type
  202.         KeyVal = tmpVal                                     ' Copy String Value
  203.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  204.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  205.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  206.         Next
  207.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  208.     End Select
  209.     GetKeyValue = True                                      ' Return Success
  210.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  211.     Exit Function                                           ' Exit
  212. GetKeyError:      ' Cleanup After An Error Has Occured...
  213.     KeyVal = ""                                             ' Set Return Val To Empty String
  214.     GetKeyValue = False                                     ' Return Failure
  215.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  216. End Function
  217.