home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPJAN90.ZIP / TESTLOCK.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-12-15  |  1.8 KB  |  92 lines
  1. PROGRAM TestLock;
  2. USES Crt,Dos,RecLock,FileUtil;
  3.  
  4. TYPE
  5.   TestRec=RECORD
  6.      Name: STRING[30];
  7.      Zip : STRING[5];
  8.      Amount : Real
  9.   END;
  10.  
  11. VAR F:FILE OF TestRec;
  12.     OutRec: TestRec;
  13.     Ch:Char;
  14.     IOTest,code:Integer;
  15.     Operation:STRING[5];
  16.     RecToLock:LongInt;
  17.  
  18. PROCEDURE UnLock(RecToUnLock:Integer);
  19. VAR UnLockSuccess:Integer;
  20. BEGIN
  21.  UnLockSuccess:=RecordLock(1,
  22.                            @F,
  23.                            RecToLock);
  24.  LockError(UnLockSuccess,RecToLock);
  25. END;
  26.  
  27. PROCEDURE Lock(RecToLock:Integer);
  28. VAR Ch:Char;
  29.     LockSuccess: Integer;
  30. BEGIN
  31. REPEAT
  32.  BEGIN
  33.  Ch:=' ';
  34.  LockSuccess:=RecordLock(0,
  35.                          @F,
  36.                          RecToLock);
  37.  LockError(LockSuccess,RecToLock);
  38.  IF LockSuccess <> 0 THEN
  39.   BEGIN
  40.    Write('File ',GetFileName(FileRec(F).Name));
  41.    WriteLn(' Record ',RecToLock:4,' is locked');
  42.    WriteLn('Would you like to try again (Y/N)?');
  43.    Ch:=ReadKey;
  44.    Ch:=UpCase(Ch);
  45.   END
  46.  ELSE
  47.   BEGIN
  48.    seek(F,RecToLock-1);
  49.    Read(F,OutRec);
  50.    WITH OutRec DO
  51.     BEGIN
  52.      WriteLn('RecToLock:',RecToLock:4);
  53.      WriteLn('name: ',Name);
  54.      WriteLn('zip: ',Zip);
  55.      WriteLn('amount: ',Amount:5:2);
  56.      WriteLn
  57.     END;
  58.   END;
  59.  END;
  60. UNTIL (LockSuccess=0) OR (Ch='N')
  61. END;
  62.  
  63. BEGIN
  64.  ClrScr;
  65.  Val(ParamStr(1),FileMode,code);
  66.  Assign(F,'testrec.dat');
  67.  {$I-}
  68.   Reset(F);
  69.  {$I+}
  70.  IOTest:=IOResult;
  71.  IF IOTest=2 THEN
  72.    Rewrite(F)
  73.  ELSE
  74.    IF IOTest <> 0 THEN IOError(IOTest);
  75.  
  76. REPEAT
  77.  BEGIN
  78.   Write('Enter +X to lock or -X to UnLock');
  79.   Write(' or Q to Quit: ');
  80.   ReadLn(Operation);
  81.   Val(Copy(Operation,2,4),RecToLock,code);
  82.   CASE Ord(Operation[1]) OF
  83.    43:IF (RecToLock > 0) AND
  84.          (RecToLock <= FileSize(F)) THEN
  85.          Lock(RecToLock);
  86.    45:UnLock(RecToLock);
  87.   END;
  88.  END
  89. UNTIL UpCase(Operation[1])='Q';
  90. Close(F)
  91. END.
  92.