home *** CD-ROM | disk | FTP | other *** search
/ Mega CD-ROM 1 / megacd_rom_1.zip / megacd_rom_1 / MAGAZINE / INSIDE_T / ITPJAN90.ZIP / RECLOCK.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-15  |  1KB  |  57 lines
  1. UNIT RecLock;
  2. INTERFACE
  3. USES Crt,Dos;
  4. FUNCTION RecordLock(Operation:Integer;
  5.                     FPointer:Pointer;
  6.                     LockRec:LongInt): Integer;
  7. PROCEDURE LockError(Error:Integer;
  8.                     LockRec:LongInt);
  9.  
  10. IMPLEMENTATION
  11.  
  12. FUNCTION RecordLock(Operation:Integer;
  13.                     FPointer:Pointer;
  14.                     LockRec:LongInt): Integer;
  15.  
  16. {Returns 0 if lock/unlock was successful,
  17.          error number if unsuccessful}
  18.  
  19. VAR LockRegs:Registers;
  20.     StartByte,TotalBytes:LongInt;
  21.  
  22. BEGIN
  23.  TotalBytes:=FileRec(FPointer^).RecSize;
  24.  StartByte:=((LockRec-1)*TotalBytes);
  25.  WITH LockRegs DO
  26.   BEGIN
  27.    AH:=$5C;
  28.    AL:=Operation;
  29.    BX:=FileRec(FPointer^).Handle;
  30.    DX:=StartByte;
  31.    CX:=StartByte SHR 16;
  32.    DI:=TotalBytes;
  33.    SI:=TotalBytes SHR 16;
  34.   END;
  35.  MsDos(LockRegs);
  36.  RecordLock:=0;
  37.  IF (LockRegs.Flags AND 1 = 1) THEN
  38.    RecordLock:=LockRegs.AX;
  39. END;
  40.  
  41. PROCEDURE LockError(Error:Integer;
  42.                     LockRec:LongInt);
  43. BEGIN
  44.  IF Error=0 THEN
  45.   WriteLn('Lock/Unlock successful')
  46.  ELSE
  47.   BEGIN
  48.   Write('Error Locking Record ',LockRec:4,' - ');
  49.    CASE Error OF
  50.     1: WriteLn('Invalid function code');
  51.     6: WriteLn('Invalid Handle');
  52.    33: WriteLn('Record already locked/unlocked');
  53.    END;
  54.   END;
  55. END;
  56. END.
  57.