Resource locking in your applications

Jim Dettman (EE MVE)Volunteer
CERTIFIED EXPERT
Independent consultant specializing in the writing of custom packages for businesses.
Published:
Updated:
This article is part of the app development series, a series of articles on Experts-Exchange.com that explores common application development problems and their solutions.

This article presents code written in VBA executing on Windows platforms, but the techniques demonstrated here could be used with any language or application.

Level: Intermediate

The problem:

 Often when developing applications the need arises to control a resource so that other users can’t do something with that resource until you are through with it.

  For many developers, this starts out with the need to lock a specific record and for whatever reason, they don’t want to use the DBMS system to do the locking.  For example, your DBMS system might only lock on pages and you want to be able to lock individual records.   You might also want to “lock” a record in a logical context within the application; you want a customer record to be held from any changes because you are trying to contact the customer. In these cases, locking the record through the DBMS would be impossible or impractical for a number of reasons (i.e. simply cannot do it or length of time).

  Of course your first thought might be to place a flag in the record itself.  A simple yes/no field would work, although you might go one step further and record a user ID and a date/time.  This sounds great (and does work), but what happens if the power goes off?  When the app comes back up, you may now have a number of records with an “in-use” flag set even though no one is using it.

  So you would be stuck with running through every record and clearing the flags.  If you needed to do this with more then a few tables, that process could become very time consuming!  As an alternative, you could provide a means of clearing a lock when someone encounters it (i.e. by asking for an admin password), but that might go on for days or weeks (“Joe, I’ve got another one!”)

A Better approach:

  When developing applications, it’s always better to come up with a generic solution to a problem rather then something specific.  In this case, what if we used a single table to keep track of our locks and checked that?  Now if we re-start for any reason, we would just need to clear a single table.  The only thing we need to add to make this work is a table name and a field to hold a record key.  It might look something like this:

tblResourceLock
LockID – Autonumber – Primary Key
TableName – Text
RecordID – Text – Primary Key of record being locked
UserID – Long – User ID that placed lock
DTPlaced – Date/Time


  Now we have a locking method that could be used for any table within our application or any other.

An even better solution:

   But why stop there?  Would it not be nice to be able to lock any resource our application might use and not just records?  For example, what if you had a printer defined in windows, which was used to produce PDFs (you “print” a report to a file in postscript, then covert that to PDF after the “print” is done with something like Ghost Script).  For this to happen properly, only one process can use that "printer" at any given time.  But Windows will queue up the next print job and as soon as the printer is free will start with the next job, even if the first process may not yet be done converting the output file to a PDF.  This is not always a problem on a workstation, but it can be a real issue on a terminal services server where multiple users have access to the same printers.

  Or what about a logical process restriction, where you do not want users doing anything within a specific area of an app, such as the General Ledger when you are closing out a month?

  To allow for that, we just need a couple of minor changes to our table:

tblResourceLock
LockID – Autonumber – Primary Key
ResourceTag – Text – Candidate Key 1A
ResourceSubTag – Text - Candidate Key 1B
UserID – Long – User ID that placed lock
DTPlaced – Date/Time

  Now we have a “Resource Tag”, which can anything that we want to use as an identifier and a “sub tag” that can classify that further.  In the case of table, a tag might be the table name, and the sub tag would be the record key.  If I left the sub tag blank, it might indicate I was locking the entire table.  For the printer situation, I might only use the tag, filling it with the name of the printer and leave the sub tag blank.  Or I could use the tag for the machine name, and the sub tag for the printer name.

  What else might you use this for?  What about the availability of the app for use?  As soon as the app starts up, you could check for a resource lock with a tag of “APPLOCKOUT” and if it doesn’t exist, it’s OK to continue.   What about just tracking who’s in an application?  Create a lock at app startup with the tag of “USER” and have the sub tag be the user ID.  Then clear it at logout.

And even a little more flexibility:

  One problem that we have right now with this setup is that it is all or nothing deal; we can only have one lock on a resource.  So when we place that lock, it is implied to be exclusive (because no other user can place a lock for the same resource).  In the case of trying to close the General Ledger for the month, one of the things I would need to know before I could start is if anyone was in there currently. Right now, I’d have no way of knowing that.  So we have a problem.

  To get around this, we can add a simple “lock level” indicator:

