home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NETWERK / NETWERK.UNT
Text File  |  1990-02-01  |  3KB  |  91 lines
  1. Unit Network; 
  2.  
  3.  
  4. INTERFACE
  5. function UnLock(var f;RecNr:integer):integer;
  6. function Lock(var f;RecNr,Retries,DelayTime:integer):integer;
  7.  
  8.  
  9. IMPLEMENTATION
  10. uses Dos,Crt;  
  11.  
  12.  
  13. function HiLongint(l:longint):word;
  14. var  l0 : record          { we use an absolute statement to }
  15.      Llow,Lhigh : word;   { get the two separate words. This }
  16.      end absolute l;      { is fast and dirty ! }
  17. begin
  18.   HiLongint:=l0.Lhigh;    { Assign the hi-two bytes }
  19. end;
  20.  
  21. function LoLongint(l:longint):word;
  22. var l0 : record           { we use an absolute statement to }
  23.          Llow,Lhigh:word; { get the two separate words. This }
  24.        end absolute l;    { is fast and and dirty ! }
  25. begin
  26.   LoLongint:=l0.Llow;     { Assign the lo-two bytes }
  27. end;
  28.  
  29. function recordLockUnlock (var f; 
  30.                            RecNr,Retries,DelayTime: integer;
  31.                            LockUnlock:byte):integer;
  32. var
  33.   Fil    : Filerec absolute f;  { record size this file uses }
  34.   Regs   : Registers;           { needed for dos calls }
  35.   Offset : longint;             { offset into file     }
  36.   t      : Integer;             { for loop needs }
  37.   e      : Integer;             { the possible error code }
  38.  
  39. begin
  40.   e:=0;                         { start with error code=0 }
  41.   if retries<1 then retries:=1; { try at least 1 time ! }
  42.   while Retries>0 do            { the number of retries }
  43.   begin
  44.     with Regs do
  45.     begin
  46.       AH:=$5C;                  { lock/unlock part of file }
  47.       AL:=LockUnlock;           { 0=lock area, 1=unlock area}
  48.       BX:=Fil.Handle;           { the file handle of file }
  49.       Offset:=RecNr*Fil.Recsize;{ determine record length }
  50.                                 { and calculate first byte }
  51.       CX:=HiLongint(Offset);    { store hi bytes of first }
  52.       DX:=LoLongint(Offset);    { store lo bytes of first }
  53.       SI:=Hi(Fil.Recsize);      { store hi byte of number }
  54.       DI:=Lo(Fil.Recsize);      { store lo byte of number }
  55.       msdos(Regs);              { (un)lock the record }
  56.       { if there was an error then return error code in AX }
  57.       if (Flags and 1) <> 0 then { see if the locking was ok}
  58.       begin
  59.         AH:=$59;                 { get ext. errorcode dos }
  60.         BX:=0;                   { needed for call }
  61.         msdos(regs);             { make the call }
  62.         e:=ax;                   { return with error code }
  63.         dec(Retries);            
  64.       end                   
  65.       else                       
  66.       begin       
  67.         e:=0;                    { there is no error }
  68.         Retries:=0;              { no more retries, it is ok}
  69.       end;
  70.     end;
  71.     if Retries>0 then delay(DelayTime); { do we have to wait}
  72.   end;                      
  73.   RecordLockUnlock:=e;   { return the error code, if any }
  74. end;
  75.  
  76. function UnLock(var f; RecNr:integer):integer;
  77. begin
  78.   { Unlock needs no delay, and no retries ! }
  79.   Unlock:=RecordLockUnlock(f,RecNr,1,0,1); { 1 = unlock }
  80. end;
  81.  
  82. function Lock(var f; RecNr,Retries,DelayTime:integer):integer;
  83. begin
  84.   Lock:=RecordLockUnlock(f,RecNr,Retries,DelayTime,0); 
  85.   { 0 = lock }
  86. end;
  87.  
  88. begin
  89.  { No init needed }
  90. end.
  91.