[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

    {
    Also, please note, this unit has not been completely tested.  It may
    (and most probably does) have bugs in it.  If (and when) any are
    discovered, please contact me, so I can update my routines also.

    **************************
    *     SHARE.PAS v1.0     *
    *                        *
    *  General purpose file  *
    *    sharing routines    *
    **************************

    1992-93 HyperDrive Software
    Released into the public domain.
    }

    {$S-,R-,D-}
    {$IFOPT O+}
      {$F+}
    {$ENDIF}

    unit Share;

    interface

    const
      MaxLockRetries : Byte = 10;

      NormalMode = $02; { ---- 0010 }
      ReadOnly   = $00; { ---- 0000 }
      WriteOnly  = $01; { ---- 0001 }
      ReadWrite  = $02; { ---- 0010 }
      DenyAll    = $10; { 0001 ---- }
      DenyWrite  = $20; { 0010 ---- }
      DenyRead   = $30; { 0011 ---- }
      DenyNone   = $40; { 0100 ---- }
      NoInherit  = $70; { 1000 ---- }

    type
      Taskers = (NoTasker, DesqView, DoubleDOS, Windows, OS2, NetWare);

    var
      MultiTasking : Boolean;
      MultiTasker  : Taskers;
      VideoSeg     : Word;
      VideoOfs     : Word;

    procedure SetFileMode(Mode : Word);
    {- Set filemode for typed/untyped files }
    procedure ResetFileMode;
    {- Reset filemode to ReadWrite (02h) }
    procedure LockFile(var F);
    {- Lock file F }
    procedure UnLockFile(var F);
    {- Unlock file F }
    procedure LockBytes(var F;  Start, Bytes : LongInt);
    {- Lock Bytes bytes of file F, starting with Start }
    procedure UnLockBytes(var F;  Start, Bytes : LongInt);
    {- Unlock Bytes bytes of file F, starting with Start }
    procedure LockRecords(var F;  Start, Records : LongInt);
    {- Lock Records records of file F, starting with Start }
    procedure UnLockRecords(var F;  Start, Records : LongInt);
    {- Unlock Records records of file F, starting with Start }
    function  TimeOut : Boolean;
    {- Check for LockRetry timeout }
    procedure TimeOutReset;
    {- Reset internal LockRetry counter }
    function  InDos: Boolean;
    {- Is DOS busy? }
    procedure GiveTimeSlice;
    {- Give up remaining CPU time slice }
    procedure BeginCrit;
    {- Enter critical region }
    procedure EndCrit;
    {- End critical region }

    implementation

    uses
      Dos;

    var
      InDosFlag : ^Word;
      LockRetry : Byte;

    procedure FLock(Handle : Word; Pos, Len : LongInt);
    Inline(
      $B8/$00/$5C/    {  mov   AX,$5C00        ;DOS FLOCK, Lock subfunction}
      $8B/$5E/$04/    {  mov   BX,[BP + 04]    ;Place file handle in Bx register}
      $C4/$56/$06/    {  les   DX,[BP + 06]    ;Load position in ES:DX}
      $8C/$C1/        {  mov   CX,ES           ;Move ES pointer to CX register}
      $C4/$7E/$08/    {  les   DI,[BP + 08]    ;Load length in ES:DI}
      $8C/$C6/        {  mov   SI,ES           ;Move ES pointer to SI register}
      $CD/$21);       {  int   $21             ;Call DOS}

    procedure FUnlock(Handle : Word; Pos, Len : LongInt);
    Inline(
      $B8/$01/$5C/    {  mov   AX,$5C01        ;DOS FLOCK, Unlock subfunction}
      $8B/$5E/$04/    {  mov   BX,[BP + 04]    ;Place file handle in Bx register}
      $C4/$56/$06/    {  les   DX,[BP + 06]    ;Load position in ES:DX}
      $8C/$C1/        {  mov   CX,ES           ;Move ES pointer to CX register}
      $C4/$7E/$08/    {  les   DI,[BP + 08]    ;Load length in ES:DI}
      $8C/$C6/        {  mov   SI,ES           ;Move ES pointer to SI register}
      $CD/$21);       {  int   $21             ;Call DOS}

    procedure SetFileMode(Mode : Word);
    begin
      FileMode := Mode;
    end;

    procedure ResetFileMode;
    begin
      FileMode := NormalMode;
    end;

    procedure LockFile(var F);
    begin
      If not MultiTasking then
        Exit;

      While InDos do
        GiveTimeSlice;

      FLock(FileRec(F).Handle, 0, FileSize(File(F)));
    end;

    procedure UnLockFile(var F);
    begin
      If not MultiTasking then
        Exit;

      While InDos do
        GiveTimeSlice;

      FLock(FileRec(F).Handle, 0, FileSize(File(F)));
    end;

    procedure LockBytes(var F;  Start, Bytes : LongInt);
    begin
      If not MultiTasking then
        Exit;

      While InDos do
        GiveTimeSlice;

      FLock(FileRec(F).Handle, Start, Bytes);
    end;

    procedure UnLockBytes(var F;  Start, Bytes : LongInt);
    begin
      If not MultiTasking then
        Exit;

      While InDos do
        GiveTimeSlice;

      FLock(FileRec(F).Handle, Start, Bytes);
    end;

    procedure LockRecords(var F;  Start, Records : LongInt);
    begin
      If not MultiTasking then
        Exit;

      While InDos do
        GiveTimeSlice;

      FLock(FileRec(F).Handle, Start * FileRec(F).RecSize, Records * FileRec(F).RecSize);
    end;

    procedure UnLockRecords(var F;  Start, Records : LongInt);
    begin
      If not MultiTasking then
        Exit;

      While InDos do
        GiveTimeSlice;

      FLock(FileRec(F).Handle, Start * FileRec(F).RecSize, Records * FileRec(F).RecSize);
    end;

    function TimeOut : Boolean;
    begin
      GiveTimeSlice;
      TimeOut := True;

      If MultiTasking and (LockRetry < MaxLockRetries) then
      begin
        TimeOut := False;
        Inc(LockRetry);
      end;
    end;

    procedure TimeOutReset;
    begin
      LockRetry := 0;
    end;

    function InDos : Boolean;
    begin
      InDos := InDosFlag^ > 0;
    end;

    procedure GiveTimeSlice;  ASSEMBLER;
    asm
      cmp   MultiTasker, DesqView
      je    @DVwait
      cmp   MultiTasker, DoubleDOS
      je    @DoubleDOSwait
      cmp   MultiTasker, Windows
      je    @WinOS2wait
      cmp   MultiTasker, OS2
      je    @WinOS2wait
      cmp   MultiTasker, NetWare
      je    @Netwarewait
     @Doswait:
      int   $28
      jmp   @WaitDone
     @DVwait:
      mov   AX,$1000
      int   $15
      jmp   @WaitDone
     @DoubleDOSwait:
      mov   AX,$EE01
      int   $21
      jmp   @WaitDone
     @WinOS2wait:
      mov   AX,$1680
      int   $2F
      jmp   @WaitDone
     @Netwarewait:
      mov   BX,$000A
      int   $7A
      jmp   @WaitDone
     @WaitDone:
    end;

    procedure BeginCrit;  ASSEMBLER;
    asm
      cmp   MultiTasker, DesqView
      je    @DVCrit
      cmp   MultiTasker, DoubleDOS
      je    @DoubleDOSCrit
      cmp   MultiTasker, Windows
      je    @WinCrit
      jmp   @EndCrit
     @DVCrit:
      mov   AX,$101B
      int   $15
      jmp   @EndCrit
     @DoubleDOSCrit:
      mov   AX,$EA00
      int   $21
      jmp   @EndCrit
     @WinCrit:
      mov   AX,$1681
      int   $2F
      jmp   @EndCrit
     @EndCrit:
    end;

    procedure EndCrit;  ASSEMBLER;
    asm
      cmp   MultiTasker, DesqView
      je    @DVCrit
      cmp   MultiTasker, DoubleDOS
      je    @DoubleDOSCrit
      cmp   MultiTasker, Windows
      je    @WinCrit
      jmp   @EndCrit
     @DVCrit:
      mov   AX,$101C
      int   $15
      jmp   @EndCrit
     @DoubleDOSCrit:
      mov   AX,$EB00
      int   $21
      jmp   @EndCrit
     @WinCrit:
      mov   AX,$1682
      int   $2F
      jmp   @EndCrit
     @EndCrit:
    end;

    begin
      {- Init }
      LockRetry:= 0;

      asm
       @CheckDV:
        mov   AX, $2B01
        mov   CX, $4445
        mov   DX, $5351
        int   $21
        cmp   AL, $FF
        je    @CheckDoubleDOS
        mov   MultiTasker, DesqView
        jmp   @CheckDone
       @CheckDoubleDOS:
        mov   AX, $E400
        int   $21
        cmp   AL, $00
        je    @CheckWindows
        mov   MultiTasker, DoubleDOS
        jmp   @CheckDone
       @CheckWindows:
        mov   AX, $1600
        int   $2F
        cmp   AL, $00
        je    @CheckOS2
        cmp   AL, $80
        je    @CheckOS2
        mov   MultiTasker, Windows
        jmp   @CheckDone
       @CheckOS2:
        mov   AX, $3001
        int   $21
        cmp   AL, $0A
        je    @InOS2
        cmp   AL, $14
        jne   @CheckNetware
       @InOS2:
        mov   MultiTasker, OS2
        jmp   @CheckDone
       @CheckNetware:
        mov   AX,$7A00
        int   $2F
        cmp   AL,$FF
        jne   @NoTasker
        mov   MultiTasker, NetWare
        jmp   @CheckDone
       @NoTasker:
        mov   MultiTasker, NoTasker
       @CheckDone:
        {-Set MultiTasking }
        cmp   MultiTasker, NoTasker
        mov   VideoSeg, $B800
        mov   VideoOfs, $0000
        je    @NoMultiTasker
        mov   MultiTasking, $01
        {-Get video address }
        mov   AH, $FE
        les   DI, [$B8000000]
        int   $10
        mov   VideoSeg, ES
        mov   VideoOfs, DI
        jmp   @Done
       @NoMultiTasker:
        mov   MultiTasking, $00
       @Done:
        {-Get InDos flag }
        mov   AH, $34
        int   $21
        mov   WORD PTR InDosFlag, BX
        mov   WORD PTR InDosFlag + 2, ES
      end;
    end.

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]