Visual Basic 6 Database How-To

Previous chapterNext chapterContents


- 10 -
Security and Multiuser Access


When multiple users have access to a database, two issues become overwhelmingly important:

This chapter presents techniques for handling both of these issues. The first 3 How-To's deal with the issue of simultaneous multiuser access, and the remaining 10 How-To's show you how to use Visual Basic to implement security with the Jet database engine.

10.1 Open a Database So That Others Can't Access It While the User Is Working with It

When your application runs in a multiuser environment, the application and the Jet database engine need to work together to control access to common data. This How-To shows how to implement the most exclusive method of access to multiuser resources, locking an entire database.

10.2 Open a Table So That Others Can't Access It While the User Is Working with It

Most of the time, locking an entire database results in limited functionality of the client software that needs to access that database. In this How-To, you will learn how to gain exclusive read and write access to individual tables.

10.3 Work with Locked Records

If you decide not to lock an entire database or table for exclusive use, the Jet engine takes over and locks clusters of records one at a time as users access them. This How-To shows how to work with the Jet engine to implement record locking in your application.

10.Work with Secured Microsoft Access Database Files

Microsoft Access database files have a sophisticated set of security features that can be turned on simply by using password protection for the Admin account. You can implement the security features at two levels: the individual database file and the workgroup. The workgroup is defined by a system database. This How-To shows you how to work with secured Microsoft Access databases.

10.5 Assign Permissions for Database Objects

Each table and query in a Microsoft Access database file has associated with it a set of permissions for each user in the workgroup. This How-To shows you how to read and change permissions for users.

10.6 Change Ownership of Database Objects

The user who creates a table or query in a Microsoft Access database becomes its owner. With the appropriate permissions, you can change the owner of a table or query. This How-To shows you the technique to accomplish this task.

10.7 Change or Delete Database Passwords

The system administrator occasionally needs the ability to change a user's password and sometimes remove it all together. This How-To shows how to accomplish this job through Visual Basic.

10.8 Use a Single Password for Data Access for All Users

You know that you can set individual passwords for each user in a workgroup, but what if you simply want to put a password on the database itself? This How-To shows you how to do just that.

10.9 Add New Users to a System Database

A system database includes an entry for each user in the workgroup. This How-To shows you how to create new users and add them to that workgroup.

10.10 Define New Groups in a System Database

Just as you might need to add new users, you also might need to add new groups to a system database. This How-To shows you how to add new groups to a system database using Visual Basic.

10.11 Add Users to Groups and Delete Users from Groups

This How-To shows you how to add and remove any user in the system database to and from any group.

10.12 Track User Activity in a Database

It is nice to know which users did what to your database. Sometimes it would be useful if they had to sign what they did. The How-To will show you how to create an audit trail with any particular recordset to keep track of user activity in an Access database.

10.13 Create and Use an Encrypted Database

This How-To will show you how to create and convert encrypted databases so that others cannot access them with a product other than Access or Visual Basic.

10.1 How do I...

Open a database so that others can't access it while the user is working with it?

Problem

I have a database that I need to access from my application. It is important that no other user access the database while my application is running, even if he or she is using the same project that I am using. How can I ensure that only one instance of my program can access the database at a time?

Technique

Using the Microsoft Jet engine, shared data access is the default data mode. In this mode, the Jet engine takes care of page locking of the database. To open the database exclusively, you must explicitly state that this is your intention by passing a true value as the second parameter of the OpenDatabase method.

Steps

The Exclusive project is designed to illustrate the two distinct data modes used when opening a database, exclusive and shared. Open the Exclusive.vbp project and compile it to an EXE file. Invoke this executable twice to create two instances of the application. You should see the USER form opened twice, as shown in Figure 10.1. To open the database exclusively, click the Open Exclusive command button, or to open the database using the shared data mode, click the Open Shared command button. Notice the combinations permitted when opening the database with the two instances of the Exclusive project. You can open the database exclusively only if no other user has the database open at all, and you can open the database shared only if no other user has the database opened exclusively. To close the database, click the Close Database command button.

Figure 10.1. Two instances of the Exclusive project.

1. Create a new project and call it Exclusive.vbp. Change the properties of the default form, Form1, to those listed in Table 10.1, and save it as frmExclusive.frm.

Table 10.1. Objects and properties for the Exclusive project.

OBJECT Property Setting
Form Name frmExclusive
Caption USER
Command button Name cmdOpenExclusive
Caption Open &Exclusive
Command button Name cmdOpenShared
Caption Open &Shared
Command button Name cmdCloseDatabase
Caption &Close Database
Command button Name cmdExit
Caption E&xit
Cancel -1 `True
Default -1 `True
Label Name lblDBStatusLabel
Caption Database Status
Label Name lblDBStatus
Caption ""

2. Enter the following form-level variable and constant declarations to be used throughout the project:

Option Explicit
` this is the database object variable used throughout this 
` project
Private db As Database
` these are private constants used to indicate the desired state
` of the database when opened
Private Const OPEN_EXCLUSIVE = True
Private Const OPEN_SHARED = False


3. Now enter the code to initialize the frmExclusive form to display the database as closed by calling the cmdCloseDatabase_Click event.

Private Sub Form_Initialize()
    ` when the form is initialized, ensure that the proper states 
    ` of the command buttons and labels are set by calling the 
    ` Close Database command button's click event
    cmdCloseDatabase_Click
End Sub


4. Code both the cmdOpenExclusive_Click and the cmdOpenShared_Click events with a call to the OpenDB procedure, passing the appropriate form-level constant to indicate the data mode desired by the user.

Private Sub cmdOpenExclusive_Click()
    ` call the OpenDB procedure of this project, passing the
    ` OPEN_EXCLUSIVE constant (this constant holds the value of 
    ` TRUE)
    OpenDB OPEN_EXCLUSIVE
