Option Public Option Explicit %REM The SimpleCodeLock class attempts to simplify the code you need to write when you use LotusScript locking techniques. This can be useful if your Domino server runs asynchronous agents that write to a single document or file. Multiple agents can use the same lock name, in which case they will share the same lock. Here's a simple example: Dim locker As New SimpleCodeLock Call locker.startLock("My Lock") '** do stuff... Call locker.stopLock() By default, this class will try to establish a lock for 5 seconds, after which time it will give up and continue. You can check the status of the startLock() method to determine whether or not the lock was successful, and you can adjust the timeout using setTimeout(). NOTE: I'm not sure that the timeout stuff actually works. The code examples in Designer Help use a loop to wait for a lock to be established, but the documentation says: "If the lock is already held by another agent, the thread stalls until the lock becomes available." So that implies that if you call CodeLock and something else has a lock, then your code waits for the lock to be available whether you like it or not. %END REM Class SimpleCodeLock Private lockName As String Private lockNum As Integer Private isLocked As Integer Private timeout As Integer Private lastError As String Public Sub new () '** default timeout is 5 seconds Call setTimeout(5) End Sub '** We will try to make sure the lock gets released when '** this object goes out of scope. However, you should '** ALWAYS call stopLock() yourself, and not rely on the '** destructor to do the work for you. Public Sub delete () Call stopLock() End Sub '** The timeout value is how long we're willing to wait to '** establish a lock -- default is 5 seconds. After this time, '** we stop trying to get a lock in startLock(). NOTE: the '** timeout value might not actually work. More testing '** is required... Public Sub setTimeout (numberOfSeconds As Integer) timeout = numberOfSeconds End Sub '** If an error occurs in the startLock() method, you can see '** what it was here. Public Function getLastError () As String getLastError = lastError End Function '** Are we currently in a locked state? Public Function getLockStatus () As Integer getLockStatus = isLocked End Function '** This function will try to establish a lock using the given '** lockName. If the lock is successful, the function will '** return True; otherwise it returns False. Public Function startLock (lockName As String) As Integer On Error Goto processError lastError = "" '** if we're already locked, decide what to do If isLocked Then If (Me.lockName = lockName) Then startLock = True Exit Function Else Call stopLock() End If End If '** create the lock. Note that this doesn't actually '** lock anything yet, it just gives us a lock handle Me.lockName = lockName lockNum = Createlock(lockName) '** keep trying to lock for the duration of our timeout '** (unless CodeLock stalls the script for us, in which '** case we wait for as long as CodeLock wants us '** to wait) Dim sleepInterval As Double Dim maxCount As Double Dim i As Long sleepInterval = 0.1 maxCount = timeout / sleepInterval For i = 0 To maxCount If Codelock(lockNum) Then isLocked = True Exit For End If Sleep(sleepInterval) Next '** we've tried to establish a lock for as long as '** possible. Either we got a lock or we didn't. If Not isLocked Then lastError = "A lock could not be established. Unknown reason." End If startLock = isLocked Exit Function processError: lastError = "Error " & Err & " on line " & Erl & ": " & Error Exit Function End Function '** Release the lock we have, if any. The return value is '** the result of the DestroyLock() function. Public Function stopLock () As Integer On Error Resume Next Dim status As Integer If isLocked Then isLocked = Not Codeunlock(lockNum) status = Destroylock(lockNum) Else status = True End If stopLock = status End Function End Class
This LotusScript was converted to HTML using the ls2html routine,
provided by Julian Robichaux at nsftools.com.