frmAbout.frm
上传用户:zhouyf163
上传日期:2010-02-28
资源大小:80k
文件大小:8k
源码类别:

图形/文字识别

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About calculator"
  5.    ClientHeight    =   3255
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   7980
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3255
  14.    ScaleWidth      =   7980
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   1  'CenterOwner
  17.    Tag             =   "About calculator"
  18.    Begin VB.CommandButton cmdOK 
  19.       Cancel          =   -1  'True
  20.       Caption         =   "OK"
  21.       Default         =   -1  'True
  22.       Height          =   585
  23.       Left            =   5160
  24.       TabIndex        =   0
  25.       Tag             =   "OK"
  26.       Top             =   2280
  27.       Width           =   2190
  28.    End
  29.    Begin VB.Line Line2 
  30.       X1              =   3960
  31.       X2              =   7800
  32.       Y1              =   2160
  33.       Y2              =   2160
  34.    End
  35.    Begin VB.Image Image1 
  36.       Height          =   2880
  37.       Left            =   120
  38.       Picture         =   "frmAbout.frx":0000
  39.       Top             =   120
  40.       Width           =   3840
  41.    End
  42.    Begin VB.Line Line1 
  43.       BorderColor     =   &H00808080&
  44.       BorderStyle     =   6  'Inside Solid
  45.       Index           =   1
  46.       X1              =   240
  47.       X2              =   7695
  48.       Y1              =   3000
  49.       Y2              =   3000
  50.    End
  51.    Begin VB.Label lblDescription 
  52.       Alignment       =   2  'Center
  53.       Caption         =   $"frmAbout.frx":2FE0
  54.       ForeColor       =   &H00000000&
  55.       Height          =   2130
  56.       Left            =   4080
  57.       TabIndex        =   1
  58.       Tag             =   "App Description"
  59.       Top             =   360
  60.       Width           =   3735
  61.    End
  62. End
  63. Attribute VB_Name = "frmAbout"
  64. Attribute VB_GlobalNameSpace = False
  65. Attribute VB_Creatable = False
  66. Attribute VB_PredeclaredId = True
  67. Attribute VB_Exposed = False
  68. ' Reg Key Security Options...
  69. Const KEY_ALL_ACCESS = &H2003F
  70.                                           
  71. ' Reg Key ROOT Types...
  72. Const HKEY_LOCAL_MACHINE = &H80000002
  73. Const ERROR_SUCCESS = 0
  74. Const REG_SZ = 1                         ' Unicode nul terminated string
  75. Const REG_DWORD = 4                      ' 32-bit number
  76. Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
  77. Const gREGVALSYSINFOLOC = "MSINFO"
  78. Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
  79. Const gREGVALSYSINFO = "PATH"
  80. 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
  81. 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
  82. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  83. Private Sub cmdOK_Click()
  84.         Unload Me
  85. End Sub
  86. Public Sub StartSysInfo()
  87.     On Error GoTo SysInfoErr
  88.         Dim rc As Long
  89.         Dim SysInfoPath As String
  90.         
  91.         ' Try To Get System Info Program PathName From Registry...
  92.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  93.         ' Try To Get System Info Program Path Only From Registry...
  94.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  95.                 ' Validate Existance Of Known 32 Bit File Version
  96.                 If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
  97.                         SysInfoPath = SysInfoPath & "MSINFO32.EXE"
  98.                         
  99.                 ' Error - File Can Not Be Found...
  100.                 Else
  101.                         GoTo SysInfoErr
  102.                 End If
  103.         ' Error - Registry Entry Can Not Be Found...
  104.         Else
  105.                 GoTo SysInfoErr
  106.         End If
  107.         
  108.         Call Shell(SysInfoPath, vbNormalFocus)
  109.         
  110.         Exit Sub
  111. SysInfoErr:
  112.         MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  113. End Sub
  114. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  115.         Dim i As Long                                           ' Loop Counter
  116.         Dim rc As Long                                          ' Return Code
  117.         Dim hKey As Long                                        ' Handle To An Open Registry Key
  118.         Dim hDepth As Long                                      '
  119.         Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  120.         Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  121.         Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  122.         '------------------------------------------------------------
  123.         ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  124.         '------------------------------------------------------------
  125.         rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  126.         
  127.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  128.         
  129.         tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  130.         KeyValSize = 1024                                       ' Mark Variable Size
  131.         
  132.         '------------------------------------------------------------
  133.         ' Retrieve Registry Key Value...
  134.         '------------------------------------------------------------
  135.         rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  136.                                                 
  137.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  138.         
  139.         tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
  140.         '------------------------------------------------------------
  141.         ' Determine Key Value Type For Conversion...
  142.         '------------------------------------------------------------
  143.         Select Case KeyValType                                  ' Search Data Types...
  144.         Case REG_SZ                                             ' String Registry Key Data Type
  145.                 KeyVal = tmpVal                                     ' Copy String Value
  146.         Case REG_DWORD                                          ' Double Word Registry Key Data Type
  147.                 For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  148.                         KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  149.                 Next
  150.                 KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  151.         End Select
  152.         
  153.         GetKeyValue = True                                      ' Return Success
  154.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  155.         Exit Function                                           ' Exit
  156.         
  157. GetKeyError:    ' Cleanup After An Error Has Occured...
  158.         KeyVal = ""                                             ' Set Return Val To Empty String
  159.         GetKeyValue = False                                     ' Return Failure
  160.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  161. End Function