End Sub
Private Sub cmdOpenShared_Click()
    ` call the OpenDB procedure of this project, passing the
    ` OPEN_SHARED constant (this constant holds the value of 
    ` FALSE)
    OpenDB OPEN_SHARED
End Sub


5. When closing the database, set the db object variable to nothing, and set the command button Enabled properties to the correct state, allowing the user only to open the database, because it is now closed. Here is the code for the Close Database command button:

Private Sub cmdCloseDatabase_Click()
    ` set the database object variable to nothing, which is
    ` the equivalent of closing the database
    Set db = Nothing
    ` change the label that displays the database status to closed
    lblDBStatus = "CLOSED"
    ` only allow the user to open the database and not close it
    cmdOpenExclusive.Enabled = True
    cmdOpenShared.Enabled = True
    cmdCloseDatabase.Enabled = False
End Sub


6. Enter the code for the Exit command button. This code first calls the Close Database click event of the command button to set the database object to nothing, unloading the project afterward to terminate the project.

Private Sub cmdExit_Click()
    ` call the close database command button click event to ensure
    ` that the database is closed before we terminate the project
    cmdCloseDatabase_Click
    ` end the application by calling Unload
    Unload Me
End Sub


7. Next, enter the code for the OpenDB procedure used to open the database for either exclusive or shared mode. If the user decides to open the database exclusively, the OPEN_EXCLUSIVE constant is passed to this procedure and onto the OpenDatabase method of the database object. This constant holds the value of True and opens the database exclusively. The other choice, OPEN_SHARED, passes a value of False to the OpenDatabase method.

Private Sub OpenDB(bDataMode As Boolean)
` if any error is encountered, call the code specified by the
` ERR_OpenDB label
On Error GoTo ERR_OpenDB:
    Dim sDBName As String
    ` on slower machines, this may take a moment; therefore,
    ` we will change the mouse pointer to an hourglass to indicate
    ` that the project is still working
    Screen.MousePointer = vbHourglass
    ` retrieve the database name and path from the ReadINI module
    sDBName = DBPath
    ` open the database using the desired data mode specified by 
    ` the user if bDataMode = OPEN_EXCLUSIVE then the value of 
    ` bDataMode is TRUE, telling the OpenDatabase method to open 
    ` the database exclusively; otherwise, OPEN_SHARED = FALSE, 
    ` opening the database in a shared mode
    Set db = dbengine.Workspaces(0).OpenDatabase(sDBName, bDataMode)
    ` if we are at this point, then the database was opened 
    ` succesfully, now display the appropriate label depending on 
    ` the data mode selected
    Select Case bDataMode
        Case OPEN_EXCLUSIVE:
            lblDBStatus = "OPEN: EXCLUSIVE"
        Case OPEN_SHARED:
            lblDBStatus = "OPEN: SHARED"
    End Select
    ` only allow the user to close that database, and do not allow
    ` opening of the database again
    cmdOpenExclusive.Enabled = False
    cmdOpenShared.Enabled = False
    cmdCloseDatabase.Enabled = True
    ` set the mouse pointer to the default icon
    Screen.MousePointer = vbDefault
Exit Sub
ERR_OpenDB:
    ` set the mouse pointer to the default icon
    Screen.MousePointer = vbDefault
    ` call the DatabaseError procedure, passing the Err object, 
    ` which describes the error that has just occurred
    DatabaseError Err
End Sub


8. To finish this project, enter the code for responding to errors opening the database. This code is as follows:

Private Sub DatabaseError(oErr As ErrObject)
    Dim sMessage As String
    ` these are the constant values used to represent the two 
    ` errors that we are going to trap in this code
    Const DB_OPEN = 3356    ` database already open in shared mode
    Const DB_IN_USE = 3045  ` database already open exclusively
    With oErr
        ` select the appropriate code depending upon the error 
        ` number
        Select Case .Number
            ` attempted to open the database exclusively, but it 
            ` is already open in shared mode
            Case DB_OPEN:
                sMessage = _
                "You cannot open the database exclusively " _
                & "because it is already opened by another user."
            ` attempted to open the database either exclusively or
            ` shared, but it is opened exclusively by another user
            Case DB_IN_USE:
                sMessage = _
                   "You cannot open the database because it is " _
                         & "opened exclusively by another user."
            ` unexpected error: display the error number and 
            ` description for the user
            Case Else
                sMessage = "Error #" & .Number & ": " & 
                           .Description
        End Select
    End With
    ` display the message for the user
    MsgBox sMessage, vbExclamation, "DATABASE ERROR"
    ` ensure that the database is closed because of the error, and
    ` properly set all the command button enabled properties as 
    ` well as the status label
    cmdCloseDatabase_Click
End Sub

How It Works

When you open an Access database exclusively in one instance of the Exclusive project, assuming that the database is not opened by any other project, the Jet engine indicates that no other application can open the database by putting codes in the LDB file named after your database. In the case of this project, you use the ORDERS.MDB database. The file named ORDERS.LDB indicates how the database is opened and by whom.

Comments

This project uses an all-or-nothing concept when locking the data from other users. Either the data can be accessed by others or it cannot. Sometimes this is too general of a technique to use when developing a multiuser application. In How-To 10.2, you will use table locking to allow more flexible manageability of your database.

10.2 How do I...

Open a table so that others can't access it while the user is working with it?

Problem

My application accesses shared data through the Jet engine. The default record-locking scheme that Jet uses works great for many instances. I need advanced record locking on particular tables so that others cannot access the entire table when my application does. How do I open a table with exclusive access?

Technique

By default, the recordset that you add will have shared rights to other users unless you explicitly request otherwise. You can indicate what kind of permissions you will grant other users when accessing that table.

The syntax for the OpenRecordset method is

Set rs = db.OpenRecordset(TableName, dbOpenTable, Options)

where rs is your recordset object variable, db is your database object variable, and TableName is the name of a valid table in the db object. The second parameter, dbOpenTable, is the type of recordset to be used. This parameter can be replaced with dbOpenDynaset, dbOpenSnapshot, dbOpenDynamic, or dbOpenForwardOnly. Table 10.2 lists the valid options.

Table 10.2. Options for the OpenRecordset method.

OPTION Description
dbDenyRead Denies read permissions to other users
dbDenyWrite Denies write permissions to other users

By using the dbDenyRead and dbDenyWrite options, you can open a table exclusively or with partial sharing rights to other users.

Steps

Open and compile the TableLocker.vbp project. Create two instances of the TableLocker project by double-clicking its icon twice from Windows Explorer. Move one form down to reveal the other (they start up in the same position). You should see the forms shown in Figure 10.2.

Figure 10.2. Two instances of the TableLocker project.

You can set the permissions assigned to opening the table by using the two check boxes on the form and then pressing the Open Table command button. You can add records and then close the table by pressing the appropriate command buttons.

Experiment with opening the table with the two instances of the project. If you open the table with exclusive rights (deny read access) with one instance and then attempt to open it with the other in any way, you will be unsuccessful. When this happens, the application asks whether you want to open the table with Read Only access. If this is possible, the table will open but deny you the right to add records.

1. Create a new project and save it as TableLocker.vbp. Edit Form1 to include the objects and properties listed in Table 10.3, and save it as frmTableLocker.vbp.

Table 10.3. Objects and properties for the Exclusive project.

OBJECT Property Setting
Form Name frmTableLocker
Caption USER
Frame Name fraTableSharing
Check box Name chkDenyRead
Caption Deny others Read Access to Table
Check box Name chkDenyWrite
Caption Deny others Write Access to Table
Command button Name cmdOpenTable
Caption &Open Table
Command button Name cmdAddRecord
Caption &Add Record
Command button Name cmdCloseTable
Caption &Close Table
Command button Name cmdExit
Caption E&xit

2. Enter the following declarations for the form-level database and recordset object variables:

Option Explicit
` form-level object variables used to access the database and
` recordset objects used throughout this project
Private db As Database
Private rs As Recordset


3. Now enter the code to initialize the form to indicate that the table is closed:

Private Sub Form_Initialize()
    ` initialize the form controls to show that the table is 
    ` closed upon startup of project
    cmdCloseTable_Click
End Sub


4. Open the database in the Form_Load event as shown next. The DBPath function is from the ReadINI module included with the distribution CD-ROM to indicate where the ORDERS database is located on your machine.

Private Sub Form_Load()
    Dim sDBName As String
    ` obtain the name and path of the table to be used in this
    ` project from the ReadINI module
    sDBName = DBPath
    ` open the database
    ` by not specifying an exclusive mode, the database is opened 
    ` in shared mode
    Set db = DBEngine.Workspaces(0).OpenDatabase(sDBName)
End Sub


5. By placing the following code in the Form_Unload event, you can ensure that it runs even if the user does not terminate the application by using the Exit command button:

Private Sub Form_Unload(Cancel As Integer)
    ` close the database and recordset objects by setting them to 
    ` nothing
    Set db = Nothing
    Set rs = Nothing
End Sub


6. Now enter the cmdOpenTable_Click event code as shown next. This event opens the table using the check box values of the frmTableLocker form to determine the permissions assigned to the opening of the table. If an error occurs, the application calls the TableError routine to gracefully handle it and might try opening the table again.

Private Sub cmdOpenTable_Click()
` if an error occurs, call the ERR_cmdOpenTable_Click code located
` at the end of this procedure
On Error GoTo ERR_cmdOpenTable_Click:
    ` local variable used to store permissions
    Dim nAccessValue As Integer
    ` set the mouse pointer to an hourglass because on some 
    ` machines, this could take a few seconds
    Screen.MousePointer = vbHourglass
    ` default the permissions to nothing (all access okay)
    nAccessValue = 0
    ` apply the proper permissions that were restricted by the 
    ` user
    If (chkDenyRead) Then nAccessValue = nAccessValue + dbDenyRead
    If (chkDenyWrite) Then nAccessValue = nAccessValue + _
       dbDenyWrite
    ` open the table using the permission variable
    Set rs = db.OpenRecordset("Customers", dbOpenTable, _
    nAccessValue)
    ` set the index to the PrimaryKey used later in GetPrimaryKey
    rs.Index = "PrimaryKey"
    ` release any locks that may be on the table, and process any
    ` data that is waiting to be completed
    DBEngine.Idle dbRefreshCache
    ` allow the correct status of the enabled property of the
    ` frmTableLocker controls
    cmdOpenTable.Enabled = False
    chkDenyRead.Enabled = False
    chkDenyWrite.Enabled = False
    cmdAddRecord.Enabled = True
    cmdCloseTable.Enabled = True
    ` set the mousepointer back to its default because we are now 
    ` finished
    Screen.MousePointer = vbDefault
Exit Sub
ERR_cmdOpenTable_Click:
    ` an error has occurred; therefore, change the mouse pointer 
    ` back to an hourglass
    Screen.MousePointer = vbDefault
    ` call the TableError function, passing the error object 
    ` describing the error that has occurred
    ` if a value of True is returned, we are going to try opening 
    ` the table again with read-only access
    If (TableError(Err)) Then
        chkDenyRead = False
        chkDenyWrite = False
        nAccessValue = dbReadOnly
        Resume
    End If
End Sub


7. When the user clicks the Add Record command button, a dummy record is added to the table using a unique primary key that is obtained by calling the GetUniqueKey function. Again, if there is an error, the TableError routine is called to handle it. The code for the cmdAddRecord_Click event is as follows:

Private Sub cmdAddRecord_Click()
` if an error occurs, call the ERR_cmdAddRecord code located at 
` the end of this procedure
On Error GoTo ERR_cmdAddRecord:
    Dim lPrimaryKey As Long
    Dim sMessage As String
    ` used to populate fields in Customer table
    ` this is necessary because most of the fields belong to 
    ` indexes, making them required fields
    Const DUMMY_INFO = "<>"
    ` retrieve a unique key from the GetPrimaryKey routine
    lPrimaryKey = GetPrimaryKey
    With rs
        ` add a new record
        .AddNew
        ` fill in the required fields
        .Fields("Customer Number") = lPrimaryKey
        .Fields("Customer Name") = DUMMY_INFO
        .Fields("Street Address") = DUMMY_INFO
        .Fields("City") = DUMMY_INFO
        .Fields("State") = DUMMY_INFO
        .Fields("Zip Code") = DUMMY_INFO
        ` make saves (if an error will occur, it will be here)
        .Update
    End With
    ` if we got this far, add new record was successfull
    sMessage = "Record added successfully!"
    MsgBox sMessage, vbInformation, "ADD RECORD"
Exit Sub
ERR_cmdAddRecord:
    ` an error has occurred; call the TableError function and pass
    ` the Err object describing the error
    TableError Err
End Sub


8. Enter the following cmdCloseTable_Click event code. This code sets the recordset object variable to nothing (the equivalent of closing the recordset) and sets the Enabled property of the controls on the form to their appropriate state.

Private Sub cmdCloseTable_Click()
    ` set the rs object variable to nothing, closing the recordset
    Set rs = Nothing
    ` properly display the controls on the frmTableLocker form
    chkDenyRead.Enabled = True
    chkDenyWrite.Enabled = True
    cmdOpenTable.Enabled = True
    cmdAddRecord.Enabled = False
    cmdCloseTable.Enabled = False
End Sub


9. Enter the cmdExit_Click code shown next to end the project. The Unload Me code will invoke the Form_Unload event where the database and recordset object variables will be set to nothing.

Private Sub cmdExit_Click()
    ` using Unload Me will call Form_Unload where the form-level
    ` database and recordset object variables will be set to 
    ` nothing
    Unload Me
End Sub


10. The GetPrimaryKey function returns a unique key based on the Customer Name field of the Customers table you are accessing:

Private Function GetPrimaryKey()
    ` return a unique primary key based on the Customer Number 
    ` field
    With rs
        ` if there are records in the table already, find the last 
        ` one and add one to the Customer Number as a unique 
        ` Primary Key; otherwise, there are no records in the 
        ` table so return 1 for the first new record to be added
        If (Not (.EOF And .BOF)) Then
            .MoveLast
            GetPrimaryKey = .Fields("Customer Number") + 1
        Else
            GetPrimaryKey = 1
        End If
    End With
End Function


11. The TableError function contains the code that handles all the input and output errors that occur within this application. If users cannot open the table with the permissions that were requested, they are asked whether they want to try again with read-only access. Enter the code for the TableError function:

Private Function TableError(oErr As ErrObject) As Boolean
    Dim sMessage As String
    Dim nResponse As Integer
    ` these are the constant values used to represent the four 
    ` errors that we are going to trap in this code
    Const TB_OPEN = 3262    ` database already open in shared mode
    Const TB_IN_USE = 3261  ` database already open exclusively
    Const TB_READ_ONLY = 3027    ` can't save, read only
    Const TB_LOCKED = 3186       ` table is locked, cannot update
    ` default the return value of the function to false, which 
    ` will indicate that we do not want to try again
    TableError = False
    With oErr
        ` select the appropriate code depending upon the error 
        ` number
        Select Case .Number
           ` the table couldn't be opened using the permissions 
           ` requested; ask the user if they would like to open it 
           ` in read-only mode
           Case TB_OPEN, TB_IN_USE:
             sMessage = "There was an error opening the table. " _
                         & "Would you like to try read only mode?"
             nResponse = MsgBox(sMessage, vbYesNo + vbQuestion, _
             "ERROR")
                If (nResponse = vbYes) Then TableError = True
                Exit Function
            ` the table is read only and you cannot add a new 
            ` record
            Case TB_READ_ONLY:
               sMessage = "You cannot add a record because the " _
                     & "database is currently opened with read " _
                     & "only status."
            ` the table is locked and you cannot add a new record
            Case TB_LOCKED:
               sMessage = "You cannot add a record because the " _
                         & "database is currently locked by 
                         & "another user."
            ` unexpected error: display the error number and
            ` description for the user
            Case Else
                sMessage = "Error #" & .Number & ": " & _
                .Description
        End Select
    End With
    ` display the message for the user
    MsgBox sMessage, vbExclamation, "TABLE ERROR"
    ` ensure that the database is closed because of the error, and
    ` properly set all the command button enabled properties, as 
    ` well as the status label
    cmdCloseTable_Click
End Function

How It Works

This project uses the dbDenyRead and dbDenyWrite options when opening the Customer table to deny rights to other users when they attempt to open the table. If another user attempts to open the table that is already opened with dbDenyRead, it is considered opened exclusively. If the table is already opened with the dbDenyWrite option, the user can only open the table with a dbReadOnly option, not allowing new records or editing of ones that already exist.

Comments

There is another parameter you can specify when you open a table; this is called the LockEdits parameter. Table 10.4 describes the options you can use for the LockEdits parameter.

Table 10.4. The LockEdits parameter.

OPTION Description
dbPessimistic Page is locked at Edit method.
dbOptimistic Page is locked at Update method.

dbPessimistic is the default value for this fourth parameter of the OpenRecordset method and indicates that the page is to be locked as soon as the Edit method is encountered. The dbOptimistic option works a little differently--it waits until the Update method is called to lock the page. The main reason for using the dbOptimistic option is to allow less time for the page to be locked. How-To 10.3 demonstrates these options.

10.3 How do I...

Work with locked records?

Problem

My application is being designed to allow multiple users to access the same data. It is inevitable that sooner or later two users will attempt to edit the same data. How do I write proper record-locking code to guard my application from situations like this and to ensure database integrity?

Technique

As touched on in How-To 10.2, you can set the way in which a record is locked by accessing the LockEdits property of the recordset. In doing this, you can set the value of this property to either pessimistic or optimistic. The default value for LockEdits is True, which corresponds to pessimistic. By setting this property to False, you obtain optimistic record locking.

Pessimistic record locking locks the record during the time indicated by the call to the Edit method and the call to the Update method of a recordset. Optimistic record locking locks the record during the call to the Update method.

With the potential danger of database corruption with multiuser access, you can expect to encounter numerous trappable runtime errors with record locking. The errors are listed here:

It has become an acceptable programming technique to trap these errors and respond to them at such times. It is common to expect some or all of these errors when running a multiuser application, as you will see in this project.

Steps

Open the RecordLocker project and compile it. Open two instances of the project and run them simultaneously. You should see the forms shown in Figure 10.3. With one instance, open a record for editing. With the other instance, select pessimistic record locking and edit the record. You will receive an error because the application is attempting to lock the record from the time the Edit method is called. Try changing the record locking to optimistic and edit the record. You will be able to get to this point; however, if you now click the Update button, you will receive an error. This is because optimistic record locking attempts to lock the record when the Update method is called.

Figure 10.3. Two instances of the RecordLocker project.

The user can navigate the recordset by using the four buttons below the option buttons. The user can also refresh the current record by clicking the Refresh button. This step is useful to ensure that you have the most up-to-date information for the current record in case another user has already changed it.

1. Create a new project and call it RecordLocker.vbp. Create the objects and change the properties as listed in Table 10.5. Save the form as frmRecordlocker.frm. Note that the cmdMove command buttons are a control array.

Table 10.5. Objects and properties for the Exclusive project.

OBJECT Property Setting
Form Name frmRecordLocker
Caption USER
Frame Name fraRecord
Text box Name txtCustomerName
Text box Name txtStreetAddress
Option button Name optPessimisticLocking
Caption Pessimistic Record Locking
Option button Name optOptimisticLocking
Caption Optimistic Record Locking
Command button Name cmdEdit
Caption &Edit
Command button Name cmdUpdate
Caption &Update
Command button Name cmdRefresh
Caption &Refresh
Command button Name cmdClose
Caption &Close
Command button Name cmdMove
Caption <<
Index 0
Command button Name cmdMove
Caption <
Index 1
Command button Name cmdMove
Caption >
Index 2
Command button Name cmdMove
Caption >>
Index 3
Label Name lblCustomerName
Caption &Customer Name
Label Name lblStreetAddress
Caption &Street Address

2. Enter the following form-level variables in the declarations section of your project. The first two variables are used to hold the database and recordset objects. The m_bEditMode variable is used to indicate whether the project is in edit mode. The last two declarations are constant values used to determine whether the LockEdits property of the recordset is set to pessimistic or optimistic.

Option Explicit
` form-level object variables that hold the database and recordset
` objects used throughout this project
Private db As Database
Private rs As Recordset
` form-level boolean variable used to indicate when the current
` record is in edit mode
Private m_bEditMode As Boolean
` form-level constant declarations used to indicate pessimistic or
` optimistic record locking
Private Const PESSIMISTIC = True
Private Const OPTIMISTIC = False


3. Now enter the code to open the database and recordset in the Form_Load event. This code also determines whether the recordset is empty (ending the application if so) and, if not, displays the first record.

Private Sub Form_Load()
    Dim sDBName As String
    ` get the path and name of the database used in this project
    ` from the ReadINI module
    sDBName = DBPath
    ` open the database and recordset
    Set db = DBEngine.Workspaces(0).OpenDatabase(sDBName)
    Set rs = db.OpenRecordset("Customers", dbOpenDynaset)
    With rs
        ` if the recordset is empty, then inform the user and end
        If (.EOF And .BOF) Then
            MsgBox "Table Empty!", vbExclamation, "ERROR"
            Unload Me
        Else
            ` move to the first record and display it
            .MoveFirst
            DisplayRecord
        End If
    End With
    ` set the optPessimisticLocking value to true (this will
    ` automatically call the optPessimisticLocking_Click event
    optPessimisticLocking = True
End Sub


4. The Form_Unload event is called when the application is terminated. By setting the form-level object variables db and rs to nothing, you achieve the same status as you would closing them with the Close method.

Private Sub Form_Unload(Cancel As Integer)
    ` set the form-level object variables for the database and
    ` recordset to nothing (this is the same as closing each 
    ` object)
    Set db = Nothing
    Set rs = Nothing
End Sub


5. Enter the cmdEdit_Click code shown next. This event first checks to see whether the record is in edit mode and updates the record if it is. After this, the recordset is placed in edit mode via the Edit method. If an error is going to occur, it will be here. If the user has selected pessimistic locking and the record is currently open, an error will occur. If no error is encountered, the text boxes are enabled to allow editing, and the form-level Boolean flag, m_bEditMode, is set to True to indicate that edit mode
is on.

Private Sub cmdEdit_Click()
` if there is an error, goto the code labeled by ERR_cmdEdit_Click
On Error GoTo ERR_cmdEdit_Click:
    ` if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    ` set the record to edit mode
    rs.Edit
    ` indicate that the record is in edit mode through the
    ` m_m_bEditMode form-level boolean variable
    m_bEditMode = True
    ` disable the edit command button and enable the update 
    ` command button and text box controls
    cmdEdit.Enabled = False
    cmdUpdate.Enabled = True
    txtCustomerName.Enabled = True
    txtStreetAddress.Enabled = True
Exit Sub
ERR_cmdEdit_Click:
    ` an error has occurred, call the RecordError routine with the
    ` error object that describes the error and a string 
    ` indicating the method attempted at the time of the error
    RecordError Err, "edit"
End Sub


6. The code for the cmdUpdate_Click event is easy. Simply call the UpdateRecord routine as shown here:

Private Sub cmdUpdate_Click()
    ` update the current record in the database
    UpdateRecord
End Sub


7. Now enter the code for the cmdRefresh_Click event as shown next. This code again updates the record if it is in edit mode; then it performs a requery of the recordset and displays the current record.

Private Sub cmdRefresh_Click()

    ` if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    ` requery dynaset and move the record pointer
    With rs
        .Requery
        .MoveNext
        .MovePrevious
    End With
    ` redisplay the current record
    DisplayRecord
End Sub


8. Enter the code for the cmdClose_Click event as shown here. This ends the application, and the Form_Unload event is automatically called.

Private Sub cmdClose_Click()
    ` end the application, this will call the Form_Unload event
    Unload Me
End Sub


9. Now enter the code for both option buttons on the frmRecordLocker form as shown next. Each event checks to see whether the record is in edit mode and performs an update if it is. Next, the LockEdits property
of the recordset is set to the locking method of choice.

Private Sub optPessimisticLocking_Click()
    ` if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    ` set the LockEdits property of the recordset to Pessimistic
    ` record locking
    rs.LockEdits = PESSIMISTIC
End Sub
Private Sub optOptimisticLocking_Click()
    ` if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    ` set the LockEdits property of the recordset to Optimistic 
    ` record locking
    rs.LockEdits = OPTIMISTIC
End Sub


10. Now enter the code for the cmdMove_Click event. This event occurs when the user presses any of the four command buttons belonging to the control array cmdMove. By comparing the Index variable passed as an argument to this event with the constants defined, the correct recordset navigation is applied and the new record is displayed.

Private Sub cmdMove_Click(Index As Integer)
    ` local constant values used to indicate which command button
    ` was pressed
    ` each constant corresponds to the index of each command 
    ` button
    Const MOVE_FIRST = 0
    Const MOVE_PREVIOUS = 1
    Const MOVE_NEXT = 2
    Const MOVE_LAST = 3
    ` if the current record is in edit mode, call UpdateRecord
    If (m_bEditMode) Then UpdateRecord
    With rs
        Select Case Index
            ` move to the first record
            Case MOVE_FIRST:
                .MoveFirst
            ` move to the previous record; if the record pointer 
            ` is before the first record, then move to the first 
            ` record
            Case MOVE_PREVIOUS:
                .MovePrevious
                If (.BOF) Then .MoveFirst
            ` move to the next record; if the record pointer is
            ` beyond the last record, then move to the last record
            Case MOVE_NEXT:
                .MoveNext
                If (.EOF) Then .MoveLast
            ` move to the last record
            Case MOVE_LAST:
                .MoveLast
        End Select
    End With
    ` display the current record after moving to a new one
    DisplayRecord
End Sub


11. The following code displays the record. Enter this in the General section
of your project. If a new record is displayed, it cannot be in edit mode; therefore, you set the m_bEditMode variable to False and disable the Update command button while enabling the Edit command button.

Private Sub DisplayRecord()
    ` disable the customer name and fill it with the current
    ` record's corresponding field value
    With txtCustomerName
        .Text = rs.Fields("Customer Name")
        .Enabled = False
    End With
    ` disable the street address and fill it with the current
    ` record's corresponding field value
    With txtStreetAddress
        .Text = rs.Fields("Street Address")
        .Enabled = False
    End With
    ` enable the edit and disable the update command buttons
    cmdEdit.Enabled = True
    cmdUpdate.Enabled = False
    ` currently not in edit mode
    m_bEditMode = False
End Sub


12. Enter the UpdateRecord code now. This procedure updates the recordset with the values shown on the form. If the recordset LockEdits property was set to optimistic and the record is currently opened by another user at this time, the Update method causes an error. Trap the error and call the RecordError procedure as shown toward the end of this procedure.

Private Sub UpdateRecord()
` if there is an error, goto the code labeled by ERR_UpdateRecord
On Error GoTo ERR_UpdateRecord:
    ` set the new values of the record fields to those displayed 
    ` on the form and update the record (this is where an error 
    ` can occur)
    With rs
        .Fields("Customer Name") = txtCustomerName
        .Fields("Street Address") = txtStreetAddress
        .Update
    End With
    ` display the updated record
    DisplayRecord
Exit Sub
ERR_UpdateRecord:
    ` an error has occurred, call the RecordError routine with the 
    ` error object that describes the error and a string 
    ` indicating the method attempted at the time of the error
    RecordError Err, "update"