1 – “Read only” - I’m using a resource, but what I am doing with it doesn’t impact anyone else.
2 – “Mutually Exclusive” – I don’t want anyone using this resource in a way that might impact me.
3 – “Exclusive” – I’m the only one that can be using this resource.

Our lock table now looks like this:

tblResourceLock
LockID – Autonumber – Primary Key
ResourceTag – Text – Index 1A
ResourceSubTag – Text - Index 1B
UserID – Long – User ID that placed lock
DTPlaced – Date/Time
LockLevel – Integer

And a couple of rules to go with that:

A. To place a read only lock, there can be no existing locks with a level of 3
B. To place a mutually exclusive lock, there can be no existing locks with a level of 2 or 3
C. To place an exclusive lock, there can be no other existing locks.

And finally, some code of how you might see this implemented:

Function PlaceResourceLock(strResourceTag As String, strSubTag As String, intLockLevel As Integer, bolDisplayMessage As Boolean) As Variant
                      
                        ' For a given resource tag & sub tag, try and create a lock record.
                        
                        ' Notes on lock level:
                        '  '1' - Shared             - More then one user can have a shared lock.
                        '  '2' - Mutually Exclusive - Only one user can hold a mutually exclusive lock.
                        '                             Other users can hold a shared lock.
                        '  '3' - Exclusive          - Only one user can hold a exclusive lock.
                        '                             No other user can be holding a lock.
                      
                      
                        ' Note: If a lock is requested and a user is already holding a lock,
                        '       the existing lock will be promoted (if possible), demoted (always possible), or
                        '       refreshed based on the current lock level and the level being requested.
                        
                        ' Set some constants so if we error out we know what was going on
                        Const Routine = "PlaceResourceLock"
                        Const Version = "1.0"
                      
                        Dim dbCur As DAO.Database
                        Dim rst As DAO.Recordset
                        Dim strCriteria As String
                        Dim strUserName As String
                        Dim strStationName As String
                      
                        Dim strMsg As String
                        Dim strResourceDisplayName As String
                        Dim intLockCountTry As Integer
                        Dim lngWait As Long
                        Dim lngX As Long
                      
                        On Error GoTo PlaceResourceLockError
                      
                        Set dbCur = CurrentDb()
                      
                        ' Get user and station name
                        strUserName = WhoAmI(True)
                        strStationName = WhoAmI(False)
                      
                        ' Format nice display name for resource
                        ' for use in messages.
                        If strSubTag = "" Then
                          strResourceDisplayName = strResourceTag
                        Else
                          strResourceDisplayName = strResourceTag & "-" & strSubTag
                        End If
                      
                        ' Try and open the table with DenyWrite
                        ' so we have exclusive access.
                        ' We need to do this because checking
                        ' and placing a lock must be an atomic
                        ' operation.
                        Set rst = dbCur.OpenRecordset("tblResourceLocks", dbOpenDynaset, dbDenyWrite)
                      
                        ' First, do we already have an existing lock?
                        strCriteria = "[ResourceTag] = " & Chr$(34) & strResourceTag & Chr$(34)
                        strCriteria = strCriteria & " AND [SubTag] = " & Chr$(34) & strSubTag & Chr$(34)
                        strCriteria = strCriteria & " AND [UserName] = " & Chr$(34) & strUserName & Chr$(34)
                        strCriteria = strCriteria & " AND [StationName] = " & Chr$(34) & strStationName & Chr$(34)
                      
                        rst.FindFirst strCriteria
                      
                        ' Did we find one?
                        If rst.NoMatch = True Then
                          ' No existing lock, so we'll be adding.
                          ' Find out if there are any conflicts
                      
                          ' Criteria for finding a lock record for the resource tag, sub, and level being requested.
                          strCriteria = "[ResourceTag] = " & Chr$(34) & strResourceTag & Chr$(34)
                          strCriteria = strCriteria & " AND [SubTag] = " & Chr$(34) & strSubTag & Chr$(34)
                          strCriteria = strCriteria & " AND [LockLevel] > " & Mid$("210", intLockLevel, 1)
                      
                          rst.FindFirst strCriteria
                      
                          ' Did we find one?
                          If rst.NoMatch = True Then
                            ' No current conflicting lock records.
                            ' Place the lock.
                            rst.AddNew
                            rst![ResourceTag] = strResourceTag
                            rst![SubTag] = strSubTag
                            rst![UserName] = strUserName
                            rst![StationName] = strStationName
                            rst![LockLevel] = intLockLevel
                            rst![LockPlaced] = Now()
                            rst.Update
                      
                            ' Indicate we got lock
                            PlaceResourceLock = True
                      
                          Else
                            ' Existing locks that conflict.
                            If bolDisplayMessage = True Then
                              ' Read records and build up a string
                              ' with all the locks outstanding.
                              strMsg = "Cannot add lock for resource '" & strResourceDisplayName & vbCrLf
                              strMsg = strMsg & "Locks are being held by following users(s):" & vbCrLf & vbCrLf
                              strMsg = "Resource '" & strResourceDisplayName & "' is locked by following users(s):" & vbCrLf & vbCrLf
                              strMsg = strMsg & "Station \ User - Lock Placed" & vbCrLf
                      
                              Do Until rst.EOF
                                strMsg = strMsg & rst![StationName] & " \ " & rst![UserName] & " - " & rst![LockPlaced] & vbCrLf
                                rst.MoveNext
                              Loop
                      
                              ' Close the recordset before we message
                              ' the user so we don't hold open the table.
                              rst.Close
                              Set rst = Nothing
                      
                              MsgBox strMsg, vbExclamation + vbOKOnly
                            End If
                      
                            ' Indicate that we did not get the lock
                            PlaceResourceLock = False
                      
                          End If
                      
                        Else
                          ' We have an existing lock.  Are we trying to
                          ' promote, demote, or refreshing the lock we have?
                          If intLockLevel > rst![LockLevel] Then
                            ' Trying to promote - need to check for locks other then ours.
                            strCriteria = "[ResourceTag] = " & Chr$(34) & strResourceTag & Chr$(34)
                            strCriteria = strCriteria & " AND [SubTag] = " & Chr$(34) & strSubTag & Chr$(34)
                            strCriteria = strCriteria & " AND [LockLevel] > " & Mid$("210", intLockLevel, 1)
                            strCriteria = strCriteria & " AND [UserName] <> " & Chr$(34) & strUserName & Chr$(34)
                            strCriteria = strCriteria & " AND [StationName] <> " & Chr$(34) & strStationName & Chr$(34)
                      
                            rst.FindFirst strCriteria
                      
                            ' Did we find one?
                            If rst.NoMatch = True Then
                              ' No current conflicting lock records, so
                              ' promote the lock.
                              rst.Edit
                              rst![LockLevel] = intLockLevel
                              rst![LockPlaced] = Now()
                              rst.Update
                      
                              ' Indicate we got lock
                              PlaceResourceLock = True
                            Else
                              ' Existing locks that conflict.
                              If bolDisplayMessage = True Then
                                ' Read records and build up a string
                                ' with all the locks outstanding.
                                strMsg = "Cannot promote lock for resource '" & strResourceDisplayName & vbCrLf
                                strMsg = strMsg & "Locks are being held by following users(s):" & vbCrLf & vbCrLf
                                strMsg = strMsg & "Station \ User - Lock Placed" & vbCrLf
                      
                                Do Until rst.EOF
                                  If rst![StationName] <> strStationName Or rst![UserName] <> strUserName Then
                                    strMsg = strMsg & rst![StationName] & " \ " & rst![UserName] & " - " & rst![LockPlaced] & vbCrLf
                                  End If
                                  rst.MoveNext
                                Loop
                      
                                ' Close the recordset before we message
                                ' the user so we don't hold open the table.
                                rst.Close
                                Set rst = Nothing
                      
                                MsgBox strMsg, vbExclamation + vbOKOnly
                              End If
                      
                              ' Indicate that we did not get the lock
                              PlaceResourceLock = False
                      
                            End If
                      
                          ElseIf intLockLevel < rst![LockLevel] Then
                            ' Demoting the lock
                            rst.Edit
                            rst![LockLevel] = intLockLevel
                            rst![LockPlaced] = Now()
                            rst.Update
                            PlaceResourceLock = True
                      
                          Else
                            ' Refreshing the lock.
                            rst.Edit
                            rst![LockPlaced] = Now()
                            rst.Update
                            PlaceResourceLock = True
                          End If
                      
                        End If
                      
                      PlaceResourceLockExit:
                        On Error Resume Next
                      
                        If Not rst Is Nothing Then
                          rst.Close
                          Set rst = Nothing
                        End If
                      
                        Set dbCur = Nothing
                      
                        Exit Function
                      
                      PlaceResourceLockError:
                        'Table locked by another user
                        If Err.Number = CNT_ERR_RESERVED Or Err.Number = CNT_ERR_UNABLE_TO_LOCK_TABLE Or Err.Number = CNT_ERR_COULDNT_UPDATE Or Err.Number = CNT_ERR_OTHER Then
                          intLockCountTry = intLockCountTry + 1
                          If intLockCountTry > 5 Then
                            PlaceResourceLock = False
                            Resume PlaceResourceLockExit
                          Else
                            DoEvents
                            DBEngine.Idle DB_FREELOCKS
                            lngWait = intLockCountTry ^ 2 * Int(Rnd * 20 + 5)
                            For lngX = 1 To lngWait
                              DoEvents
                            Next lngX
                            Resume
                          End If
                        Else
                          MsgBox "Unexpected error" & Err.Number & " - " & Err.Description & " - Line: " & VBA.Erl & " in routine: " & Routine & " version: " & Version
                          PlaceResourceLock = Null
                          Resume PlaceResourceLockExit
                        End If
                      
                      End Function

