home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mega CD-ROM 1
/
megacd_rom_1.zip
/
megacd_rom_1
/
MAGAZINE
/
INSIDE_T
/
ITPJAN90.ZIP
/
TESTLOCK.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1989-12-15
|
2KB
|
92 lines
PROGRAM TestLock;
USES Crt,Dos,RecLock,FileUtil;
TYPE
TestRec=RECORD
Name: STRING[30];
Zip : STRING[5];
Amount : Real
END;
VAR F:FILE OF TestRec;
OutRec: TestRec;
Ch:Char;
IOTest,code:Integer;
Operation:STRING[5];
RecToLock:LongInt;
PROCEDURE UnLock(RecToUnLock:Integer);
VAR UnLockSuccess:Integer;
BEGIN
UnLockSuccess:=RecordLock(1,
@F,
RecToLock);
LockError(UnLockSuccess,RecToLock);
END;
PROCEDURE Lock(RecToLock:Integer);
VAR Ch:Char;
LockSuccess: Integer;
BEGIN
REPEAT
BEGIN
Ch:=' ';
LockSuccess:=RecordLock(0,
@F,
RecToLock);
LockError(LockSuccess,RecToLock);
IF LockSuccess <> 0 THEN
BEGIN
Write('File ',GetFileName(FileRec(F).Name));
WriteLn(' Record ',RecToLock:4,' is locked');
WriteLn('Would you like to try again (Y/N)?');
Ch:=ReadKey;
Ch:=UpCase(Ch);
END
ELSE
BEGIN
seek(F,RecToLock-1);
Read(F,OutRec);
WITH OutRec DO
BEGIN
WriteLn('RecToLock:',RecToLock:4);
WriteLn('name: ',Name);
WriteLn('zip: ',Zip);
WriteLn('amount: ',Amount:5:2);
WriteLn
END;
END;
END;
UNTIL (LockSuccess=0) OR (Ch='N')
END;
BEGIN
ClrScr;
Val(ParamStr(1),FileMode,code);
Assign(F,'testrec.dat');
{$I-}
Reset(F);
{$I+}
IOTest:=IOResult;
IF IOTest=2 THEN
Rewrite(F)
ELSE
IF IOTest <> 0 THEN IOError(IOTest);
REPEAT
BEGIN
Write('Enter +X to lock or -X to UnLock');
Write(' or Q to Quit: ');
ReadLn(Operation);
Val(Copy(Operation,2,4),RecToLock,code);
CASE Ord(Operation[1]) OF
43:IF (RecToLock > 0) AND
(RecToLock <= FileSize(F)) THEN
Lock(RecToLock);
45:UnLock(RecToLock);
END;
END
UNTIL UpCase(Operation[1])='Q';
Close(F)
END.