End Sub


13. Finally, enter the RecordError code, which displays the proper error message for the user based on the error object that was passed to it as a parameter:

Private Sub RecordError(oErr As ErrObject, sAction As String)
    Dim sMessage As String
    ` error constant used to indicate that the current record is
    ` locked and cannot be updated or edited
    Const RECORD_LOCKED = 3260
    With Err
        Select Case .Number
            ` the record cannot be edited
          Case RECORD_LOCKED:
              sMessage = "Cannot " & sAction & " at this time " _
                       & "because the record is currently locked " _
                       & "by another user."
          ` an unexpected error has occurred
          Case Else:
              sMessage = "ERROR #" & .Number & ": " & _
                         .Description
       End Select
    End With
    ` display the error message created above
    MsgBox sMessage, vbExclamation, "ERROR"
End Sub

How It Works

This How-To uses the LockEdits property of the recordset object to determine how a particular record is locked. If the user selects pessimistic locking, the default setting for the Jet engine, the record becomes locked immediately upon calling the Edit method of the recordset. This lock remains on until the Update method of the recordset is called.

On the other hand, if the user has selected optimistic record locking for the LockEdits property, the record is locked only when the Update method is called. The advantage to this alternative is that the record is not locked for a potentially long period as with pessimistic locking; however, the data in the record can change during the time between the calls to the Edit and Update methods. If this is the case, a trappable runtime error occurs.

This project allows navigation of the recordset with four command buttons that emulate the Data control VCR navigation buttons. When the user clicks a navigation button, the record pointer is repositioned to the first, previous, next, or last record. If the record pointer goes before the first record or after the last, the application traps the potential error and repositions the record pointer to the first or last record.

Comments

The preceding three How-To projects deal with constantly checking error codes to determine the state of a database, table, or record. It is very important to always be a courteous programmer. This means properly coding your applications so that they will prevent error messages from occurring not only in your own project but also in other developers' applications.

Table 10.6 lists the most common error messages you might encounter when dealing with locking databases.

Table 10.6. Common database-locking error messages.

ERROR NUMBER Is Generated When...
3167 You use Edit, and the record has been deleted since the last time you read it.
3186 You use Update on a new or edited record, and the record's page is locked by another user.
3197 You use Edit or Update, and the record has changed since the last time you read it.
3027 You try to write to a table you have opened as read only.
3260 You use Addnew, Edit, or Update, and the record's page is locked by another user.
3261 You try to open a table that another user has opened with dbDenyRead or dbDenyWrite.
3262 You try to open a table with dbDenyRead or dbDenyWrite, and another user has the table open.
3356 You try to open a database already opened exclusively by another user, or you try to open exclusively a database that another user already has opened.

These error messages can be detected at various points in a project and should be trapped whenever possible.

10.4 How do I...

Work with secured Microsoft Access database files?

Problem

I need to create a secure Microsoft Access database file and have my Visual Basic program manipulate it. How can I do this?

Technique

Microsoft Access databases support a wide variety of security features. The Jet engine can control which users and applications can access databases, tables, or fields. Security features are managed through the use of a system database. By convention, the database is usually named SYSTEM.MDW.

Every Microsoft Access user is assigned to a workgroup, and a copy of SYSTEM.MDW is established for each workgroup. An entry for each user in the Windows Registry points to the correct copy of SYSTEM.MDW for the user's assigned workgroup. This file is specified with the key HKEY_LOCAL_MACHINE\
SOFTWARE\Microsoft\Office\8.0\Access\Jet\3.5\Engines
. In this How-To, you learn the techniques for accessing the objects in a secured Microsoft Access database.

Permissions

Each Microsoft Access database file includes a set of permissions that give users certain specified rights to the database and to the objects within the database. For the database itself, two permissions can be granted: the right to open the database (Open Database) and the right to open the database exclusively (Open Exclusive).

Although Microsoft Access security covers all database object types, the only data objects that can be accessed from Visual Basic are tables and queries. Table 10.7 lists the seven permissions that can be granted for table and query objects. Granting any of these permissions except Read Design implies granting others as well. Table 10.7 also shows these implied permissions.

Table 10.7. Permissions for Microsoft Access tables and queries.

PERMISSION Implies These Additional Permissions
Read Design (none)
Modify Design Read Design, Read Data, Update Data, Delete Data
Administer All other permissions
Read Data Read Design
Update Data Read Data, Read Design
Insert Data Read Data, Read Design
Delete Data Read Data, Read Design

Groups and Users

Everyone who accesses a Microsoft Access database is a user and is identified by a username. Users can also be assigned to groups. Every group has a group name. User and group information for a specified workgroup is stored in the system database (usually SYSTEM.MDW) file. You can use Microsoft Access (or Visual Basic) to create users and groups and to assign users to groups.

You grant permissions by users or by groups. Users inherit the rights of their group, unless you specify otherwise. Assume, for example, that you have a group named Payroll Department. You assign the entire group only Read Data permission to the Pay Rates table (and Read Design permission, which is implied by Read Data). For two users within the group, Tom and Betty, you also assign Update Data, Insert Data, and Delete Data permissions. For one user in the group, Pat, you revoke Read Data permission. The specific permission assignments you have made for users Tom, Betty, and Pat override the group permissions for these users.

Secured and Unsecured Systems

All the preceding information is transparent--and relatively unimportant--as long as you are working with an unsecured system. When the Workgroup Administrator application creates a new system database--and thereby creates a new workgroup--the system is by default an unsecured system. All users are assigned empty strings ("") as passwords. Users do not log in when they start Access, and your Visual Basic program does not need to provide a username or password because all users are logged in automatically with the default name Admin and the password "".

This all changes as soon as the Admin user's password changes, because a password-protected Admin account makes the system into a secured system. Each time a user starts Microsoft Access in a secured system, he or she must provide a username, and that name must be registered in the workgroup's copy of the system database. If the system database contains a password other than "" for the user, the password must be provided at login. In like manner, before your Visual Basic program can access a database in a secured system, it must provide a valid username and a password (if the user is assigned a password).

Security ID Numbers

Every user and group has a Security ID (SID)--a binary string created by the Jet engine and stored in the system database where the user or group is defined. With several important exceptions, the Jet database engine builds a user or group SID based on two pieces of information:

The SID, therefore, uniquely identifies a user or group.

Security IDs and Object Permissions

Object permissions are defined by assignment to an SID. You can think of a permission as a keyhole through which access to an object can be obtained and the SID as a unique key that fits the keyhole (see Figure 10.4). Each object has a set of keyholes, one matching the SID "key" for each user or group that has a specific permission. When you assign permission for an object (a process covered in How-To 10.5), you in effect "drill another keyhole" into the object and encode it with the SID of a specific user or group.

Ensuring a Secure Database

It is altogether too easy to think you have "secured" a Microsoft Access database yet actually have a security system with gaping holes. The holes can exist because the predefined default users and groups are exceptions to the way SIDs are built. Default users' and groups' SIDs are built as shown in Table 10.8.

Figure 10.4. Security IDs and permissions.

Table 10.8. Security ID sources for default users and groups.

USER OR GROUP SID Source
Admin user Hard-coded and identical in every system database
Guest user Hard-coded and identical in every system database
Users group Hard-coded and identical in every system database
Guests group Hard-coded and identical in every system database
Admins group Built by the Jet engine from three pieces of data: a username, a company name, and an ID number

The information in Table 10.8 has extremely important implications for database security. The Admin user's SID is hard-coded and identical in every system database; that means that objects created by the Admin user can be accessed by the Admin user in any system database. All someone needs to do to gain access to an object created by an Admin user from any system database is to create a new system database and log in as Admin. Admin is the default user; in an unsecured system, all users are Admin. Therefore, if you create an object in an unsecured system, that object belongs to Admin and cannot be secured.

One solution (recommended by Microsoft in the Microsoft Access documentation) is to delete the Admin user from the system database. This is permissible as long as the Admins group contains at least one other user.

Unlike the Admin user SID, the Admins group SID is unique to each system database. Note in Table 10.8 that the Admins group SID requires an ID number. If the system database was created by the Microsoft Access setup program, the ID number component of the Admins group SID is taken from the setup disks, and each set of setup disks is uniquely encoded. If the system database is created through the Microsoft Access Workgroup Administrator, the ID number component is computed based on an identifier entered by the person who creates the system database with the Workgroup Administrator.

This scheme prevents someone who is a member of an Admins group in one system database from automatically getting Admins group permissions when accessing database files through other system databases; because the Admins group SIDs are different, the permissions are different (recall the concept of unique keyholes and keys from Figure 10.4). But it also means that all users who are currently members of the Admins group of the system database in use when the database was originally created will always have the ability to change permissions on all objects in the database--and this ability cannot be removed by anyone. Therefore, when you create a database you intend to secure, you should be cognizant of who is defined to the system database as part of the Admins group.

Another implication of Table 10.8 is that permissions assigned to the Guests or Users group through one system database will be available to members of the Guests or Users group in any system database. Therefore, assign the Guests or Users groups only the permissions you are willing to give to anyone. If you need to assign permissions to a group of users and you want to restrict who can access the permissions, create a new group (see How-To 10.10 for details on how to create a group and assign users to it).

Accessing a Secured System Through Visual Basic

Before your application can access a secured Microsoft Access system, it needs to provide the Jet engine with several pieces of information:

After the Jet engine knows where to look for usernames and passwords, you provide a username and password. You can do this by straightforward assignment to DBEngine properties:

DBEngine.DefaultUser = "Annette"
DBEngine.DefaultPassword = "mouseketeer"

The username is not case-sensitive, but the password is case-sensitive. If the password is recorded in the system database as Mouseketeer and you supply mouseketeer, the login attempt will fail.

Workspaces and Sessions

The Jet engine implements most database security features through the Workspace object and its Groups and Users collection. A Workspace object is a member of the Workspaces collection of the Database object.

When you set the IniPath, DefaultUser, and DefaultPassword properties of the DBEngine object, you are actually setting the UserName and Password for the default workspace. The default workspace can be accessed by its name, DBEngine.Workspaces("#Default Workspace#"), in which the # symbols are part of the name, or as DBEngine.Workspaces(0).

A Workspace object defines a session for a user. Session and workspace are close to being synonyms. Within a session, you can open multiple databases. Transactions occur within sessions.

For the default workspace, a session begins when you set the DefaultUser and DefaultPassword properties for the DBEngine object. After you have successfully initialized the default session, your program can create additional password-protected sessions.

To open a new session, you create a new Workspace object by using the CreateWorkspace method of the DBEngine object. The CreateWorkspace method takes three required arguments: Name (the name of the workspace), UserName, and Password. You can append the Workspace object to the DBEngine object's Workspaces collection--although you do not need to add the Workspace object to the collection to use the object. This code fragment initializes the default workspace and then creates a new Workspace object named My Space for the user Lucy, whose password is diamonds. It then opens a database within the new workspace.

Dim wkSpace as Workspace
Dim db as Database
DBEngine.IniPath = "D:\MYAPP\THEINI.INI"
DBEngine.DefaultUser = "Mary"
DBEngine.DefaultPassword = "contrary"
Set wkSpace = DBEngine.CreateWorkspace("My Space", "Lucy", "diamonds")
Set db = wkSpace.OpenDatabase("BIBLIO.MDB")

Note that you must be logged into the DBEngine object via the DefaultUser and DefaultPassword objects before you can create additional workspaces.

Steps

Open the Secure project (Secure.vbp) and make sure that the path in the GetWorkgroupDatabase function points to your SYSTEM.MDW file. Then run the Secure project. You will first see a dialog box indicating the system database name to be used in the application. The next dialog box is that of a typical logon screen, as shown in Figure 10.5. Here you can enter different usernames and passwords to access the database.

Figure 10.5. The Secure project.

1. Create a new project and name it Secure.vbp. Add the objects and edit the properties as shown in Table 10.9; then save the form as frmSecure.frm.

Table 10.9. Objects and properties for the Secure project.

OBJECT Property Setting
Form Name frmSecure
Caption Secure
Text box Name txtUserName
Text box Name txtPassword
Command button Name cmdOK
Caption &OK
Default True
Command button Name cmdCancel
Caption &Cancel
Cancel True
Label Name lblUserName
Caption &User Name
Label Name lblPassword
Caption &Password.

2. There are no form-level variables to declare in this project, so go directly to entering the Form_Load code as shown next. This code sets the DBEngine properties with the default user and password to access the SYSTEM.MDW file.

Private Sub Form_Load()
` if there is an error, goto the code labeled by ERR_Form_Load
On Error GoTo ERR_Form_Load:
    ` local variables used to hold the user name and password
    Dim sUser As String
    Dim sPassword As String
    With DBEngine
        ` set the system database INI path (registry key)
        DBEngine.IniPath = GetINIPath
        ` set system database file
        .SystemDB = GetWorkgroupDatabase
        ` set default user information
        sUser = "Admin"
        sPassword = "myturn"
        ` assign default user information
        .DefaultUser = sUser
        .DefaultPassword = sPassword
        ` display current system database
        MsgBox "The system database is " & .SystemDB, vbInformation
    End With
