MsgBox \修改成功！\Unload Me Exit Sub er: MsgBox \有错误产生！\End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Form_Load() Text1.Text = login.user Text2.Text = login.password Set db = New Connection db.CursorLocation = adUseClient db.Open \ Set rs = New Recordset End Sub Private Sub Form_Unload(Cancel As Integer) If rs.State = adStateOpen Then rs.Close Set rs = Nothing
db.Close Set db = Nothing End Sub 7.2、档案的版本和系统信息 About.frm Option Explicit ' 注册表关键字安全选项... Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' 注册表关键字 ROOT 类型... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' 独立的空的终结字符串 Const REG_DWORD = 4 ' 32位数字
Const gREGKEYSYSINFOLOC = \Const gREGVALSYSINFOLOC = \Const gREGKEYSYSINFO = \Const gREGVALSYSINFO = \TH\ Private Declare Function RegOpenKeyEx Lib \Alias \(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib \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 Private Declare Function RegCloseKey Lib \ Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub Private Sub cmdOK_Click() Unload Me End Sub Private Sub Form_Load() Me.Caption = \关于 \
lblVersion.Caption = \版本 \ lblTitle.Caption = App.Title Me.Width = 5820 Me.Height = 4035 End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' 试图从注册表中获得系统信息程序的路径及名称... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' 试图仅从注册表中获得系统信息程序的路径... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' 已知32位文件版本的有效位置 If (Dir(SysInfoPath & \ SysInfoPath = SysInfoPath & \ ' 错误 - 文件不能被找到... Else GoTo SysInfoErr
End If ' 错误 - 注册表相应条目不能被找到... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox \此时系统信息不可用\End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' 循环计数器 Dim rc As Long ' 返回代码 Dim hKey As Long ' 打开的注册表关键字句柄 Dim hDepth As Long ' Dim KeyValType As Long ' 注册表关键字数据类型 Dim tmpVal As String ' 注册表关键字值的临时存储器 Dim KeyValSize As Long ' 注册表关键自变量的