Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DMSLIB.ZIP
Filename : LOCKS.PRG

**||LOCKS.PRG updated on- Friday, October 2, 1987 at- 4:10 pm
**||(c)1987, D M Sampson Consulting
function NET_USE
PARAMETERS file, ex_use, wait,temp
PRIVATE forever,ok
store .f. to ok
store .t. to neterror
forever = (wait=0)
DO WHILE (forever .or. wait > 0) .and. .not. ok
if ex_use
USE &file EXCLUSIVE
else
USE &file
endif

ok = .not. neterr()
neterror = neterr()

if ok
loop
endif
@ 24,60 say 'Trying to lock '+file
?? iif(wait=3 .or. wait=6 .or. wait=9,chr(07),'')
inkey(1)
wait = wait-1
@ 24,60 say space(25)

ENDDO
if .not. ok
save screen to temp
?? chr(07)+chr(07)
@ 05,15 clear to 15,64
@ 05,15 to 15,64 double
line1 = 'Database File &file is in... or,'
line2 = 'can not be set to exclusive use'
line3 = 'Try again when file is free'
line4 = 'Hit any key to continue'
center(07,upper(line1))
center(09,upper(line2))
center(11,upper(line3))
center(13,upper(line4))
set console off
wait
set console on
restore screen from temp
endif
RETURN ok



function FIL_LOCK
PARAMETERS wait
PRIVATE forever,ok,temp

store .f. to ok
store .t. to neterror
forever = (wait = 0)

DO WHILE (forever .OR. wait > 0) .and. .not. ok
ok = FLOCK()
if ok
loop
endif
@ 24,60 say 'Trying to lock '+alias()
?? iif(wait=3 .or. wait=6 .or. wait=9,chr(07),'')
inkey(.5)
wait = wait- .5
@ 24,60 say space(25)
ENDDO
if .not. ok
save screen to temp
?? chr(07)+chr(07)
@ 05,15 clear to 13,64
@ 05,15 to 13,64 double
line1 = 'Database File alias() can not be locked'
line2 = 'Try again when file is free'
line3 = ' HIT ANY KEY ..... '
center(07,upper(line1))
center(09,upper(line2))
center(11,upper(line3))
set console off
wait
set console on
restore screen from temp
endif
RETURN ok


function REC_LOCK
PARAMETERS wait
PRIVATE forever,ok,temp
store .f. to ok
store .t. to neterror
forever = (wait = 0)
DO WHILE (forever .OR. wait > 0) .and. .not. ok

ok = RLOCK()
neterror = .not. ok

if ok
loop
endif
@ 24,60 say 'Trying to lock '+str(recno(),4)
?? iif(wait=3 .or. wait=6 .or. wait=9,chr(07),'')
inkey(.5)
wait = wait-.5
@ 24,60 say space(25)

ENDDO
if .not. ok
save screen to temp
?? chr(07)
@ 20,00 clear to 24,40
@ 20,00 to 24,40
line1 = 'record #'+str(recno(),4)+' is currently '
line2 = 'locked, try this record again when it is free'
line3 = ' HIT ANY KEY .....'
center(21,upper(line1))
center(22,upper(line2))
center(23,upper(line3))
set console off
wait
set console on
restore screen from temp
endif
RETURN ok


function ADD_REC
PARAMETERS wait
PRIVATE forever,ok,temp,mess
store .f. to ok
store .t. to neterror

forever = (wait = 0)
DO WHILE (forever .OR. wait > 0) .and. .not. ok

APPEND BLANK
ok = .NOT. NETERR()
neterror = neterr()

if ok
loop
endif

mess = 'Trying to Append a blank'
rjust(24,mess)
?? iif(wait=3 .or. wait=6 .or. wait=9,chr(07),'')
inkey(.5)
wait = wait-.5
rjust( 24,space( len(mess) ) )

ENDDO
if .not. ok
save screen to temp
?? chr(07)
@ 20,00 clear to 24,40
@ 20,00 to 24,40
line1 = 'this record can not be added to the file'
line2 = 'try adding record again in a few seconds'
line3 = ' HIT ANY KEY ..... '
center(21,upper(line1))
center(22,upper(line2))
center(23,upper(line3))
set console off
wait
set console on
restore screen from temp

endif
return ok

**||End of File-> LOCKS.PRG