Exit Sub
ERR_Form_Load:
    ` display the error information and then end the application
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With
    Unload Me
End Sub. 


3. Now enter the code for cmdOK_Click. This event creates a new Workspace object with the supplied information from the frmSecure form, and if it is successful, it opens a recordset obtaining some information.

Private Sub cmdOK_Click()
` if an error occurs, then goto the code labeled by 
` ERR_cmdOK_Click
On Error GoTo ERR_cmdOK_Click:
    ` local object variables used to hold the database, recordset,
    ` and workspace
    Dim db As Database
    Dim rs As Recordset
    Dim ws As Workspace
    ` local variable used to store database path and name
    Dim sDBName As String
    ` local variables used to store the username and password
    Dim sUserName As String
    Dim sPassword As String
    ` if there is no username, inform the user and exit the 
    ` procedure if there is a username, assign the name and 
    ` password
    If (txtUserName = "") Then
        MsgBox "You must enter a username.", vbExclamation, _
               "ERROR"
        txtUserName.SetFocus
        Exit Sub
    Else
        sUserName = txtUserName
        sPassword = txtPassword
    End If
    ` create a new workspace for the user
    Set ws = DBEngine.CreateWorkspace _
                 ("NewWorkspace", sUserName, sPassword)
    ` obtain the database name and path from ReadINI and then open
    ` the database
    sDBName = DBPath
    Set db = ws.OpenDatabase(sDBName)
    ` ensure that we have connected by creating a recordset of 
    ` some data
    Set rs = db.OpenRecordset("SELECT * FROM Customers")
    ` inform the user that we are successful
    MsgBox "User " & txtUserName & " connected successfully!", _
           vbInformation, "SUCCESS"
Exit Sub
ERR_cmdOK_Click:
    ` display the error information and then end the application
    ` With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With
End Sub. 


4. Now add the trivial code to end the project in the cmdCancel_Click event:

Private Sub cmdCancel_Click()
    ` end the application
    Unload Me
End Sub

How It Works

When the application starts, frmSecure is loaded. The Load event connects to the system database designated in the Windows Registry and, if it is successful, displays a message showing the name of that database. When the user clicks the OK button, the click event creates a new Workspace object, opens ORDERS.MDB, and opens a recordset based on a table in ORDERS.MDB. If these steps are successful, the username and password are valid and the user has Read Data privileges to the table.

Comments

In previous versions of Visual Basic, the Jet engine looked in INI files for the name of the system database file. With Visual Basic 6.0 and the Jet 3.51 engine, the system database file is located in the Windows Registry. Probably the most likely spot to find this file would be in your Windows system directory.

10.5 How do I...

Assign permissions for database objects?

Problem

I need to write an application for the system administrators where I work, to allow them to change the permissions of users for Access databases. These administrators don't necessarily have Access available to them. How do I provide this capability through my own Visual Basic application?

Technique

Permissions for a database are stored in a system table in the database. If you have Administer access to the database, you can change these permissions through Access or Visual Basic.

Each Microsoft Access Database object owns a Containers collection where the following are true:

The values of the Permissions object for each combination of permissions for users other than the Admin user are shown in Table 10.10. (The values for the Admin user, Administer, and Modify Design permissions vary, depending on whether the object represented by the document is a table or a query.) Each permission named in the Permission or Permissions column includes not only the named permission but also all implied permissions. For example, the value of permissions property is 20 when Read Data and its implied property Read Design are True; the value is 116 when Update Data and Delete Data and all the implied properties of both are True.

Table 10.10. Permissions property values for users other than Admin.

PERMISSION OR PERMISSIONS Value of Permissions Property
No permissions 0
Read Design 4
Read Data 20
Insert Data 52
Update Data 84
Update Data and Insert Data 116
Delete Data 148
Insert Data and Delete Data 180
Update Data and Delete Data 212
Update Data, Insert Data, and Delete Data 244
Modify Design 65756
Modify Design and Insert Data 65788
Administer 852478

You can determine the permissions a user has for a table or a query by setting the UserName property of the Document object to the user's name and then reading the Permissions property. If you have Administer permission for the table or query, you can set permissions for other users by setting the UserName property and then assigning a value to the Permissions property.

Steps

Open the Permitter project and make sure that the GetWorkgroupDatabase function returns the proper fully qualified path for the SYSTEM.MDW file. When this is done, run the application. You should see the form shown in Figure 10.6. Select a combination of a single user and a table or query from the two list boxes on the Permitter form. You can change various properties set for each combination and save them by clicking the Save button. Notice the permission code above the check boxes. It changes according to the combinations of permissions granted to the user for the given table or query.

Figure 10.6. The Permitter project.

1. Create a new project and name it Permitter.vbp. Add and edit the objects and properties as listed in Table 10.11, and save the form as frmPermitter.frm. Note that all the check boxes are part of a control array.

Table 10.11. Objects and properties for the Permitter project.

OBJECT Property Setting
Form Name frmPermitter
Caption Permitter
List box Name lstUsers
List box Name lstTablesAndQueries
Command button Name cmdSave
Caption &Save
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True
Frame Name fraPermissions
Caption Permissions
Check box Name chkPermission
Caption &Read Design
Index 0
Check box Name chkPermission
Caption &Modify Design
Index 1
Check box Name chkPermission
Caption &Administer
Index 2
Check box Name chkPermission
Caption R&ead Data
Index 3
Check box Name chkPermission
Caption &Update Data
Index 4
Check box Name chkPermission
Caption &Insert Data
Index 5
Check box Name chkPermission
Caption &Delete Data
Index 6
Label Name lblPermissionCode
Caption Permission Code:
Label Name lblPermissions
Caption 0
Label Name lblUsers
Caption &Users
Label Name lblTablesAndQueries
Caption &Tables and Queries

2. First enter the following form-level declarations in the declarations section of the project. The database object variable will serve as the home of the database object referred to throughout the project. The constant declarations with the PER_ prefix correspond to the seven check boxes on the frmPermitter form. The last set of declarations, those preceded by the DB_ characters, are used to indicate the different values associated with the permissions.

Option Explicit
` form-level object variable used to store database object
Private db As Database
` form-level constant declarations which correspond to check boxes
` on the frmPermitter form
Const PER_READ_DESIGN = 0
Const PER_MODIFY_DESIGN = 1
Const PER_ADMINISTER = 2
Const PER_READ_DATA = 3
Const PER_UPDATE_DATA = 4
Const PER_INSERT_DATA = 5
Const PER_DELETE_DATA = 6
` form-level constant declarations which indicate various 
` permissions
Const DB_NOPERMISSIONS = 0
Const DB_READDESIGN = 4
Const DB_READDATA = 20
Const DB_INSERTDATA = 52
Const DB_UPDATEDATA = 84
Const DB_UPDATEINSERTDATA = 116
Const DB_DELETEDATA = 148
Const DB_INSERTDELETEDATA = 180
Const DB_UPDATEDELETEDATA = 212
Const DB_UPDATEINSERTDELETEDATA = 244
Const DB_MODIFYDESIGN = 65756
Const DB_MODIFYDESIGN_INSERTDATA = 65788
Const DB_READSEC = 131072
Const DB_ADMINISTER = 852478


3. Enter the Form_Load event as shown next. This code sets the default user and password of the DBEngine object. You might have to change the values of these two variables to your system administrator's name and password. The database is then open, and the two list boxes on the form are populated. If there are no current users for the database, the application is terminated.

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
    Dim sDBName As String
    ` assign default username 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
        ` get path and name of database from ReadINI module
        sDBName = DBPath
        ` open database
        Set db = .Workspaces(0).OpenDatabase(sDBName)
    End With
    ` populate the two list boxes with the available users, 
    ` tables, and queries from database
    FillUserList
    FillTableAndQueriesList
    ` if there are no valid users, inform the user and exit the 
    ` application
    If (lstUsers.ListCount < 1) Then
        MsgBox "There are no users!", vbExclamation, "USERS"
        cmdClose_Click
    Else
        ` initialize the list boxes to point to the first item in 
        ` each list box
        lstUsers.ListIndex = 0
        lstTablesAndQueries.ListIndex = 0
    End If
Exit Sub
ERR_Form_Load:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
        vbExclamation, _
               "ERROR"
    End With
End Sub


4. Enter the following Form_Unload code now. This code ensures that the database object is released by setting it to nothing when the application is terminated.

Private Sub Form_Unload(Cancel As Integer)
    ` close the database
    Set db = Nothing
End Sub


5. Now enter both the lstUsers and the lstTablesAndQueries Click event code. Each event relies on the other's list box having a selected item. If there is a selected item in the corresponding list box, the ReadPermissions procedure is called to gather the permission information for the user and table/query combination, checking off the appropriate check boxes on the form.

Private Sub lstUsers_Click()
    ` if the TablesAndQueries list box is set to one of the items, 
    ` call the ReadPermissions procedure, and if there was an 
    ` error, unselect all check boxes
    If (lstTablesAndQueries.ListIndex >= 0) Then
        If (Not ReadPermissions()) Then
            lstUsers.ListIndex = -1
            UnCheckAll
        End If
    End If
End Sub
Private Sub lstTablesAndQueries_Click()
    ` if the Users list box is set to one of the items, call the
    ` ReadPermissions procedure, and if there was an error, 
    ` unselect all check boxes
    If (lstUsers.ListIndex >= 0) Then
        If (Not ReadPermissions()) Then
            lstTablesAndQueries.ListIndex = -1
            UnCheckAll
        End If
    End If
End Sub


6. The chkPermission_Click event handles all seven check boxes found on the frmPermitter form. This code ensures that the correct combinations of check boxes are set. Enter the following code:

Private Sub chkPermission_Click(Index As Integer)
    Dim nCount As Integer
    With chkPermission(Index)
        ` set the appropriate check box values dependent upon the 
        ` others
        Select Case Index
            Case PER_READ_DESIGN:
                If (.Value = vbUnchecked) Then
                    For nCount = 0 To 6
                        chkPermission(nCount).Value = vbUnchecked
                    Next nCount
                End If
            Case PER_MODIFY_DESIGN:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = _
                       vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                    chkPermission(PER_UPDATE_DATA).Value = _
                       vbChecked
                    chkPermission(PER_INSERT_DATA).Value = _
                       vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = _
                       vbUnchecked
                End If
            Case PER_ADMINISTER:
                If (.Value = vbChecked) Then
                    For nCount = 0 To 6
                        chkPermission(nCount).Value = vbChecked
                    Next nCount
                End If
            Case PER_READ_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = _
                       vbChecked
                Else
                    chkPermission(PER_MODIFY_DESIGN).Value = _
                       vbUnchecked
                    chkPermission(PER_UPDATE_DATA).Value = _
                       vbUnchecked
                    chkPermission(PER_DELETE_DATA).Value = _
                       vbUnchecked
                    chkPermission(PER_INSERT_DATA).Value = _
                       vbUnchecked
                    chkPermission(PER_ADMINISTER).Value = _
                       vbUnchecked
                End If
            Case PER_UPDATE_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = _
                       vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = _
                       vbUnchecked
                    chkPermission(PER_MODIFY_DESIGN).Value = _
                       vbUnchecked
                End If
            Case PER_INSERT_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = _
                       vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = _
                       vbUnchecked
                End If
            Case PER_DELETE_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = _
                       vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = _
                       vbUnchecked
                    chkPermission(PER_MODIFY_DESIGN).Value = _
                       vbUnchecked
                End If
        End Select
    End With
End Sub


7. Enter the cmdSave_Click event code now. This code calculates the Permission Code value from the check boxes on the form and saves it
to the Permissions property of the appropriate Document object.