Open in new window


   and a corresponding function to clear existing locks:

Function ClearResourceLock(strResourceTag As String, strSubTag As String, strUser As String, strStationName As String) As Variant
                      
                          ' Clear locks based on passed criteria
                          ' calling routine should pass an '*' (asterick)
                          ' to clear all locks for a given field.
                      
                          Const Routine = "ClearResourceLock"
                          Const Version = "1.0"
                      
                          Dim dbCur As DAO.Database
                          Dim rst As DAO.Recordset
                          Dim strSQL As String
                          Dim strWhere As String
                          Dim intLockCountTry As Integer
                          Dim lngWait As Long
                          Dim lngX As Long
                      
                          On Error GoTo ClearResourceLockError
                      
                          Set dbCur = CurrentDb()
                      
                          If strResourceTag & strUser & strStationName <> "" Then
                      
                              ' Start of SQL Select
                              strSQL = "Select * FROM tblResourceLocks "
                      
                              ' Construct the WHERE clause
                              strWhere = ""
                      
                              If strResourceTag <> "*" And strResourceTag <> "" Then
                                  strWhere = strWhere & "ResourceTag = " & Chr$(34) & strResourceTag & Chr$(34) & " AND "
                                  If strSubTag <> "*" Then strWhere = strWhere & "SubTag = " & Chr$(34) & strSubTag & Chr$(34) & " AND "
                              End If
                      
                              If strUser <> "*" And strUser <> "" Then
                                  strWhere = strWhere & "UserName = " & Chr$(34) & strUser & Chr$(34) & " AND "
                              End If
                      
                              If strStationName <> "*" And strStationName <> "" Then
                                  strWhere = strWhere & "StationName = " & Chr$(34) & strStationName & Chr$(34) & " AND "
                              End If
                      
                              ' Add WHERE clause if needed.
                              If strWhere <> "" Then strSQL = strSQL & "WHERE " & left$(strWhere, Len(strWhere) - 5)
                      
                              strSQL = strSQL & ";"
                      
                              Set rst = dbCur.OpenRecordset(strSQL, dbOpenDynaset, dbDenyWrite)
                      
                              ' Delete all records found.
                              Do Until rst.EOF = True
                                  rst.Delete
                                  rst.MoveNext
                              Loop
                      
                              ClearResourceLock = True
                          Else
                              MsgBox "Invalid call to " & Routine & " - No Arguments passed"
                              ClearResourceLock = False
                          End If
                      
                      ClearResourceLockExit:
                          On Error Resume Next
                      
                          If Not rst Is Nothing Then
                              rst.Close
                              Set rst = Nothing
                          End If
                      
                          Set dbCur = Nothing
                      
                          Exit Function
                      
                      ClearResourceLockError:
                          'Table locked by another user
                          If Err.Number = CNT_ERR_RESERVED Or Err.Number = CNT_ERR_UNABLE_TO_LOCK_TABLE Or Err.Number = CNT_ERR_COULDNT_UPDATE Or Err.Number = CNT_ERR_OTHER Then
                              intLockCountTry = intLockCountTry + 1
                              If intLockCountTry > 5 Then
                                  ClearResourceLock = False
                                  Resume ClearResourceLockExit
                              Else
                                  DoEvents
                                  DBEngine.Idle DB_FREELOCKS
                                  lngWait = intLockCountTry ^ 2 * Int(Rnd * 20 + 5)
                                  For lngX = 1 To lngWait
                                      DoEvents
                                  Next lngX
                                  Resume
                              End If
                          Else
                              MsgBox "Unexpected error " & Err.Number & " - " & Err.Description & " - Line: " & VBA.Erl & " in routine: " & Routine & " version: " & Version
                              ClearResourceLock = Null
                              Resume ClearResourceLockExit
                          End If
                      
                      End Function

