home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBBS / ECO_LOCK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-09-13  |  2.1 KB  |  109 lines
  1. {$A-,I-,X+}
  2. unit eco_lock;
  3. interface
  4. uses dos;
  5.  
  6. type
  7.   stream = file;
  8.  
  9. const
  10.   _keep_mode  = -1;        { do not change file mode in fopen }
  11.   _readonly   = $00;       {     share mode dos 3++ and above }
  12.   _denyall    = $10;
  13.   _writeonly  = $01;
  14.   _denywrite  = $20;
  15.   _readwrite  = $02;
  16.   _denyread   = $30;
  17.   _denynone   = $40;
  18.  
  19.   lockregion   = 00;
  20.   unlockregion = 01;
  21.  
  22.  
  23.   function fopen(var fv : stream; fn : pathstr; mode : integer) : integer;
  24.   function fclose(var fv : stream) : integer;
  25.   function shareloaded : boolean;
  26.   function filelock(
  27.     handle :    word;
  28.     action :    byte;
  29.     start,    
  30.     bytes  : longint;
  31.     var ax : integer
  32.   ): boolean;
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39. implementation
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.   function fopen; {open untyped file return the dos error code}
  47.   var fm : byte;
  48.   begin
  49.     assign(fv,fn);
  50.     fm := filemode;
  51.     if mode <> _keep_mode then filemode := mode;
  52.     reset(fv,1);
  53.     fopen := ioresult;
  54.     filemode := fm;
  55.   end;
  56.  
  57.  
  58.  
  59.  
  60.   function  fclose(var fv : stream) : integer;
  61.   begin
  62.     close(fv);
  63.     fclose := ioresult;
  64.   end;
  65.  
  66.  
  67.  
  68.   function shareloaded : boolean;
  69.   var reg : registers;
  70.   begin
  71.     reg.ax := $1000;
  72.     intr($2f,reg);
  73.     shareloaded := ((reg.flags and $01) = 0) and (reg.al = $ff);
  74.   end;
  75.  
  76.  
  77.  
  78. {
  79.  
  80. Lock or Unlock region of file.
  81.  
  82. Input         : Handle  - turbo untype file variable handle (filerec(fv).handle)
  83. input         : action  - action to take. See constants above;
  84. input         : start   - beginging file position to lock.
  85. input         : bytes   - number of bytes to lock.
  86. output        : ax      - ax register return value
  87.  
  88. returns TRUE if lock is successful, False otherwise (check AX)
  89.  
  90. }
  91.  
  92.  
  93.  
  94.   function filelock(handle : word; action : byte; start,bytes : longint; var ax : integer): boolean;
  95.   var reg : registers;
  96.   begin
  97.     reg.ax := $5c00 + action;
  98.     reg.bx := handle;
  99.     reg.cx := hi(start);
  100.     reg.dx := lo(start);
  101.     reg.si := hi(bytes);
  102.     reg.di := lo(bytes);
  103.     intr($21,reg);
  104.     filelock := (reg.flags and $01) = $00;
  105.     ax := reg.ax;
  106.    end;
  107.  
  108. end.
  109.