Private Sub cmdSave_Click()
` if there is an error, goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:
    Dim oDocument As Document
    Dim lPermissionCode As Long
    ` set the document object variable to the proper selected 
    ` table or query from the list box
    Set oDocument = _
               db.Containers("Tables").Documents(lstTablesAndQueries.Text)
    ` create the proper permission code dependent upon the 
    ` selected check boxes of frmPermitter
    If chkPermission(PER_ADMINISTER) = vbChecked Then
        lPermissionCode = DB_ADMINISTER
    ElseIf chkPermission(PER_MODIFY_DESIGN) = vbChecked Then
        If chkPermission(PER_INSERT_DATA) = vbChecked Then
            lPermissionCode = DB_MODIFYDESIGN_INSERTDATA
        Else
            lPermissionCode = DB_MODIFYDESIGN
        End If
    ElseIf chkPermission(PER_UPDATE_DATA) = vbChecked Then
        If chkPermission(PER_INSERT_DATA) = vbChecked Then
            If chkPermission(PER_DELETE_DATA) = vbChecked Then
                lPermissionCode = DB_UPDATEINSERTDELETEDATA
            Else
                lPermissionCode = DB_UPDATEINSERTDATA
            End If
        Else
            lPermissionCode = DB_UPDATEDATA
        End If
    ElseIf chkPermission(PER_INSERT_DATA) = vbChecked Then
        If chkPermission(PER_DELETE_DATA) = vbChecked Then
            lPermissionCode = DB_INSERTDELETEDATA
        Else
            lPermissionCode = DB_INSERTDATA
        End If
    ElseIf chkPermission(PER_DELETE_DATA) = vbChecked Then
        lPermissionCode = DB_DELETEDATA
    ElseIf chkPermission(PER_READ_DATA) = vbChecked Then
        lPermissionCode = DB_READDATA
    ElseIf chkPermission(PER_READ_DESIGN) = vbChecked Then
        lPermissionCode = DB_READDESIGN
    Else
        lPermissionCode = DB_NOPERMISSIONS
    End If
    With oDocument
        ` save the permission code to the document object for the 
        ` proper user
        .UserName = lstUsers.Text
        If (UCase$(.UserName) = "ADMIN") Then _
                lPermissionCode = lPermissionCode + DB_READSEC
        .Permissions = lPermissionCode
        lblPermissions.Caption = .Permissions
    End With
Exit Sub
ERR_cmdSave_Click:
    ` display the error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
               vbExclamation, "ERROR"
    End With
End Sub


8. Enter the cmdClose_Click event code given next. This simply ends the application.

Private Sub cmdClose_Click()
    ` close the application
    Unload Me
End Sub


9. The UnCheckAll procedure, as shown here, is called from throughout the application to clear all the check boxes on the form:

Private Sub UnCheckAll()
    Dim nCount As Integer
    ` set all the permission check boxes to unchecked
    For nCount = 0 To 6
        chkPermission(nCount).Value = vbUnchecked
    Next nCount
End Sub


10. Now enter both the FillUserList and the FillTableAndQueriesList procedures as shown next. The FillUserList procedure populates the lstUsers list box with the information found in the Users collection of the new workspace, and the FillTableAndQueriesList procedure populates the lstTablesAndQueries list box with the tables and queries found in the Documents collection of the Tables container.

