frmAbout.frm
上传用户:rocksue
上传日期:2013-06-17
资源大小:41926k
文件大小:9k
源码类别:

SQL Server

开发平台:

SQL

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "学生信息管理系统"
  5.    ClientHeight    =   3204
  6.    ClientLeft      =   36
  7.    ClientTop       =   336
  8.    ClientWidth     =   5892
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3204
  14.    ScaleWidth      =   5892
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   1  'CenterOwner
  17.    Tag             =   "About Student_Mis"
  18.    Begin VB.PictureBox picIcon 
  19.       AutoSize        =   -1  'True
  20.       BackColor       =   &H00C0C0C0&
  21.       ClipControls    =   0   'False
  22.       Height          =   432
  23.       Left            =   240
  24.       Picture         =   "frmAbout.frx":0000
  25.       ScaleHeight     =   374.634
  26.       ScaleMode       =   0  'User
  27.       ScaleWidth      =   374.634
  28.       TabIndex        =   1
  29.       TabStop         =   0   'False
  30.       Top             =   240
  31.       Width           =   432
  32.    End
  33.    Begin VB.CommandButton cmdOK 
  34.       Cancel          =   -1  'True
  35.       Caption         =   "OK"
  36.       Default         =   -1  'True
  37.       Height          =   345
  38.       Left            =   1920
  39.       TabIndex        =   0
  40.       Tag             =   "OK"
  41.       Top             =   2640
  42.       Width           =   1467
  43.    End
  44.    Begin VB.Label lblDescription 
  45.       Caption         =   "版权提供:LL Software Corp."
  46.       BeginProperty Font 
  47.          Name            =   "宋体"
  48.          Size            =   16.2
  49.          Charset         =   0
  50.          Weight          =   700
  51.          Underline       =   0   'False
  52.          Italic          =   0   'False
  53.          Strikethrough   =   0   'False
  54.       EndProperty
  55.       ForeColor       =   &H00000000&
  56.       Height          =   456
  57.       Left            =   600
  58.       TabIndex        =   3
  59.       Tag             =   "App Description"
  60.       Top             =   1680
  61.       Width           =   4932
  62.    End
  63.    Begin VB.Label lblTitle 
  64.       Caption         =   "学生信息管理系统"
  65.       BeginProperty Font 
  66.          Name            =   "华文彩云"
  67.          Size            =   22.2
  68.          Charset         =   134
  69.          Weight          =   700
  70.          Underline       =   0   'False
  71.          Italic          =   0   'False
  72.          Strikethrough   =   0   'False
  73.       EndProperty
  74.       ForeColor       =   &H00404040&
  75.       Height          =   480
  76.       Left            =   1056
  77.       TabIndex        =   2
  78.       Tag             =   "Application Title"
  79.       Top             =   240
  80.       Width           =   4092
  81.    End
  82.    Begin VB.Line Line1 
  83.       BorderColor     =   &H00808080&
  84.       BorderStyle     =   6  'Inside Solid
  85.       Index           =   1
  86.       X1              =   225
  87.       X2              =   5657
  88.       Y1              =   2430
  89.       Y2              =   2430
  90.    End
  91.    Begin VB.Line Line1 
  92.       BorderColor     =   &H00FFFFFF&
  93.       BorderWidth     =   2
  94.       Index           =   0
  95.       X1              =   240
  96.       X2              =   5657
  97.       Y1              =   2445
  98.       Y2              =   2445
  99.    End
  100. End
  101. Attribute VB_Name = "frmAbout"
  102. Attribute VB_GlobalNameSpace = False
  103. Attribute VB_Creatable = False
  104. Attribute VB_PredeclaredId = True
  105. Attribute VB_Exposed = False
  106. ' Reg Key Security Options...
  107. Const KEY_ALL_ACCESS = &H2003F
  108.                                           
  109. ' Reg Key ROOT Types...
  110. Const HKEY_LOCAL_MACHINE = &H80000002
  111. Const ERROR_SUCCESS = 0
  112. Const REG_SZ = 1                         ' Unicode nul terminated string
  113. Const REG_DWORD = 4                      ' 32-bit number
  114. Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
  115. Const gREGVALSYSINFOLOC = "MSINFO"
  116. Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
  117. Const gREGVALSYSINFO = "PATH"
  118. 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
  119. 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
  120. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  121. Private Sub Form_Load()
  122.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  123.     lblTitle.Caption = App.Title
  124. End Sub
  125. Private Sub cmdSysInfo_Click()
  126.         Call StartSysInfo
  127. End Sub
  128. Private Sub cmdOK_Click()
  129.         Unload Me
  130. End Sub
  131. Public Sub StartSysInfo()
  132.     On Error GoTo SysInfoErr
  133.         Dim rc As Long
  134.         Dim SysInfoPath As String
  135.         
  136.         ' Try To Get System Info Program PathName From Registry...
  137.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  138.         ' Try To Get System Info Program Path Only From Registry...
  139.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  140.                 ' Validate Existance Of Known 32 Bit File Version
  141.                 If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
  142.                         SysInfoPath = SysInfoPath & "MSINFO32.EXE"
  143.                         
  144.                 ' Error - File Can Not Be Found...
  145.                 Else
  146.                         GoTo SysInfoErr
  147.                 End If
  148.         ' Error - Registry Entry Can Not Be Found...
  149.         Else
  150.                 GoTo SysInfoErr
  151.         End If
  152.         
  153.         Call Shell(SysInfoPath, vbNormalFocus)
  154.         
  155.         Exit Sub
  156. SysInfoErr:
  157.         MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  158. End Sub
  159. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  160.         Dim i As Long                                           ' Loop Counter
  161.         Dim rc As Long                                          ' Return Code
  162.         Dim hKey As Long                                        ' Handle To An Open Registry Key
  163.         Dim hDepth As Long                                      '
  164.         Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  165.         Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  166.         Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  167.         '------------------------------------------------------------
  168.         ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  169.         '------------------------------------------------------------
  170.         rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  171.         
  172.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  173.         
  174.         tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  175.         KeyValSize = 1024                                       ' Mark Variable Size
  176.         
  177.         '------------------------------------------------------------
  178.         ' Retrieve Registry Key Value...
  179.         '------------------------------------------------------------
  180.         rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  181.                                                 
  182.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  183.         
  184.         tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
  185.         '------------------------------------------------------------
  186.         ' Determine Key Value Type For Conversion...
  187.         '------------------------------------------------------------
  188.         Select Case KeyValType                                  ' Search Data Types...
  189.         Case REG_SZ                                             ' String Registry Key Data Type
  190.                 KeyVal = tmpVal                                     ' Copy String Value
  191.         Case REG_DWORD                                          ' Double Word Registry Key Data Type
  192.                 For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  193.                         KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  194.                 Next
  195.                 KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  196.         End Select
  197.         
  198.         GetKeyValue = True                                      ' Return Success
  199.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  200.         Exit Function                                           ' Exit
  201.         
  202. GetKeyError:    ' Cleanup After An Error Has Occured...
  203.         KeyVal = ""                                             ' Set Return Val To Empty String
  204.         GetKeyValue = False                                     ' Return Failure
  205.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  206. End Function