Open in new window


  Note that you can clear locks in a number of ways; by tag/sub tag, user, or station.

Are there any drawbacks with this?

  Well the obvious one; we are not truly locking anything.  Only within the context of our application do these “locks” apply and only if we use them consistently.  If I use a printer and forget to request a lock first, nothing will stop the process from actually using that printer.

  The other issue here is concurrency.  Some of you may have noticed that I am opening the resource table with deny write and in the error trapping code, there is logic to support a number of tries in placing a lock before it will give up.  With having this error logic in place and a small number of users, locking the table momentarily to check for and place a lock won’t be a problem.  However if you have a high number of users, the last thing you want to do is lock an entire table for anything.  In an add-on to this article, I’ll demonstrate the “reservation” technique in writing the locks, allowing you to place locks without locking the entire table.

In summary:
   
  For many, the table setup and logic above will provide all you need to do basic resource locking within your applications as it provides all the basic building blocks to get the job done.   But it is basic and I’m sure many of you will find ways in which you can extend or modify it.

  One only needs to add a little thought and you’ll find that there are numerous ways in why you can use the above in your applications.
5
4,441 Views
Jim Dettman (EE MVE)Volunteer
CERTIFIED EXPERT
Independent consultant specializing in the writing of custom packages for businesses.

Comments (11)