Private Sub FillUserList()
    Dim oUser As User
    ` populate the user list boxes with all users except CREATOR, 
    ` ENGINE, and ADMIN (these shouldn't be changed)
    For Each oUser In DBEngine.Workspaces(0).Users
        With oUser
            If (UCase$(.Name) <> "CREATOR") _
            And (UCase$(.Name) <> "ENGINE") _
            And (UCase$(.Name) <> "ADMIN") Then
                lstUsers.AddItem .Name
            End If
        End With
    Next
End Sub
Private Sub FillTableAndQueriesList()
    Dim oDocument As Document
    ` populate the TableAndQueries list boxes with all the 
    ` available tables and queries except the system ones
    For Each oDocument In db.Containers("Tables").Documents
        With oDocument
            If (Left$(.Name, 4) <> "MSys") Then _
                    lstTablesAndQueries.AddItem .Name
        End With
    Next
End Sub


11. The ReadPermissions function returns a Boolean value: True for success and False for failure. This code breaks down the Permissions property of the appropriate Document object and checks off the corresponding check boxes of the frmPermitter form.

Function ReadPermissions() As Boolean
` if there is an error, then goto the code labeled by ERR_ReadPermissions
On Error GoTo ERR_ReadPermissions:
    Dim nCount As Integer
    Dim lPermissionCode As Long
    Dim oDocument As Document
    ` set the document object to the appropriately selected table 
    ` or query
    Set oDocument = _
            db.Containers("Tables").Documents(lstTablesAndQueries.Text)
    ` set the user name and get the current permissions for that 
    ` user
    With oDocument
        .UserName = lstUsers.Text
        lblPermissions.Caption = .Permissions
        lPermissionCode = .Permissions
    End With
    ` set all check boxes to unchecked
    UnCheckAll
    ` set the appropriate check boxes for the current permission 
    ` for the user selected
    Select Case lPermissionCode
        Case DB_READDESIGN
            chkPermission(PER_READ_DESIGN).Value = vbChecked
        Case DB_READDATA
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
        Case DB_INSERTDATA
            chkPermission(PER_INSERT_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        Case DB_UPDATEDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        Case DB_UPDATEINSERTDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        Case DB_DELETEDATA
            chkPermission(PER_DELETE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        Case DB_INSERTDELETEDATA
            chkPermission(PER_DELETE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
        Case DB_UPDATEDELETEDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
        Case DB_UPDATEINSERTDELETEDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
        Case DB_MODIFYDESIGN
            chkPermission(PER_MODIFY_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
        Case DB_MODIFYDESIGN_INSERTDATA
            chkPermission(PER_MODIFY_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
        Case DB_ADMINISTER
            For nCount = 0 To 6
                chkPermission(nCount).Value = vbChecked
            Next nCount
    End Select
    ` indicate success
    ReadPermissions = True
Exit Function
ERR_ReadPermissions:
    ` display the error for the user
    With Err
        MsgBox "ERROR #" & .Number& & ": " & .Description, _
        vbExclamation, "ERROR"
    End With
    ` indicate failure
    ReadPermissions = False
End Function

How It Works

When the form loads, the program connects to the system database, opens the ORDERS database, and populates the two list boxes according to the available information from these two databases. When the user selects both a valid user and a table or query from the list boxes, the ReadPermissions function is called to display the options available for the combination through seven check boxes on the form. The user can change these permissions and then save them by clicking the Save button. The application then calculates a new value for the Permissions property of the appropriate user/document combination and saves it to the system database.

Comments

The Permissions help screen identifies built-in constants for representing values of the Permissions property. If you look up these constants in the Object Browser, you can see their values. Using these built-in variables is tricky, however, because it is not always clear which implied properties each is including. The values in Table 10.10 were obtained experimentally, by changing the permissions in Microsoft Access and reading the resulting value of the Permissions property through Visual Basic.

10.6 How do I...

Change ownership of database objects?

Problem

How can I give system administrators the ability to change the ownership of various tables and queries through my Visual Basic application?

Technique

Every data object in Microsoft Access has an owner. The default owner is the creator of that object. The owner has specific permissions that others do not necessarily have. These permissions include the right to grant full privileges to himself or others.

The name of the owner of a table or query resides in the Owner property of the appropriate Document object that represents the data object. A user with Administer permission can change the owner of any data object by changing the name of the Owner property.

Steps

Open the project OWNERSHIP.VBP and make sure that the GetWorkgroupDatabase function is returning the proper fully qualified path to your SYSTEM.MDW file. When this is done, run the application. If the username and password variables, located in the Form_Load event, are correct, you should see the form shown in Figure 10.7. When a user clicks on a table or query in the list box, the owner of that data object is selected from the other list box. By selecting a different user from the list and clicking the Save Owner button, you can change ownership of the data object.

1. Create a new project and call it OWNERSHIP.VBP. Use Form1 to create the objects and edit the properties as listed in Table 10.12. Save the form as frmOwnership.frm.

Figure 10.7. The Ownership project.

Table 10.12. Objects and properties for the Ownership project.

OBJECT Property Setting
Form Name frmOwnership
Caption Ownership
List box Name lstUsers
List box Name lstTablesAndQueries
Command button Name cmdSave
Caption &Save
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True
Label Name lblUsers
Caption &Users:
Label Name lblTablesAndQueries
Caption &Tables And Queries

2. Begin by entering the following code into the declarations section of the project:

Option Explicit
` form-level object variable used to hold the database object
Private db As Database


3. Now enter the Form_Load event code as listed next. Change the sUserName and sPassword variables to hold the values of your administrator's username and password.

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
    Dim sDBName 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
        ` get path and name of database from ReadINI module
        sDBName = DBPath
        ` open database
        Set db = .Workspaces(0).OpenDatabase(sDBName)
    End With
    ` populate the two list boxes with the available users, 
    ` tables, and queries from database
    FillUserList
    FillTableAndQueriesList
    ` if there are no valid users, inform the user and exit the 
    ` application
    If (lstUsers.ListCount < 1) Then
        MsgBox "There are no users!", vbExclamation, "USERS"
        cmdClose_Click
    Else
        ` initialize the list boxes to point to the first item in 
        ` each list box
        lstUsers.ListIndex = 0
        lstTablesAndQueries.ListIndex = 0
    End If
Exit Sub
ERR_Form_Load:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With
End Sub


4. Enter the Form_Unload code to ensure that the database object variable is closed and released before the application terminates:

Private Sub Form_Unload(Cancel As Integer)
    ` close the database
    Set db = Nothing
End Sub


5. Now enter the code for both the FillTableAndQueriesList and the FillUserList procedures. These two routines are very similar to those found in the preceding How-To. The FillTableAndQueriesList proce-dure populates the lstTablesAndQueries list box with the names of the data objects in the Tables container. The FillUserList routine populates the lstUsers list box with the users found in the Users collection of the current Workspace object.

Private Sub FillTableAndQueriesList()
    Dim oDocument As Document
    ` populate the TableAndQueries list boxes with all the 
    ` available tables and queries except the system ones
    For Each oDocument In db.Containers("Tables").Documents
        With oDocument
            If (Left$(.Name, 4) <> "MSys") Then _
                    lstTablesAndQueries.AddItem .Name
        End With
    Next
End Sub
Private Sub FillUserList()
    Dim oUser As User
    ` populate the user list boxes with all users except CREATOR 
    ` and ENGINE (these shouldn't be changed)
    For Each oUser In DBEngine.Workspaces(0).Users
        With oUser
            If (UCase$(.Name) <> "CREATOR") _
            And (UCase$(.Name) <> "ENGINE") Then
                lstUsers.AddItem .Name
            End If
        End With
    Next
End Sub


6. Now enter the lstTablesAndQueries_Click event code as listed here. This code finds the owner of the selected data object from the Users list by comparing it to the Owner property of the selected Document object.

Private Sub lstTablesAndQueries_Click()
    Dim nCount As Integer
    Dim sCurOwner As String
    With lstUsers
        ` loop through each user until the owner of the selected 
        ` table or query is found
        For nCount = 0 To .ListCount - 1
        sCurOwner = _
          db.Containers("Tables").Documents(lstTablesAndQueries.Text).Owner
            If (.List(nCount) = sCurOwner) Then .ListIndex = nCount
        Next nCount
    End With
End Sub


7. The cmdSave_Click event code simply changes the value of the Owner property of the Documents object to that of the selected user from the lstUsers list box:

Private Sub cmdSave_Click()
` if there is an error, goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:
    ` assign the new owner to the select table or query
    db.Containers("Tables").Documents(lstTablesAndQueries.Text).Owner = _
            lstUsers.Text
Exit Sub
ERR_cmdSave_Click:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
                vbExclamation, "ERROR"
    End With
End Sub


8. Finally, enter the following code for the cmdClose_Click event to terminate the application:

Private Sub cmdClose_Click()
    ` end the application
    Unload Me
End Sub

How It Works

When the program starts, the system database is accessed using the default user and password properties. With this database, the lstTablesAndQueries list box is populated with the available data objects. The Users list box is populated with all the users available in the given workgroup. When the user selects a data object from the list, the Owner property of that data object is used to find the user who is the owner of it. With a click of the Save button on the frmOwnership form, the Owner property is changed to the currently selected user in the lstUsers list box.

Comments

You have added extensive error-handling code to the preceding few How-To's. This is because of the complexity involved, and the precision necessary, when accessing the system database. A lot of the code will vary from machine to machine and user to user, depending on usernames and passwords.

If you are working on a single PC that is not part of a network, there is a very good chance that you will have only one or two users listed in the lstUsers list box. To add more users to your system, jump to How-To 10.9 to see a project that enables you to add more users.

10.7 How do I...

Change or delete database

passwords?

Problem

How do I give the system administrators at my site the ability to change users' passwords for Access databases from my Visual Basic applications?

Technique

Each user's password is stored in the Password property of the corresponding User object. The current user's password is stored in the Password property of the current Workspace object.

The Password property cannot be read through Visual Basic, and it cannot be directly set. To change the password, you must use the NewPassword method for a given user. The NewPassword method has two arguments--the first being the current password and the second being the new password. Ordinary users cannot change their password without knowing the current one.

Users with Administer power can change other users' passwords as well as their own without the need to know the current password. Instead, an empty string is passed to the NewPassword method in place of the current password.

Steps

Open and run the PASSWORDS.VBP project. A list of available users appears on the form, as shown in Figure 10.8. You can change the password of a given user by clicking the Change Password button, or you can delete the password for a user by clicking the Delete Password button.

Figure 10.8. The Passwords project.

1. Create a new project and save it as PASSWORDS.VBP. Use Form1 to add the objects and edit the properties as listed in Table 10.13. Save the form as frmPasswords.frm.

Table 10.13. Objects and properties for the Passwords project.

OBJECT Property Setting
Form Name frmPasswords
Caption Passwords
List box Name lstUsers
Command button Name cmdChangePassword
Caption C&hange Password
Command button Name cmdDeletePassword
Caption &Delete Password
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True
Label Name lblUsers
Caption &Users

2. Begin by entering the Form_Load event code to access the system database and the call to FillUserList, which populates the lstUsers list box. If there are no users in the list, the application terminates.

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
    ` populate the users list box with the available users
    FillUserList
    ` if there are no valid users, inform the user and exit the 
    ` application
    If (lstUsers.ListCount < 1) Then
        MsgBox "There are no users!", vbExclamation, "USERS"
        cmdClose_Click
    Else
        ` initialize the list boxes to point to the first item in 
        ` users list
        lstUsers.ListIndex = 0
    End If
Exit Sub
ERR_Form_Load:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
               vbExclamation, "ERROR"
    End With
    ` end the application
    cmdClose_Click
End Sub


3. Enter the code for the Click event of the cmdChangePassword command button as shown next. This code asks for the old password, the new password, and a confirmation of the new password; then it calls the ChangePassword routine to change the password. Users logged in as Admin do not have to specify anything for the old password because they have the power to change the current password without any knowledge
of it.

Private Sub cmdChangePassword_Click()
    ` local variables used to store passwords
    Dim sOldPassword As String
    Dim sNewPassword As String
    Dim sConPassword As String
    ` ask for old password
    sOldPassword = InputBox( _
                   "Please enter the old password for user `" _
                            & lstUsers.Text & "`.", _
                            "CHANGE PASSWORD")
    ` ask for new password
    sNewPassword = InputBox( _
                   "Please enter the new password for user `" _
                            & lstUsers.Text & "`.", _
                            "CHANGE PASSWORD")
    ` confirm new password
    sConPassword = InputBox("Please confirm new password for user `" _
                            & lstUsers.Text & "`.", _
                            "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
       MsgBox "New password does not match confirmed password.", _
               vbExclamation, "ERROR"
    Else
        ChangePassword sOldPassword, sNewPassword
    End If
End Sub


4. Now enter the code to delete a password located in the Click event of the cmdDeletePassword command button. This event asks for the old password and calls the ChangePassword routine with an empty string as a new password to delete the current password. Again, if the user is logged on as Admin, as in this example, it is unnecessary to enter an old password.

Private Sub cmdDeletePassword_Click()
    ` local variable used to store old password
    Dim sOldPassword As String
    ` ask for old password
    sOldPassword = InputBox(_
"Please enter the old password for user `" _
                            & lstUsers.Text & "`.", _
                                       "DELETE PASSWORD")
    ` change the password
    ChangePassword sOldPassword, ""
End Sub


5. Enter the code for the cmdClose_Click event to terminate the application:

Private Sub cmdClose_Click()
    ` end the application
    Unload Me
End Sub


6. The FillUserList routine is listed next. This procedure adds all the current users of the workgroup to the lstUsers list box except for CREATOR and ENGINE. These should not be changed; therefore, they are not available for access by the user.

Private Sub FillUserList()
    Dim oUser As User
    ` populate the user list boxes with all users except CREATOR 
    ` and ENGINE (these shouldn't be changed)
    For Each oUser In DBEngine.Workspaces(0).Users
        With oUser
            If (UCase$(.Name) <> "CREATOR") _
            And (UCase$(.Name) <> "ENGINE") Then
                lstUsers.AddItem .Name
            End If
        End With
    Next
End Sub


7. Finally, enter the ChangePassword routine listed here. This procedure takes two arguments. The first is the old password, and the second is the new password. If there are no errors, the password is changed using the NewPassword method.

Private Sub ChangePassword(sOldPassword As String, _
                           sNewPassword As String)
` if there is an error, then goto the code labeled by 
` ERR_ChangePassword
On Error GoTo ERR_ChangePassword:
    ` constant used to define application-defined error
    Const ERR_PASSWORD_TOO_LONG = 32000
    ` if the new password is too long, raise application-defined 
    ` error
    If (Len(sNewPassword) > 14) Then Error ERR_PASSWORD_TOO_LONG
    ` change password, given the old and new passwords
    DBEngine.Workspaces(0).Users(lstUsers.Text).NewPassword _
             sOldPassword, sNewPassword
    ` if we got this far, we must be successful; notify the user
    MsgBox "Password successfully changed for user `" _
           & lstUsers.Text & "`", vbInformation, "SUCCESS"
Exit Sub
ERR_ChangePassword:
    ` local variable used to hold error message
    Dim sMessage As String
    With Err
        Select Case .Number
            ` application-defined error, password too long
            Case ERR_PASSWORD_TOO_LONG:
                sMessage = _
                   "The password must be 14 characters or less."
            ` unexpected error, create error message with number 
            ` and description
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & _
                           .Description
        End Select
    End With
    ` display error for the user
    MsgBox sMessage, vbExclamation, "ERROR"
End Sub

How It Works

After the program accesses the system database in the Form_Load event, the list box on the form is populated with the available users in the workgroup. When a user selects a username from the list and clicks the Change Password button, old and new passwords are sent to the ChangePassword procedure, where a call to the NewPassword method changes the password. When the user clicks the Delete Password button, an empty string is passed to the ChangePassword procedure to set the new password to nothing, therefore deleting it.

10.8 How do I...

Use a single password for data access for all users?

Problem

I want to secure my Access database, but I do not think it is necessary for each user to have his or her own password. Instead, I want to create a password that I can change for the entire database, regardless of the user. How do I create a single password for an entire Access database with Visual Basic?

Technique

The same concept shown in How-To 10.7 applies here. The NewPassword method is used to change the password for a given Access database.

The NewPassword not only applies to the User object, but it also is available with the Database object. When you specify a password for a database, you must connect to that database in the future with a string indicating the valid password.

This string is passed as an argument to the OpenDatabase method, as shown in this example:

Set db = _
  DBEngine.Workspaces(0).OpenDatabase(DBName, True, False, ";pwd=PASSWORD")

Here, db is a database object, DBName is a valid path and name of an Access database, and PASSWORD is the password for the given database.

Steps

Open and run the DatabasePassword.vbp project. You should see the form as shown in Figure 10.9. When a user clicks the Open Database button, she is prompted with an input box asking for the password for the database. If there is no password, the user simply presses Enter. After the database is open, the user can change the password by clicking the Change Password button. Just as with changing a user's password, the project prompts for the old password as well as the new and a confirmation of the new password. If all is successful, the password is changed.

Figure 10.9. The DatabasePassword project.

1. Create a new project and save it as DatabasePassword.vbp. Add the objects and edit the properties of Form1 as shown in Table 10.14. Afterward, save the form as frmDatabasePassword.frm.

Table 10.14. Objects and properties for the DatabasePassword project.

OBJECT Property Setting
Form Name frmDatabasePassword
Caption Database Password
Command button Name cmdOpenDatabase
Caption &Open Database
Command button Name cmdChangePassword
Caption Change &Password
Command button Name cmdCloseDatabase
Caption &Close Database
Command button Name cmdExit
Caption &Exit
Cancel -1 `True
Default -1 `True

2. Enter the following code in the declarations section of your project. The db object variable is used to store the database object, and the NO_ERROR constant declaration is used throughout the project to indicate success.

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


3. Now enter the familiar Form_Load event as shown next. This event, like the others in the previous How-To sections, establishes a link with the system database using a default user and password. These variables might need to be altered by the user to her own Administer values.

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


4. Add the code that ensures that the database is closed in the Form_Unload event as shown here:

Private Sub Form_Unload(Cancel As Integer)
    ` ensure that the database is closed upon shutdown of 
    ` application
    cmdCloseDatabase_Click
End Sub


5. Now enter the code for the cmdOpenDatabase_Click event of the Open Database command button. This code prompts the user for the current database password, creates a password string, and passes it to the OpenDatabase method. If all is successful, the user is notified that the database is opened, and the Change Password and Close Database buttons are enabled.

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


6. The cmdChangePassword_Click event prompts the user for the old password, the new, and a confirmation, and successfully changes the password by calling the NewPassword method of the Database object. Enter the following code:

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


7. The Click event of the Close Database command button is listed next. This procedure simply releases the database object by setting it equal
to nothing and disables the Change Password and Close Database
buttons, as well as enables the Open Database button. The final event, cmdExit_Click, ends the application. Enter these procedures now:

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

How It Works

When the DatabasePassword project is initialized, the system database is addressed with the default username and password. When the user opens the database, he is prompted for the current password. This password is used to create a string that is passed to the OpenDatabase method to open the database object.

When the user elects to change the current database password, he is asked to supply the old and new passwords, as well as a confirmation of the new password. With a call to the NewDatabase method of the database object, the password is changed.

You should note that the password cannot be changed when a database is opened in shared mode. As in this How-To, you must open the database exclusively (by specifying True as the second argument to the OpenDatabase method) to change the password.

Comments

Every How-To in this chapter uses the same database, the ORDERS.MDB database file. When you are through with this How-To, be sure to change the database password back to a NULL string so that the other How-To projects can successfully access the database!

10.9 How do I...

Add new users to a system database?

Problem

I need to give system administrators at my user sites the ability to add new users to the system database. How do I accomplish this task through Visual Basic?

Technique

The Workspace object has a collection called Users. Each user defined in the system database has a corresponding User object within the Users collection. To add a new user, you must first create a new User object. The new User object must be supplied a name, a PID, and, optionally, a password.

The PID is a case-sensitive alphanumeric string between 4 and 20 characters in length. The Jet engine uses this PID in combination with the username to build a security ID for a user.

After the User object is created, it is appended to the Users collection of the current Workspace object via the Append method.

Steps

Open and run the AddUser.vbp project. You should see the form shown in Figure 10.10. To add a user, click the Add User button and supply a username and password; the PID string is calculated from the username. If the user is successfully added, you will see a message box indicating so, and the list box on the form will be updated to include the new user.

Figure 10.10. The AddUser project.

1. Create a new project and call it AddUser.vbp. Using Form1, add the objects and edit the properties as shown in Table 10.15, saving the form as frmAddUser.frm.

Table 10.15. Objects and properties for the AddUser project.

OBJECT Property Setting
Form Name frmAddUser
Caption Add User
List box Name lstUsers
Command button Name cmdAddUser
Caption &Add User
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True
Label Name lblUsers
Caption &Users

2. There are no form-level declarations in this project, so go ahead and enter the Form_Load event code as shown next. This code accesses the system database using the default username, Admin, and an empty string password. After this is done, the FillUserList procedure is called to show all the available users in the system database.

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
    ` populate the users list box with the available users
    FillUserList
Exit Sub
ERR_Form_Load:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
               vbExclamation, _
               "ERROR"
    End With
    ` end the application
    cmdClose_Click
End Sub


3. Now enter the code for the Click event of the cmdAddUser command button. This event asks the user for both a username and a password. After error-checking the input values, the procedure calls the GetNewPID procedure to receive a personal identifier. This event then creates a new User object with this information and appends it to the Users collection
of the current Workspace object.

Private Sub cmdAddUser_Click()
` if there is an error, then goto code labeled by 
` ERR_cmdAddUser_Click
On Error GoTo ERR_cmdAddUser_Click:
    ` local variables used to store passwords
    Dim sNewUserName As String
    Dim sNewPassword As String
    Dim sConPassword As String
    ` local variables used for the new user
    Dim sPID As String
    Dim oNewUser As User
    ` constant declarations for application-defined error messages
    Const ERR_NO_USER_NAME = 32000
    Const ERR_PASSWORD_TOO_LONG = 32001
    Const ERR_PASSWORDS_NOT_EQUAL = 32002
    ` enter a new username
    sNewUserName = InputBox("Please enter a new username.", _
"ADD USER")
    ` trim excess white spaces from the username
    sNewUserName = Trim$(sNewUserName)
    ` if no username is entered, notify the user and abandon task
    If (sNewUserName = "") Then Error ERR_NO_USER_NAME
    ` ask for new password
    sNewPassword = InputBox( _
                   "Please enter the new password for user `" _
                            & sNewUserName & "`.", "ADD USER")
    ` if the password is too long, notify the user and end the 
    ` task
    If (Len(sNewPassword) > 14) Then Error ERR_PASSWORD_TOO_LONG
    ` confirm new password
    sConPassword = InputBox("Please confirm new password for user `" _
                            & sNewUserName & "`.", "ADD USER")
    ` if new password is not equivalent to the confirmed password,
    ` notify the user and end the task
    If (sNewPassword <> sConPassword) Then Error _
       ERR_PASSWORDS_NOT_EQUAL
    `get a PID for the new user
    sPID = GetNewPID(sNewUserName)
    With DBEngine
        ` create a new user object from username, pid, and 
        ` password
        Set oNewUser = .Workspaces(0).CreateUser(sNewUserName, _
                                                 sPID, _
                                                 sNewPassword)
        ` append the new users to the workspace
        .Workspaces(0).Users.Append oNewUser
    End With
    ` repopulate list box with new users
    FillUserList
    ` notify the user of success
    MsgBox "User `" & sNewUserName & "` added successfully.", _
            vbInformation, "ADD USER"
Exit Sub
ERR_cmdAddUser_Click:
    ` variable used for error message
    Dim sMessage As String
    With Err
        ` create an error message for given error code
        Select Case .Number
            Case ERR_NO_USER_NAME:
                sMessage = "You did not enter a user name."
            Case ERR_PASSWORD_TOO_LONG:
                sMessage = _
                   "The password must be 14 characters or less"
            Case ERR_PASSWORDS_NOT_EQUAL:
                sMessage = "The confirmed password is not " _
                         & "equivalent to the new password."
            ` unexpected error, create an error message from the 
            ` error number and description
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & _
                         .Description
        End Select
    End With
    ` display the error message for the user
    MsgBox sMessage, vbExclamation, "ERROR"
End Sub


4. Enter the following code to terminate the application:

Private Sub cmdClose_Click()
    ` end the application
    Unload Me
End Sub


5. Now enter the FillUserList procedure, which populates the lstUsers list box with all the users listed in the system database:

Private Sub FillUserList()
    Dim oUser As User
    With lstUsers
        ` clear current list of users
        .Clear
        ` populate the user list boxes with all users
        For Each oUser In DBEngine.Workspaces(0).Users
            .AddItem oUser.Name
        Next
    End With
End Sub


6. Finally, enter the GetNewPID function, which creates a new PID string for the specified username, ensuring that it is at least 4 but no more than 20 characters:

Private Function GetNewPID(sUserName As String) As String
    Dim sPID As String
    ` create new PID
    sPID = sUserName
    If (Len(sPID) > 20) Then
        ` if the PID is greater than 20 characters, shorten it
        sPID = Left$(sPID, 20)
    Else
        ` if the PID is less than 4 characters, add some 
        ` underscores
        While (Len(sPID) < 4)
            sPID = sPID & "_"
        Wend
    End If
    ` return newly created PID value
    GetNewPID = sPID
End Function

How It Works

When the AddUser project starts, the code reads the system database to populate the list box on the form with the available users. When the user decides to add a new user by clicking the Add User button, he must enter both a new username and a password. The username is used to create a PID string. The name, PID, and password are then used to create a new User object, which is appended to the existing Users collection.

Comments

To remove a user from the system database, simply use the Delete method of the Workspace object's Users collection to delete the desired user, as shown here:

DBEngine.Workspaces(0).Users("USERNAME").Delete

Here, USERNAME is a name of a user currently in the Users collection of the current workspace.

10.10 How do I...

Define new groups in a system database?

Problem

How do I give system administrators the ability to define new groups in the system database through Visual Basic?

Technique

The techniques used in this How-To directly correspond to those used in How-To 10.9. To add a new group to the Groups collection of the current Workspace object, you must first create a new Group object from a group name and a PID.

In previous versions of Microsoft Jet, the identifier used for a group was called a GID (group identifier). Now, to make things uniform, it is called a PID (personal identifier), as it is for a user.

The PID is used in the same manner for a group as for a user. It is used in conjunction with the group name to build an SID for the group. After you create the group with its name and PID, you can append it to the Groups collection of the current Workspace object.

Steps

Open and run the AddGroup.vbp project. You should see the form shown in Figure 10.11. To add a group, click the Add Group button and supply the application with a name for the new group. If all is successful, you will see a verification message box and the new group in the list of groups on the form.

Figure 10.11. The AddGroup project.

1. Create a new project and save it as AddGroup.vbp. Use Form1 to create the objects and edit the properties as listed in Table 10.16. Save this form as frmAddGroup.frm.

Table 10.16. Objects and properties for the AddGroup project.

OBJECT Property Setting
Form Name frmAddGroup
Caption Add Group
List box Name lstGroups
Command button Name cmdAddGroup
Caption &Add Group
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True
Label Name lblGroups
Caption &Groups

2. Enter the Form_Load event code shown next. This code accesses the system database with the default username and password assigned to
the sUserName and sPassword variables, respectively. Then call the FillGroupList to populate the list box on the frmAddGroup form.

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 username 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
    ` populate the group list box with the available groups
    FillGroupList
Exit Sub
ERR_Form_Load:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
               vbExclamation, _
               "ERROR"
    End With
    ` end the application
    cmdClose_Click
End Sub


3. Now enter the code for the Click event of the cmdAddGroup command button. This code asks the user for a new group name and calls GetNewPID to create a personal identifier for the new group. With this information, a new Group object is created and appended to the Groups collection of the current workspace.

Private Sub cmdAddGroup_Click()
` if there is an error, then goto code labeled by 
` ERR_cmdAddGroup_Click
On Error GoTo ERR_cmdAddGroup_Click:
    ` local variables used to store new group name
    Dim sNewGroupName As String
    ` local variables used for the new group
    Dim sPID As String
    Dim oNewGroup As Group
    ` constant declaration for application-defined error message
    Const ERR_NO_GROUP_NAME = 32000
    ` enter a new group name
    sNewGroupName = InputBox("Please enter a new group name.", _
                    "ADD GROUP")
    ` trim excess white spaces from the group name
    sNewGroupName = Trim$(sNewGroupName)
    ` if no group name is entered, notify the user and abandon 
    ` task
    If (sNewGroupName = "") Then Error ERR_NO_GROUP_NAME
    `get a PID for the new group
    sPID = GetNewPID(sNewGroupName)
    With DBEngine
        ` create a new group object from group name, PID, and 
        ` password
        Set oNewGroup = .Workspaces(0).CreateGroup( _
                        sNewGroupName, sPID)
        ` append the new groups to the workspace
        .Workspaces(0).Groups.Append oNewGroup
    End With
    ` repopulate list box with new groups
    FillGroupList
    ` notify the user of success
    MsgBox "Group `" & sNewGroupName & "` added successfully.", _
            vbInformation, "ADD GROUP"
Exit Sub
ERR_cmdAddGroup_Click:
    ` variable used for error message
    Dim sMessage As String
    With Err
        ` create an error message for given error code
        Select Case .Number
            Case ERR_NO_GROUP_NAME:
                sMessage = "You did not enter a group name."
            ` unexpected error, create an error message from the 
            ` error number and description
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & _
                           .Description
        End Select
    End With
    ` display the error message for the user
    MsgBox sMessage, vbExclamation, "ERROR"
    Stop
    Resume
End Sub


4. Enter the code for the cmdClose_Click event, which terminates the application:

Private Sub cmdClose_Click()
    ` end the application
    Unload Me
End Sub


5. Now enter the FillGroupList procedure, which populates the lstGroups list box with the groups found in the system database:

Private Sub FillGroupList()
    Dim oGroup As Group

    With lstGroups
        ` clear current list of groups
        .Clear
        ` populate the group list boxes with all groups
        For Each oGroup In DBEngine.Workspaces(0).Groups
            .AddItem oGroup.Name
        Next
    End With
End Sub


6. To complete the project, enter the GetNewPID function, which accepts the new GroupName as an argument used to create the PID that is returned. The PID will be between 4 and 20 characters in length.

Private Function GetNewPID(sGroupName As String) As String
    Dim sPID As String
    ` create new PID
    sPID = sGroupName
    If (Len(sPID) > 20) Then
        ` if the PID is greater than 20 characters, shorten it
        sPID = Left$(sPID, 20)
    Else
        ` if the PID is less than 4 characters, add some 
        ` underscores
        While (Len(sPID) < 4)
            sPID = sPID & "_"
        Wend
    End If
    ` return newly created PID value
    GetNewPID = sPID
End Function

How It Works

This application begins by accessing the system database and populating the list box with the groups listed within it. When a user decides to add a new group by clicking the Add Group button, he is asked to supply a new group name. A PID is then created from this group name, and with both of these variables, a new Group object is created. This object is then appended to the Groups collection of the current workspace using the Append method. Finally, the list box is repopulated with the inclusion of the new group.

Comments

To remove a group from a system database, simply use the Delete method of the Workspace object's Groups collection to delete the desired group, as shown here:

DBEngine.Workspaces(0).Groups("GROUPNAME").Delete

Here, GROUPNAME is a valid name of a group that belongs to the Groups collection of the current Workspace object.

10.11 How do I...

Add users to groups and delete users from groups?

Problem

How do I give system administrators at my user sites the ability to add and remove users from different groups by using Visual Basic?

Technique

The Group object owns a collection called Users. Each user who belongs to the group is represented by a User object within the Users collection. If a User object exists in a system database, you can add that user to a group by first using the CreateUser method of the Group object to create a temporary User object, supplying the username of a user who is defined within the current system database.

After this job is done, you append the temporary User object to the Users collection of an existing Group object.

Steps

Open and run the AddUsersToGroups.vbp project. You should see the form shown in Figure 10.12. You can select the group you want to work with from the combo box at the top of the form. A list box on the left lists all the available users in the system database, and the list box on the right shows the users who are currently part of the selected group.

Figure 10.12. The AddUsersToGroups project.

To move a user into the currently selected group, select a user from the list of available users and click the > button to move that user to the list of included users. To remove a user from a group, select the user from the list of included users and click the < button. To add all users to a group, click the >> button, and to remove all users from a group, click the << button. Changes are immediate, so be careful!

To delete a user from a group, use the Delete method of the Group object's Users collection.

1. Create a new project and name it AddUsersToGroups.vbp. Add and edit the objects and properties as shown in Table 10.17, and save the form as frmAddUsersToGroups.frm. Notice that the four cmdMove command buttons are part of a control array.

Table 10.17. Objects and properties for the AddUsersToGroups project.

OBJECT PROPERTY SETTING
Form Name frmAddUsersToGroups
Caption Add Users to Groups
Combo box Name cboGroups
Style 2 `Dropdown List
List box Name lstAvailableUsers
Sorted -1 `True
List box Name lstIncludedUsers
Sorted -1 `True
Command button Name cmdMove
Caption <<
Index 0
Command button Name cmdMove
Caption <
Index 1
Command button Name cmdMove
Caption >
Index 2
Command button Name cmdMove
Caption >>
Index 3
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True
Label Name lblGroups
Caption &Groups
Label Name lblAvailableUsers
Caption &Available Users
Label Name lblIncludedUsers
Caption &Included Users

2. Enter the code for the Form_Load event as shown here. This code initializes the DBEngine with the default username and passwords defined in the sUserName and sPassword variables. The event then calls the FillAvailableUserList and FillGroupCombo procedures to populate the form with the available users and groups from the system database.

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 username 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
    ` populate the users list box with the available users
    FillAvailableUserList
    ` if there are no valid users, inform the user and exit the 
    ` application
    If (lstAvailableUsers.ListCount < 1) Then
        MsgBox "There are no users!", vbExclamation, "USERS"
        cmdClose_Click
    Else
        ` populate the group combo box and select the first group 
        ` automatically
        FillGroupCombo
        cboGroups.ListIndex = 0
    End If
Exit Sub
ERR_Form_Load:
    ` display error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
        vbExclamation, _
               "ERROR"
    End With
    ` end the application
    cmdClose_Click
End Sub
3. Now enter the code that repopulates the lstIncludedUsers list box when the user selects a new group from the cboGroups combo box:

Private Sub cboGroups_Click()
    ` fill the included users text boxes for the selected group
    FillIncludedUsers
End Sub
4. Enter the code for the Click event of the cmdMove command buttons now. This event handles all four of the move buttons between the two list boxes on frmAddUsersToGroups. Using the locally declared constants to indicate the different buttons, users are either removed or added to the current group by a call to either RemoveUserFromGroup or AddUserToGroup.

Private Sub cmdMove_Click(Index As Integer)
    Dim nCount As Integer
    ` constant declarations that correspond to the four move 
    ` buttons on the frmAddUsersToGroups form
    Const MOVE_REMOVE_ALL = 0
    Const MOVE_REMOVE = 1
    Const MOVE_ADD = 2
    Const MOVE_ALL = 3
    Select Case Index
        ` remove all included users from list
        Case MOVE_REMOVE_ALL:
            With lstIncludedUsers
                For nCount = 0 To .ListCount - 1
                    RemoveUserFromGroup .List(nCount)
                Next nCount
            End With
        ` if a user is selected, remove it
        Case MOVE_REMOVE:
            With lstIncludedUsers
                If (.ListIndex < 0) Then Exit Sub
                RemoveUserFromGroup .Text
            End With
        ` if a user is selected, add it
        Case MOVE_ADD:
            With lstAvailableUsers
                If (.ListIndex < 0) Then Exit Sub
                AddUserToGroup .Text
            End With
        ` add all users from available users list box
        Case MOVE_ALL:
            With lstAvailableUsers
                For nCount = 0 To .ListCount - 1
                    AddUserToGroup .List(nCount)
                Next nCount
            End With
    End Select
    ` repopulated the included user list box
    FillIncludedUsers
End Sub
5. Enter the code to terminate the application in the cmdClose_Click event:

Private Sub cmdClose_Click()
    ` end the application
    Unload Me
End Sub
6. Now enter the FillGroupCombo, FillAvailableUserList, and FillIncludedUsers procedures, which all use the system database to populate their corresponding controls with groups available, users available, or users in selected group:

Private Sub FillGroupCombo()
    Dim oGroup As Group
    ` populate the group combo box with all available groups
    For Each oGroup In DBEngine.Workspaces(0).Groups
        cboGroups.AddItem oGroup.Name
    Next
End Sub
Private Sub FillAvailableUserList()
    Dim oUser As User
    ` populate the user list boxes with all users except CREATOR 
    ` and ENGINE
    For Each oUser In DBEngine.Workspaces(0).Users
        With oUser
            If (UCase$(.Name) <> "CREATOR") _
            And (UCase$(.Name) <> "ENGINE") Then
                lstAvailableUsers.AddItem .Name
            End If
        End With
    Next
End Sub
Private Sub FillIncludedUsers()
    Dim oUser As User
    With lstIncludedUsers
        ` clear the included users list box
        .Clear
        ` add all the included users for the given group
        For Each oUser In _
                    DBEngine.Workspaces(0).Groups(cboGroups.Text).Users
            .AddItem oUser.Name
        Next
    End With
End Sub
7. Next enter the code to add a new user to a group. This procedure creates a new User object with the name of the selected user and then appends the object to the Users collection of the selected group.

Private Sub AddUserToGroup(sUserName As String)
` if there is an error, goto code labeled by ERR_AddUserToGroup
On Error GoTo ERR_AddUserToGroup:
    Dim oUser As User
    ` constant declaration for error when user is already in group
    Const ERR_USER_IN_GROUP = 3032
    With DBEngine.Workspaces(0).Groups(cboGroups.Text)
        ` create a user and add him to the group
        Set oUser = .CreateUser(sUserName)
        .Users.Append oUser
    End With
Exit Sub
ERR_AddUserToGroup:
    With Err
        Select Case .Number
            ` if user is in group already, continue execution
            Case ERR_USER_IN_GROUP:
                Resume Next
            ` unexpected error, notify user
            Case Else
               MsgBox "ERROR #" & .Number & ": " & .Description, _
                        vbExclamation, "ERROR"
        End Select
    End With
End Sub
8. Finally, enter the code to remove a user from a group. The procedure RemoveUserFromGroup, shown next, uses the Delete method of the Users collection to remove the specified user from the Group object.

Private Sub RemoveUserFromGroup(sUserName As String)
    ` remove user from group
    DBEngine.Workspaces(0).Groups( _
             cboGroups.Text).Users.Delete sUserName
End Sub

How It Works

When the application begins, it accesses the system database with default values for username and password. This database is used to populate the combo box of frmAddUsersToGroups with all the available groups and the Available Users list box with all the users listed in the database.

When a user selects a group, the Users collection of that Group object is used to populate the Included Users list box. To move users in to the specified group, a new User object is created and appended to the Users collection. To remove users from the group, the Remove method of the Users collection is used with the specified user.

10.12 How do I...

Track user activity in a database?

Problem

I want to somehow keep a log to track which users created or edited records in my Access database. How do I track user activity in a database using Visual Basic?

Technique

By creating two fields in a recordset, you can track both the user who modified a record and the date and time a record was modified. The first field, used to track the user, is populated with the current username taken from the UserName property of the current Workspace object.

The second field, the date and time a user modified a record, is populated with the function Now, which returns the current date and time.

Steps

Open and run the project Tracker.vbp. After entering a valid username and password, you should see the form shown in Figure 10.13. A ListView control shows the records of the Customers table in the ORDERS.MDB database. The Order Number, User Name, and Last Modified information is displayed.

By clicking the Add Record button, you can add a dummy record to the recordset that becomes populated in the ListView control. The username specified at the start of the application is used to populate the User Name field of the recordset, and the current date and time is entered into the Last Modified field.

Figure 10.13. The Tracker project.

1. Create a new project and name it Tracker.vbp. Go to the Project | Components menu selection and choose Microsoft Windows Common Controls 6.0 from the list to include the ListView control in your project.

2. Use Form1 in your project to add and edit the objects and properties as shown in Table 10.18. Use the (Custom) property in the property window of the ListView control to add the three ColumnHeaders listed in Table 10.18. Save the form as frmTracker.frm.

Table 10.18. Objects and properties for the Tracker project.

OBJECT PROPERTY SETTING
Form Name frmTracker
Caption Tracker
ListView Name lstCustomers
View 3 `Report View
HideColumnHeaders 0 `False
ColumnHeader Text Order Number
ColumnHeader Text User Name
SubItemIndex 1
ColumnHeader Text Last Modified
SubItemIndex 2
Command button Name cmdAddRecord
Caption &Add Record
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True

3. Now enter the form-level object variables in the declarations section of your project. These variables are used to hold both the database and the recordset objects used throughout the Tracker project.

Option Explicit
` form-level object variables used to store database and recordset 
` objects
Private db As Database
Private rs As Recordset
4. Enter the Form_Load event code as shown next. This code asks the user to enter both a valid username and a password from those in the system database to open the Orders database and call the PopulateListView procedure.

Private Sub Form_Load()
` if there is an error, goto the code labeled by ERR_Form_Load
On Error GoTo ERR_Form_Load:
    ` local constant declaration for invalid user name or password 
    ` error
    Const ERR_INVALID_INFORMATION = 3029
    Dim sUserName As String
    Dim sPassword As String
    Dim sDBName As String
    ` get username
    sUserName = InputBox("Enter user name.", "LOGON")
    ` get user password
    sPassword = InputBox("Enter password.", "LOGON")
    With DBEngine
        ` set system database path and name
        .SystemDB = GetWorkgroupDatabase
        ` set default passwords
        .DefaultUser = sUserName
        .DefaultPassword = sPassword
        ` retrieve database path and name from ReadINI module
        sDBName = DBPath
        ` open database with given user and password
        Set db = .Workspaces(0).OpenDatabase(sDBName)
    End With
    ` populate the list view control
    PopulateListView
Exit Sub
ERR_Form_Load:
    Dim sMessage As String
    With Err
        Select Case .Number
            ` invalid user or password
            Case ERR_INVALID_INFORMATION:
                sMessage = "Invalid user name or password."
            ` unexpected error, notify the user
            Case Else
                sMessage = "ERROR #" & .Number & ": " & _
                           .Description
        End Select
    End With
    ` display the message for the user
    MsgBox sMessage, vbExclamation, "ERROR"
    ` end the application
    cmdClose_Click
End Sub
5. Enter the code to close and release the database and recordset object variables in the Form_Unload event:

Private Sub Form_Unload(Cancel As Integer)
    ` close the recordset and database
    Set rs = Nothing
    Set db = Nothing
End Sub
6. Now enter the cmdAddRecord_Click event code to add a new record. Notice the two fields, User Last Modified and DateTime Last Modified. These are populated with the UserName property of the current workspace and the Now method to successfully create an auditing trail that you will use to track which user created a given record.

Private Sub cmdAddRecord_Click()
` if an error occurs, call the ERR_cmdAddRecord code located at 
` the end of this procedure
On Error GoTo ERR_cmdAddRecord:
    Dim sMessage As String
    Dim lPrimaryKey As Long
    ` used to populate fields in Customer table
    ` this is necessary because most of the fields belong to 
    ` indexes making them required fields
    Const DUMMY_INFO = "<>"
    ` retrieve a unique key from the GetPrimaryKey routine
    lPrimaryKey = GetPrimaryKey
    With rs
        ` add a new record
        .AddNew
        ` fill in the required fields
        .Fields("Customer Number") = lPrimaryKey
        .Fields("Customer Name") = DUMMY_INFO
        .Fields("Street Address") = DUMMY_INFO
        .Fields("City") = DUMMY_INFO
        .Fields("State") = DUMMY_INFO
        .Fields("Zip Code") = DUMMY_INFO
        ` set the username, date, and time of new record to track 
        ` users
        .Fields("User Last Modified") = _
                DBEngine.Workspaces(0).UserName
        .Fields("DateTime Last Modified") = Now
        ` make saves (if an error will occur, it will be here)
        .Update
    End With
    PopulateListView
    ` if we got this far, add new record was successfull
    sMessage = "Record added successfully!"
    MsgBox sMessage, vbInformation, "ADD RECORD"
Exit Sub
ERR_cmdAddRecord:
    ` display error for user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
        vbExclamation, _
               "ERROR"
    End With
End Sub
7. Enter the code to terminate the application on pressing the cmdClose command button:

Private Sub cmdClose_Click()
    ` end the application
    Unload Me
End Sub
8. Now enter the GetPrimaryKey function, which uses the Customer Number field of the last record in the ORDERS.MDB database to create a new unique key:

Private Function GetPrimaryKey()
    ` return a unique primary key based on the Customer Number 
    ` field
    With rs
        ` if there are records in the table already, find the last 
        ` one and add one to the Customer Number as a unique 
        ` Primary Key; otherwise there are no records in the 
        ` table, so return 1 for the first new record to be added
        If (Not (.EOF And .BOF)) Then
            .MoveLast
            GetPrimaryKey = .Fields("Customer Number") + 1
        Else
            GetPrimaryKey = 1
        End If
    End With
End Function
9. Finally, enter the code for the PopulateListView procedure, which repopulates the ListView control with the entire Customer table, showing which user added which Order Number, along with the date and time the record was added:

Private Sub PopulateListView()
    Dim oItem As ListItem
    ` show headers of list view and clear the contents of the 
    ` ListItems collection
    With lstCustomers
        .HideColumnHeaders = False
        .ListItems.Clear
    End With
    ` repopulate the recordset
    Set rs = db.OpenRecordset("Customers", dbOpenTable)
    With rs
        ` order the records by the primary key
        .Index = "PrimaryKey"
        ` add all records to the list view
        While (Not rs.EOF)
            Set oItem = lstCustomers.ListItems.Add(, , _
                            .Fields("Customer Number"))
            oItem.SubItems(1) = "" & .Fields("User Last Modified")
            oItem.SubItems(2) = "" & .Fields( _
                                "DateTime Last Modified")
            .MoveNext
        Wend
    End With
End Sub

How It Works

When the application begins, it asks the user to enter a username and password, which are checked against the system database when the OpenDatabase method is used to access ORDERS.MDB. If the user correctly entered a valid username and corresponding password, the ListView control of the Tracker project is populated with the contents of the Customer table showing the Order Number, User Last Modified, and DateTime Last Modified fields to form an auditing trail of the modification to the recordset.

When the user chooses to add a record by clicking the Add Record button, a new record is created using a newly created primary key. In addition, the current date and time as well as the current username (taken from the UserName property of the current Workspace object) are used.

Comments

When you set the DefaultUser and DefaultPassword properties of the DBEngine object, you are logging in to the system database with that user. You should note that after you set these properties, you cannot change them during the life of your application. You must terminate the program and restart it to log on as a new user.

10.13 How do I...

Create and use an encrypted database?

Problem

I want to prohibit other users from viewing my Access database files from various word processors and spy applications. How can I encrypt my database using Visual Basic?

Technique

To encrypt an Access database, you must either specify encryption upon creation of the database or compact the database into a newly encrypted file. To decrypt an Access database, you must decrypt it to a newly created file using CompactDatabase.

Steps

Open and run the Encryptor.vbp project. You should see the form shown in Figure 10.14. To create a newly encrypted database, click the Create a New Encrypted Database button. You then are asked to specify a database path and name through a common dialog form.

Figure 10.14. The Encryptor project.

To encrypt an existing database, click the Encrypt an Existing Database button, and specify the database to encrypt and a database path and name of the file to encrypt to. Conversely, to decrypt a database, click the Decrypt an Existing Database button, and enter the database to decrypt along with the database to decrypt to. Do not enter a current database name to encrypt or decrypt to; rather, enter a name of a database that does not exist.

1. Create a new project and call it Encryptor.vbp. Go to the Project | Components menu selection and choose Microsoft Common Dialog Control 6.0 from the list to include the File Open Common Dialog control in your project.

2. Add the objects and edit the properties as shown in Table 10.19. Save the form as frmEncryptor.frm.

Table 10.19. Objects and properties for the Encryptor project.

OBJECT Property Setting
Form Name frmEncryptor
Caption Encryptor
Common Dialog Name cdlFile
Filter MS Access Databases (*.mdb)
Command button Name cmdCreateDatabase
Caption Create a &New Encrypted Database
Command button Name cmdEncryptDatabase
Caption &Encrypt an Existing Database
Command button Name cmdDecryptDatabase
Caption &Decrypt an Existing Database
Command button Name cmdClose
Caption &Close
Cancel -1 `True
Default -1 `True

3. Now enter the following constant declarations in the declarations section of your project. These are used to indicate application-defined errors later in the project.

Option Explicit
` form-level constant declarations of application-defined errors
Private Const NO_ERROR = 0
Private Const ERR_DATABASE_EXISTS = 3204
4. Enter the code for the Form_Load event as shown here. Not only does this code log on to the system database as the other How-To projects did, but it also initializes the Common Dialog control used in this project.

Private Sub Form_Load()
` if there is an error, goto the code labeled by ERR_Form_Load
On Error GoTo ERR_Form_Load:
    Dim sUserName As String
    Dim sPassword As String
    sUserName = "admin"
    sPassword = ""
    With DBEngine
        ` set system database path and name
        .SystemDB = GetWorkgroupDatabase
        ` set default passwords
        .DefaultUser = sUserName
        .DefaultPassword = sPassword
    End With
    With cdlFile
        ` set various properties of the common dialog control
        .Flags = cdlOFNExplorer
        .DefaultExt = "mdb"
    End With
Exit Sub
ERR_Form_Load:
    ` display the error message for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, _
        vbExclamation, _
               "ERROR"
    End With
    ` end the application
    cmdClose_Click
End Sub
5. Now enter the code for the Click event of the cmdCreateDatabase command button. This code uses the Common Dialog control to ask the user the name of the database to create. When given this name, the event creates an empty encrypted database.

Private Sub cmdCreateDatabase_Click()
` if there is an error, goto the code labeled by ERR_cmdCreateDatabase_Click
On Error GoTo ERR_cmdCreateDatabase_Click:
    Dim db As Database
    Dim sNewDatabase As String
    With cdlFile
        ` get the name of the database to encrypt or decrypt to
        .filename = ""
        .DialogTitle = "DATABASE TO CREATE"
        .Action = 1
        sNewDatabase = .filename
        ` if the name was not given, abandon task
        If (sNewDatabase = "") Then Exit Sub
    End With
    ` create the encrypted database
    Set db = DBEngine(0).CreateDatabase(sNewDatabase, _
                 dbLangGeneral, dbEncrypt)
    ` close the database
    Set db = Nothing
ERR_cmdCreateDatabase_Click:
    Dim sMessage As String
    With Err
        ` determine error
        Select Case .Number
            ` there is no error, inform the user of success
            Case NO_ERROR:
                sMessage = "Database created successfully. "
            ` the database already exists
            Case ERR_DATABASE_EXISTS:
                sMessage = "You must choose a database that does " _
                         & "not already exist."
            ` 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
6. Enter the code for the cmdEncryptDatabase_Click and the cmdDecryptDatabase_Click events as shown next. These procedures both call the Encryptor routine to either encrypt or decrypt a database, depending on the argument passed to the routine.

Private Sub cmdEncryptDatabase_Click()
    ` call procedure to encrypt database
    Encryptor dbEncrypt
End Sub
Private Sub cmdDecryptDatabase_Click()
    ` call procedure to decrypt database
    Encryptor dbDecrypt
End Sub
7. Enter the cmdClose_Click event code to terminate the application:

Private Sub cmdClose_Click()
    ` terminate the application
    Unload Me
End Sub
8. Finally, enter the following Encryptor procedure, which takes an Integer argument that will be passed to the CompactDatabase method. This argument will be either dbEncrypt or dbDecrypt, depending on which button the user presses.

Private Sub Encryptor(nAction As Integer)
` if there is an error, goto the code labeled by ERR_Encryptor
On Error GoTo ERR_Encryptor:
    Dim sCurDatabase As String
    Dim sNewDatabase As String
    Dim sActionString As String
    ` create string depending upon action decided by user
    If (nAction = dbEncrypt) Then
        sActionString = "ENCRYPT"
    Else
        sActionString = "DECRYPT"
    End If
    With cdlFile
        ` get the name of the database to encrypt or decrypt
        .filename = ""
        .DialogTitle = "DATABASE TO " & sActionString
        .Action = 1
        sCurDatabase = .filename
        ` if the name was not given, abandon task
        If (sCurDatabase = "") Then Exit Sub
        ` get the name of the database to encrypt or decrypt to
        .filename = ""
        .DialogTitle = "DATABASE TO " & sActionString & " TO"
        .Action = 1
        sNewDatabase = .filename
        ` if the name was not given, abandon task
        If (sNewDatabase = "") Then Exit Sub
    End With
    ` encrypt the database
    DBEngine.CompactDatabase sCurDatabase, sNewDatabase, , nAction
ERR_Encryptor:
    Dim sMessage As String
    With Err
        ` determine error
        Select Case .Number
            ` there is no error, inform the user of success
            Case NO_ERROR:
                sMessage = "Database successfully " _
                         & LCase$(sActionString) & "ed to file `" _
                         & sNewDatabase & "`."
            ` the database already exists
            Case ERR_DATABASE_EXISTS:
                sMessage = "You must choose a database that does " _
                         & "not already exist."
            ` 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

How It Works

At the start of this application, the user is logged on to the system database using the default values for both the username and the password. When the user decides to create a new database, the dbEncrypt option is included in the CreateDatabase method to indicate that encryption is to be used on the database.

If the user decides to either encrypt or decrypt an existing database, he must actually create a new database from the existing one by using the CompactDatabase method with an option of dbEncrypt or dbDecrypt. The database to be created from the CompactDatabase method cannot already exist.

Comments

In this How-To, you started off accessing the system database in the Form_Load event given the default Admin username and password, although the project did not necessarily need to access the system database.

Encryption is not really going to help you much unless you also add a password, which you did not do in this application. Encryption stops others from viewing an Access database with anything but Access itself and Visual Basic. Because both these tools are readily available, do not count on encryption as your only source of security. The framework is here for system database security, and this is why you included its access in the Form_Load event.


Previous chapterNext chapterContents

© Copyright, Macmillan Computer Publishing. All rights reserved.