frmAbout.frm
上传用户:xiao_xia32
上传日期:2022-07-21
资源大小:1174k
文件大小:10k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX"
  3. Begin VB.Form frmAbout 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "人事管理系统"
  6.    ClientHeight    =   3075
  7.    ClientLeft      =   3165
  8.    ClientTop       =   3210
  9.    ClientWidth     =   5940
  10.    ClipControls    =   0   'False
  11.    Icon            =   "frmAbout.frx":0000
  12.    LinkTopic       =   "Form2"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    Moveable        =   0   'False
  16.    ScaleHeight     =   2122.419
  17.    ScaleMode       =   0  'User
  18.    ScaleWidth      =   5577.967
  19.    ShowInTaskbar   =   0   'False
  20.    Begin Threed.SSCommand cmdOK 
  21.       Height          =   345
  22.       Left            =   4200
  23.       TabIndex        =   6
  24.       Top             =   1800
  25.       Width           =   1500
  26.       _Version        =   65536
  27.       _ExtentX        =   2646
  28.       _ExtentY        =   609
  29.       _StockProps     =   78
  30.       Caption         =   "确   定"
  31.       Font3D          =   1
  32.    End
  33.    Begin VB.PictureBox Picture1 
  34.       Appearance      =   0  'Flat
  35.       BackColor       =   &H80000005&
  36.       BorderStyle     =   0  'None
  37.       ForeColor       =   &H80000008&
  38.       Height          =   495
  39.       Left            =   240
  40.       Picture         =   "frmAbout.frx":0CCA
  41.       ScaleHeight     =   495
  42.       ScaleWidth      =   495
  43.       TabIndex        =   5
  44.       Top             =   240
  45.       Width           =   495
  46.    End
  47.    Begin Threed.SSCommand cmdSysInfo 
  48.       Height          =   345
  49.       Left            =   4200
  50.       TabIndex        =   7
  51.       Top             =   2280
  52.       Width           =   1500
  53.       _Version        =   65536
  54.       _ExtentX        =   2646
  55.       _ExtentY        =   609
  56.       _StockProps     =   78
  57.       Caption         =   "系统信息(&S)..."
  58.       Font3D          =   1
  59.    End
  60.    Begin VB.Label Label1 
  61.       Caption         =   "版权所有:"
  62.       Height          =   255
  63.       Left            =   2760
  64.       TabIndex        =   4
  65.       Top             =   1200
  66.       Width           =   975
  67.    End
  68.    Begin VB.Line Line1 
  69.       BorderColor     =   &H00808080&
  70.       BorderStyle     =   6  'Inside Solid
  71.       Index           =   1
  72.       X1              =   112.686
  73.       X2              =   5337.57
  74.       Y1              =   1159.565
  75.       Y2              =   1159.565
  76.    End
  77.    Begin VB.Label lblDescription 
  78.       Caption         =   "海山科技公司"
  79.       ForeColor       =   &H00000000&
  80.       Height          =   330
  81.       Left            =   3720
  82.       TabIndex        =   0
  83.       Top             =   1200
  84.       Width           =   3885
  85.    End
  86.    Begin VB.Label lblTitle 
  87.       Caption         =   "人事信息管理"
  88.       BeginProperty Font 
  89.          Name            =   "宋体"
  90.          Size            =   12
  91.          Charset         =   134
  92.          Weight          =   700
  93.          Underline       =   0   'False
  94.          Italic          =   0   'False
  95.          Strikethrough   =   0   'False
  96.       EndProperty
  97.       ForeColor       =   &H00000000&
  98.       Height          =   360
  99.       Left            =   2760
  100.       TabIndex        =   2
  101.       Top             =   240
  102.       Width           =   3885
  103.    End
  104.    Begin VB.Line Line1 
  105.       BorderColor     =   &H00FFFFFF&
  106.       BorderWidth     =   2
  107.       Index           =   0
  108.       X1              =   112.686
  109.       X2              =   5323.484
  110.       Y1              =   1159.565
  111.       Y2              =   1159.565
  112.    End
  113.    Begin VB.Label lblVersion 
  114.       Caption         =   "版本   V 1.0.1"
  115.       Height          =   225
  116.       Left            =   2760
  117.       TabIndex        =   3
  118.       Top             =   720
  119.       Width           =   3885
  120.    End
  121.    Begin VB.Label lblDisclaimer 
  122.       Caption         =   $"frmAbout.frx":0FD4
  123.       ForeColor       =   &H00000000&
  124.       Height          =   1065
  125.       Left            =   240
  126.       TabIndex        =   1
  127.       Top             =   1800
  128.       Width           =   3870
  129.    End
  130. End
  131. Attribute VB_Name = "frmAbout"
  132. Attribute VB_GlobalNameSpace = False
  133. Attribute VB_Creatable = False
  134. Attribute VB_PredeclaredId = True
  135. Attribute VB_Exposed = False
  136. Option Explicit
  137. ' 注册表关键字安全选项...
  138. Const READ_CONTROL = &H20000
  139. Const KEY_QUERY_VALUE = &H1
  140. Const KEY_SET_VALUE = &H2
  141. Const KEY_CREATE_SUB_KEY = &H4
  142. Const KEY_ENUMERATE_SUB_KEYS = &H8
  143. Const KEY_NOTIFY = &H10
  144. Const KEY_CREATE_LINK = &H20
  145. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  146.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  147.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  148.                      
  149. ' 注册表关键字 ROOT 类型...
  150. Const HKEY_LOCAL_MACHINE = &H80000002
  151. Const ERROR_SUCCESS = 0
  152. Const REG_SZ = 1                         ' 独立的空的终结字符串
  153. Const REG_DWORD = 4                      ' 32位数字
  154. Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
  155. Const gREGVALSYSINFOLOC = "MSINFO"
  156. Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
  157. Const gREGVALSYSINFO = "PATH"
  158. 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
  159. 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
  160. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  161. Private Sub cmdSysInfo_Click()
  162.   Call StartSysInfo
  163. End Sub
  164. Private Sub cmdOK_Click()
  165.   Unload Me
  166. End Sub
  167. Private Sub Form_Load()
  168.     Me.Caption = "人事信息管理系统"
  169.     lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision
  170.     lblTitle.Caption = "人事信息管理系统"
  171. End Sub
  172. Public Sub StartSysInfo()
  173.     On Error GoTo SysInfoErr
  174.   
  175.     Dim rc As Long
  176.     Dim SysInfoPath As String
  177.     
  178.     ' 试图从注册表中获得系统信息程序的路径及名称...
  179.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  180.     ' 试图仅从注册表中获得系统信息程序的路径...
  181.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  182.         ' 已知32位文件版本的有效位置
  183.         If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
  184.             SysInfoPath = SysInfoPath & "MSINFO32.EXE"
  185.             
  186.         ' 错误 - 文件不能被找到...
  187.         Else
  188.             GoTo SysInfoErr
  189.         End If
  190.     ' 错误 - 注册表相应条目不能被找到...
  191.     Else
  192.         GoTo SysInfoErr
  193.     End If
  194.     
  195.     Call Shell(SysInfoPath, vbNormalFocus)
  196.     
  197.     Exit Sub
  198. SysInfoErr:
  199.     MsgBox "此时系统信息不可用", vbOKOnly
  200. End Sub
  201. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  202.     Dim i As Long                                           ' 循环计数器
  203.     Dim rc As Long                                          ' 返回代码
  204.     Dim hKey As Long                                        ' 打开的注册表关键字句柄
  205.     Dim hDepth As Long                                      '
  206.     Dim KeyValType As Long                                  ' 注册表关键字数据类型
  207.     Dim tmpVal As String                                    ' 注册表关键字值的临时存储器
  208.     Dim KeyValSize As Long                                  ' 注册表关键自变量的尺寸
  209.     '------------------------------------------------------------
  210.     ' 打开 {HKEY_LOCAL_MACHINE...} 下的 RegKey
  211.     '------------------------------------------------------------
  212.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表关键字
  213.     
  214.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 处理错误...
  215.     
  216.     tmpVal = String$(1024, 0)                             ' 分配变量空间
  217.     KeyValSize = 1024                                       ' 标记变量尺寸
  218.     
  219.     '------------------------------------------------------------
  220.     ' 检索注册表关键字的值...
  221.     '------------------------------------------------------------
  222.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  223.                          KeyValType, tmpVal, KeyValSize)    ' 获得/创建关键字值
  224.                         
  225.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 处理错误
  226.     
  227.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 外接程序空终结字符串...
  228.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null 被找到,从字符串中分离出来
  229.     Else                                                    ' WinNT 没有空终结字符串...
  230.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null 没有被找到, 分离字符串
  231.     End If
  232.     '------------------------------------------------------------
  233.     ' 决定转换的关键字的值类型...
  234.     '------------------------------------------------------------
  235.     Select Case KeyValType                                  ' 搜索数据类型...
  236.     Case REG_SZ                                             ' 字符串注册关键字数据类型
  237.         KeyVal = tmpVal                                     ' 复制字符串的值
  238.     Case REG_DWORD                                          ' 四字节的注册表关键字数据类型
  239.         For i = Len(tmpVal) To 1 Step -1                    ' 将每位进行转换
  240.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' 生成值字符。 By Char。
  241.         Next
  242.         KeyVal = Format$("&h" + KeyVal)                     ' 转换四字节的字符为字符串
  243.     End Select
  244.     
  245.     GetKeyValue = True                                      ' 返回成功
  246.     rc = RegCloseKey(hKey)                                  ' 关闭注册表关键字
  247.     Exit Function                                           ' 退出
  248.     
  249. GetKeyError:      ' 错误发生后将其清除...
  250.     KeyVal = ""                                             ' 设置返回值到空字符串
  251.     GetKeyValue = False                                     ' 返回失败
  252.     rc = RegCloseKey(hKey)                                  ' 关闭注册表关键字
  253. End Function