CERTIFIED EXPERT
Fellow
Most Valuable Expert 2017

Author

Commented:
Mohamed,

Here are the constants:

Const CNT_ERR_RESERVED = 3000
Const CNT_ERR_UNABLE_TO_LOCK_TABLE = 3211
Const CNT_ERR_COULDNT_UPDATE = 3260
Const CNT_ERR_OTHER = 3262
Const CNT_ERR_NO_CURRENT_ROW = 3021

as for the follow-up article, I never got around to writing it mainly because I never found a situation where the concurrency issues were enough of a problem to warrant taking the time to do so.

Jim.
Thank You Jim for the quick response.

Kindest Regards,
Mohamed
CERTIFIED EXPERT
Fellow
Most Valuable Expert 2017

Author

Commented:
No problem.

If you do implement this and find that concurrency is an issue with locking the table, let me know and I'll take the time to work up the code and article for the reservation technique.   Cannot make any promises on a time frame though as I am quite busy at the moment.

Jim.
Jim

Fantastic article on 'Resource Locking'. Thank you. This addresses one of my biggest challenges in my MS Access applications.
One Question though, Where in the Application should the functions be called?

Thanks
Anton Greffrath
CERTIFIED EXPERT
Fellow
Most Valuable Expert 2017

Author

Commented:
Anton,

Glad you enjoyed the article.

<<Where in the Application should the functions be called?>>

  Anywhere you want/need them.   For example, if I have a single label printer that's shared, then I "lock" the printer just before I print, and clear the lock when I'm done.

  If I'm tracking users, then I place a "user" lock right after the login form and don't clear it until the app quits.

 Or if I have a call record that a supervisor needs to look at, it becomes "locked" on based on some condition, then is not cleared until a supervisor reviews the problem.

 Think of the locks more as a flag or reservation.

Jim.

View More

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.