Semaphore Record Locking in FoxPro2.6

[Guest_imported]

Hi there,

Has anyone got any exmaples of semaphore locking used to enable multi-user access to a Foxpro2.6 system?

We want to use it to lock individual records while allowing others access to the system.

Thanks,

SteveH

 

[davidtoranzo]

Hi Steve,

I suggest you to consult the followings functions and commands in FP help file:

RLOCK()
SET REPROCESS
SET MULTILOCKS
UNLOCK

There you can find abundant information and examples as well.

Good luck!

David.

 

[DSummZZZ]

Here are a couple of functions I use for record locking.
Use the SET REPROCESS statement in you initialization area of your main program. 5 SECONDS will attempt a record lock, pause for 5 seconds, retry, and so on:

SET REPROCESS TO 5 SECONDS
SET PROCEDURE TO proc_lib &&... or whatever it is named

When it comes time to attempt a record lock, you can do something like:

SELECT table1
IF rec_lock()
   SELECT table2
   IF rec_lock()
      IF *... any other locks that need to be made
         *... update record(s)
      ENDIF
   ENDIF
ENDIF
UNLOCK ALL

Then place the following two finctions within your procedure library (proc_lib.prg):

*!********************************************************
*!       Function: REC_LOCK
*!
*!          Calls: ABORTRLOCK         
*!
*!*******************************************************
FUNCTION rec_lock
   
   PUBLIC abort_rlock
   
   STORE 0 TO retries
   STORE .F. TO islocked
   STORE .F. TO abort_rlock
   SET ESCAPE ON
   ON ESCAPE DO abortrlock
   
   DO WHILE retries <= 10 .AND. !abort_rlock
      IF RLOCK()
         STORE .T. TO islocked
         EXIT
      ELSE
         retries = retries + 1
         WAIT WINDOW 'Attempting to lock record...' + LTRIM(STR(retries)) + '/10'NOWAIT
         STORE .F. TO islocked
      ENDIF ( RLOCK() )
   ENDDO ( retries <= 10 .AND. !abort_rlock )

   IF !islocked
      WAIT WINDOW &quot;Unable to lock record' TIMEOUT 3
   ENDIF

   SET ESCAPE OFF
   RETURN islocked
*: end proc 
   
*!*********************************************************
*!      Procedure: ABORTRLOCK
*!
*!      Called by: REC_LOCK()         (function  in STRATPRC.PRG)
*!
*!*********************************************************
PROCEDURE abortrlock
   
   ON ESCAPE
   SET ESCAPE OFF
   abort_rlock = .T.
   WAIT WINDOW &quot;Lock request aborted.&quot; TIMEOUT 2
   RETURN

*: end proc

Dave S.