
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
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.
This How-To shows you how to add and remove any user in the system database to and from any group.
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.
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.
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.
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 ""
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
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
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
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
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
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
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.
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.
| 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
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
Private Sub Form_Initialize()
` initialize the form controls to show that the table is
` closed upon startup of project
cmdCloseTable_Click
End Sub
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
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
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
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
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
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
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
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.
| 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.
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.
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
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
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
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
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
Private Sub cmdUpdate_Click()
` update the current record in the database
UpdateRecord
End Sub
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
Private Sub cmdClose_Click()
` end the application, this will call the Form_Unload event
Unload Me
End Sub
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
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
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
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
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.
| 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.
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.
| 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.
| 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.
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.
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.
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.
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.
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.
| 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.
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
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
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
Private Sub Form_Unload(Cancel As Integer)
` close the database
Set db = Nothing
End Sub
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
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
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
Private Sub cmdClose_Click()
` close the application
Unload Me
End Sub
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
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
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.
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.
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
Option Explicit ` form-level object variable used to hold the database object Private db As 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
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
Private Sub Form_Unload(Cancel As Integer)
` close the database
Set db = Nothing
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
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
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
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
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.
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.
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
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
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
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
Private Sub cmdClose_Click()
` end the application
Unload Me
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
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.
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.
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
Option Explicit ` form-level object variable declaration used to hold database ` object Private db As Database ` form-level constant declaration used to indicate success Private Const NO_ERROR = 0
Private Sub Form_Load()
` if there is an error, then goto the code section labeled by
` ERR_Form_Load
On Error GoTo ERR_Form_Load:
Dim sUserName As String
Dim sPassword As String
` assign default user name and password
sUserName = "Admin"
sPassword = ""
With DBEngine
` set system database path and name
.SystemDB = GetWorkgroupDatabase
` set default user name and password
.DefaultUser = sUserName
.DefaultPassword = sPassword
End With
` initialize database to closed state to disable various
` buttons
cmdCloseDatabase_Click
Exit Sub
ERR_Form_Load:
` display error for the user
With Err
MsgBox "ERROR #" & .Number & ": " & .Description, _
vbExclamation, _
"ERROR"
End With
` end the application
cmdExit_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
` ensure that the database is closed upon shutdown of
` application
cmdCloseDatabase_Click
End Sub
Private Sub cmdOpenDatabase_Click()
` if there is an error, goto the code labeled by
` ERR_cmdOpenDatabase_Click
On Error GoTo ERR_cmdOpenDatabase_Click:
Dim sPassword As String
Dim sDBName As String
` local constant declaration of application-defined error
Const ERR_NOT_VALID_PASSWORD = 3031
` ask user for the password of the database
sPassword = InputBox("Please enter database password.", _
"OPEN DATABASE")
` create connection string
sPassword = ";pwd=" & sPassword
` retrieve database name and path from the ReadINI module
sDBName = DBPath
` attempt to open the database
Set db = DBEngine.Workspaces(0).OpenDatabase _
(sDBName, True, False, sPassword)
ERR_cmdOpenDatabase_Click:
Dim sMessage As String
With Err
` determine error
Select Case .Number
` there is no error, inform the user of success and
` enable the use of the change password and close
` database command buttons
Case NO_ERROR:
sMessage = "Database opened successfully."
cmdOpenDatabase.Enabled = False
cmdChangePassword.Enabled = True
cmdCloseDatabase.Enabled = True
` password is incorrect
Case ERR_NOT_VALID_PASSWORD:
sMessage = "Invalid password."
` unexpected error, inform the user
Case Else:
sMessage = "ERROR #" & .Number & ": " & _
.Description
End Select
` display the error for the user
MsgBox sMessage, _
IIf(.Number = NO_ERROR, vbInformation, _
vbExclamation), _
IIf(.Number = NO_ERROR, "SUCCESS", "ERROR")
End With
End Sub
Private Sub cmdChangePassword_Click()
` if there is an error,
` goto the code labeled by ERR_cmdChangePassword_Click
On Error GoTo ERR_cmdChangePassword_Click:
` local variables used to store passwords
Dim sOldPassword As String
Dim sNewPassword As String
Dim sConPassword As String
` private constant declarations for application-defined errors
Const ERR_PASSWORDS_DIFFER = 32000
Const ERR_PASSWORD_TOO_LONG = 32001
` ask for old password
sOldPassword = InputBox("Please enter the old password for " _
& "the database.", "CHANGE PASSWORD")
` ask for new password
sNewPassword = InputBox("Please enter the new password for " _
& "the database.", "CHANGE PASSWORD")
If (Len(sNewPassword) > 14) Then Error ERR_PASSWORD_TOO_LONG
` confirm new password
sConPassword = InputBox("Please confirm new password for " _
& "the database.", "CHANGE PASSWORD")
` if new password is not equivalent to the confirmed password,
` notify the user and end the task; otherwise, change the
` password
If (sNewPassword <> sConPassword) Then Error _
ERR_PASSWORDS_DIFFER
` change the password
db.NewPassword sOldPassword, sNewPassword
ERR_cmdChangePassword_Click:
Dim sMessage As String
With Err
` select appropriate error
Select Case .Number
` no error has occurred, inform the user of success
Case NO_ERROR:
sMessage = "Password changed successfully."
` new and confirmed passwords are different
Case ERR_PASSWORDS_DIFFER:
sMessage = "The confirmed password does not " _
& "match the new password."
` password is longer than 14 characters
Case ERR_PASSWORD_TOO_LONG:
sMessage = _
"The password must be 14 characters or less."
` unexpected error, inform the user
Case Else:
sMessage = "ERROR #" & .Number & ": " & _
.Description
End Select
` display the error for the user
MsgBox sMessage, _
IIf(.Number = NO_ERROR, vbInformation, _
vbExclamation), _
IIf(.Number = NO_ERROR, "SUCCESS", "ERROR")
End With
End Sub
Private Sub cmdCloseDatabase_Click()
` close the database
Set db = Nothing
` only allow the user to open the database
cmdOpenDatabase.Enabled = True
cmdChangePassword.Enabled = False
cmdCloseDatabase.Enabled = False
End Sub
Private Sub cmdExit_Click()
` end the application
Unload Me
End Sub
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!
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.
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
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
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
Private Sub cmdClose_Click()
` end the application
Unload Me
End Sub
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
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.
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.
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
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
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
Private Sub cmdClose_Click()
` end the application
Unload Me
End Sub
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
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.
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.
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.
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
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
Private Sub cboGroups_Click()
` fill the included users text boxes for the selected group
FillIncludedUsers
End Sub
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
Private Sub cmdClose_Click() ` end the application Unload Me End Sub
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
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
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.
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.
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
Option Explicit ` form-level object variables used to store database and recordset ` objects Private db As Database Private rs As Recordset
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
Private Sub Form_Unload(Cancel As Integer)
` close the recordset and database
Set rs = Nothing
Set db = Nothing
End Sub
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
Private Sub cmdClose_Click()
` end the application
Unload Me
End Sub
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
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.
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.
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
Option Explicit ` form-level constant declarations of application-defined errors Private Const NO_ERROR = 0 Private Const ERR_DATABASE_EXISTS = 3204
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
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
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
Private Sub cmdClose_Click()
` terminate the application
Unload Me
End Sub
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.
© Copyright, Macmillan Computer Publishing. All rights reserved.