frmdatabasepassword.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Begin VB.Form frmDatabasePassword 
   Caption         =   "Database Password"
   ClientHeight    =   2700
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   2880
   LinkTopic       =   "Form1"
   ScaleHeight     =   2700
   ScaleWidth      =   2880
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdChangePassword 
      Caption         =   "Change &Password"
      Height          =   435
      Left            =   600
      TabIndex        =   1
      Top             =   660
      Width           =   1755
   End
   Begin VB.CommandButton cmdOpenDatabase 
      Caption         =   "&Open Database"
      Height          =   435
      Left            =   600
      TabIndex        =   0
      Top             =   120
      Width           =   1755
   End
   Begin VB.CommandButton cmdCloseDatabase 
      Caption         =   "&Close Database"
      Height          =   435
      Left            =   600
      TabIndex        =   2
      Top             =   1200
      Width           =   1755
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "&Exit"
      Default         =   -1  'True
      Height          =   435
      Left            =   600
      TabIndex        =   3
      Top             =   2100
      Width           =   1755
   End
End
Attribute VB_Name = "frmDatabasePassword"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' form level object variable declaration used to hold database object
Private db As Database

' form level constant declaration used to indicate success
Private Const NO_ERROR = 0


Private Sub Form_Load()

' if there is an error then goto the code section labeled by ERR_Form_Load
On Error GoTo ERR_Form_Load:

    Dim sUserName As String
    Dim sPassword As String
    
    ' assign default user name and password
    sUserName = "Admin"
    sPassword = ""
    
    With DBEngine
        
        ' set system database path and name
        .SystemDB = GetWorkgroupDatabase

        ' set default user name and password
        .DefaultUser = sUserName
        .DefaultPassword = sPassword
        
    End With
    
    ' initialize database to closed state to disable various buttons
    cmdCloseDatabase_Click
    
Exit Sub

ERR_Form_Load:

    ' display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With

    ' end the application
    cmdExit_Click
    
End Sub


Private Sub Form_Unload(Cancel As Integer)

    ' ensure that the database is closed upon shutdown of application
    cmdCloseDatabase_Click
    
End Sub

Private Sub cmdOpenDatabase_Click()

' if there is an error goto the code labeled by ERR_cmdOpenDatabase_Click
On Error GoTo ERR_cmdOpenDatabase_Click:

    Dim sPassword As String
    Dim sDBName As String
    
    ' local constant declaration of application defined error
    Const ERR_NOT_VALID_PASSWORD = 3031
    
    ' ask user for the password of the database
    sPassword = InputBox("Please enter database password.", _
                         "OPEN DATABASE")
    
    ' create connection string
    sPassword = ";pwd=" & sPassword
    
    ' retrieve database name and path from the ReadINI module
    sDBName = DBPath
    
    ' attempt to open the database
    Set db = DBEngine.Workspaces(0).OpenDatabase _
                (sDBName, True, False, sPassword)
        
ERR_cmdOpenDatabase_Click:

    Dim sMessage As String

    With Err
    
        ' determine error
        Select Case .Number
        
            ' there is no error, inform the user of success and enable the
            ' use of the change password and close database command buttons
            Case NO_ERROR:
                sMessage = "Database opened successfully."
                
                cmdOpenDatabase.Enabled = False
                cmdChangePassword.Enabled = True
                cmdCloseDatabase.Enabled = True
        
            ' password is incorrect
            Case ERR_NOT_VALID_PASSWORD:
                sMessage = "Invalid password."
                
            ' unexpected error, inform the user
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & .Description
                
        End Select
        
        ' display the error for the user
        MsgBox sMessage, _
               IIf(.Number = NO_ERROR, vbInformation, vbExclamation), _
               IIf(.Number = NO_ERROR, "SUCCESS", "ERROR")
    
    End With
    
End Sub

Private Sub cmdChangePassword_Click()

' if there is an error goto the code labeled by ERR_cmdChangePassword_Click
On Error GoTo ERR_cmdChangePassword_Click:

    ' local variables used to store passwords
    Dim sOldPassword As String
    Dim sNewPassword As String
    Dim sConPassword As String
    
    ' private constant declarations for application defined errors
    Const ERR_PASSWORDS_DIFFER = 32000
    Const ERR_PASSWORD_TOO_LONG = 32001
    
    ' ask for old password
    sOldPassword = InputBox("Please enter the old password for the " _
                          & "database.", "CHANGE PASSWORD")
                            
    ' ask for new password
    sNewPassword = InputBox("Please enter the new password for the " _
                          & "database.", "CHANGE PASSWORD")
                          
    If (Len(sNewPassword) > 14) Then Error ERR_PASSWORD_TOO_LONG
                            
    ' confirm new password
    sConPassword = InputBox("Please confirm new password for the " _
                          & "database.", "CHANGE PASSWORD")
                            
    ' if new password is not equivalent to the confirmed password,
    ' notify the user and end the task, otherwise, change the password
    If (sNewPassword <> sConPassword) Then Error ERR_PASSWORDS_DIFFER
    
    ' change the password
    db.NewPassword sOldPassword, sNewPassword
    
ERR_cmdChangePassword_Click:

    Dim sMessage As String

    With Err
    
        ' select appropriate error
        Select Case .Number
        
            ' no error has occurred, inform the user of success
            Case NO_ERROR:
                sMessage = "Password changed successfully."
        
            ' new and confirmed passwords are different
            Case ERR_PASSWORDS_DIFFER:
                sMessage = "The confirmed password does not match the " _
                         & "new password."
                         
            ' password is longer than 14 characters
            Case ERR_PASSWORD_TOO_LONG:
                sMessage = "The password must be 14 characters or less."
                
            ' unexpected error, inform the user
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & .Description
                
        End Select
        
        ' display the error for the user
        MsgBox sMessage, _
               IIf(.Number = NO_ERROR, vbInformation, vbExclamation), _
               IIf(.Number = NO_ERROR, "SUCCESS", "ERROR")
    
    End With
        
                            
End Sub

Private Sub cmdCloseDatabase_Click()

    ' close the database
    Set db = Nothing
    
    ' only allow the user to open the database
    cmdOpenDatabase.Enabled = True
    cmdChangePassword.Enabled = False
    cmdCloseDatabase.Enabled = False
    
End Sub

Private Sub cmdExit_Click()

    ' end the application
    Unload Me
    
End Sub