POINT Software Programming/PPROG1.ISO/pascal/visionix/vshareu.pas

Pascal/Delphi Source File | 1993-12-28 | 12.2 KB | 549 lines

{
 ══════════════════════════════════════════════════════════════════════════════

 Visionix DOS File-Sharing Functions Unit (VSHARE)
   Version 0.1
 Copyright 1992 Visionix
 ALL RIGHTS RESERVED

 ──────────────────────────────────────────────────────────────────────────────

 Revision history in reverse chronological order:

 Initials  Date      Comment
 ────────  ────────  ──────────────────────────────────────────────────────────

 lpg       03/16/93  Added Source Documentation

 lpg       12/27/92  Created

 ══════════════════════════════════════════════════════════════════════════════

File-Sharing Functions Summary
------------------------------

INT 21h

Func | Sub | Name                               | Use
-----+-----+------------------------------------+--------------------------------------
 44h | 0Bh | Set Sharing Retry Count            | Set number of times DOS retries a file sharing operation
 5Ch | 00h | Lock File                          | Denies access to specified region in file
 5Ch | 01h | Unlock File                        | Allow access to specified region in file
-----+-----+------------------------------------+--------------------------------------



NOTE: Use Function GetExtendedError to Process and Parse Error Message

}

(*-

[TEXT]

<Overview>

This unit implements various file-share and record locking functions.
It has been completely rewritten and will be replaced in the next
BETA release.

JRT: I dont really even know where these functions came from...

<Interface>

-*)

Unit VShareU;

Interface

Uses

  DOS,
  vcrtu;


Const

  fmReadOnly   =   0;    {FileMode constants}
  fmWriteOnly  =   1;
  fmReadWrite  =   2;
  fmDenyAll    =  16;
  fmDenyWrite  =  32;
  fmDenyRead   =  48;
  fmDenyNone   =  64;
  fmNoInherit  = 128;

Const

  Tries           : Word = 150;
  TryDelay        : Word = 100;

Var

  FileError : Word;




  Function SetShareRetryCnt(           RetryCnt  : WORD;
                                       Pause     : WORD      ) : BYTE;

  Function LockFile(               VAR FileHandle;
                                       LockArea  : LONGINT;
                                       LockLen   : LONGINT   ) : BYTE;

  Function UnLockFile(             VAR FileHandle;
                                       LockArea  : LONGINT;
                                       LockLen   : LONGINT   ) : BYTE;


  Function  LongLo(                    InNum     : LongInt   ): Word;

  Function  LongHi(                    InNum     : LongInt   ): Word;

  Function  LockFileAlt(           Var F;
                                       LockStart : LongInt;
                                       LockLength: LongInt   ): Word;

  Function  UnLockFileAlt(         Var F;
                                       LockStart : LongInt;
                                       LockLength: LongInt   ): Word;

  Function  shAssign(              Var F         : File;
                                       FName     : String    ): Boolean;

  Function  shLock(                Var F;
                                       LockStart : LONGINT;
                                       LockLength: LONGINT   ): Word;

  Procedure FlushFile(             Var F                     ); {Dupe file handle, close dupe handle}

  Function  shReset(               Var F         : File;
                                       RecSize   : Word      ): Boolean;

  Function  shRead(                Var F         : File;
                                   Var Rec;
                                       ReadSize  : Word;
                                   Var NumRead   : Word      ): Boolean;

  Function  shWrite(               Var F         : File;
                                   Var Rec;
                                       ReadSize  : Word      ): Boolean;

  Function  shOpenFile(            Var F         : File;
                                       PathName  : String    ): Boolean;

  Function  shMakeFile(            Var F         : File;
                                       PathName  : String    ): Boolean;

  Procedure shCloseFile(           Var F         : File      );

  Function  shSeekFile(            Var F         : File;
                                       FPos      : LongInt   ): Boolean;



Implementation



{──────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function SetShareRetryCnt(   RetryCnt  : WORD;
                             Pause     : WORD         ) : BYTE;

[PARAMETERS]

RetryCnt    Number of Times to Retry before Fail
Pause       Pause Time between Retries

[RETURNS]

Status Code (0=Success)

[DESCRIPTION]

Sets number of times DOS retries a file sharing operation.

Default is 1 Loop, 3 Retries.  Pause depends upon computer clock speed.

[SEE-ALSO]

[EXAMPLE]

-*)

Function SetShareRetryCnt(   RetryCnt  : WORD;
                             Pause     : WORD         ) : BYTE;
Assembler;
ASM

  MOV  CX, Pause
  MOV  DX, RetryCnt

  MOV  AX, $440B
  INT  $21

  JC   @@1                   { If Carry, Status = Error }

  XOR  AL, AL                { Status = No Error }

 @@1:

END;  { SetShareRetryCnt }


{──────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function LockFile(       VAR FileHandle;
                             LockArea  : LONGINT;
                             LockLen   : LONGINT      ) : BYTE;

[PARAMETERS]

FileHandle  VAR File Handle (not typed)
LockArea    Offset of Region to Lock in File
LockLen     Length of Region to Lock in File

[RETURNS]

Status Code (0=Success)

[DESCRIPTION]

Denies access to specified region in file.

NOTE: File Sharing MUST be loaded before using Lock on a Local Computer

[SEE-ALSO]

[EXAMPLE]

-*)

Function LockFile(       VAR FileHandle;
                             LockArea  : LONGINT;
                             LockLen   : LONGINT      ) : BYTE;
Assembler;
ASM

  MOV  BX, word PTR FileHandle

  MOV  CX, word PTR LockArea+2
  MOV  DX, word PTR LockArea

  MOV  SI, word PTR [lockLen+2]
  MOV  DI, word PTR [LockLen]

  MOV  AX, $5C00

  INT  $21

  JC   @@1                   { If Carry, Status = Error }

  XOR  AL,AL                 { Status = No Error }

 @@1:

END;  { LockFile }


{──────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function UnLockFile(     VAR FileHandle;
                             LockArea  : LONGINT;
                             LockLen   : LONGINT      ) : BYTE;

[PARAMETERS]

FileHandle  VAR File Handle (not typed)
LockArea    Offset of Locked Region in File
LockLen     Length of Locked Region in File

[RETURNS]

Status Code (0=Success)

[DESCRIPTION]

Allows access to specified region in file.

NOTE: Region Must be same one locked with LockFile Func.

[SEE-ALSO]

[EXAMPLE]

-*)

Function UnLockFile(     VAR FileHandle;
                             LockArea  : LONGINT;
                             LockLen   : LONGINT      ) : BYTE;
Assembler;
ASM

  MOV  BX, word PTR [FileHandle]

  MOV  CX, word PTR [LockArea+2]
  MOV  DX, word PTR [LockArea  ]

  MOV  SI, word PTR [LockLen+2]
  MOV  DI, word PTR [LockLen  ]

  MOV  AX, $5C00

  INT  $21

  JC   @@1                   { If Carry, Status = Error }

  XOR  AL,AL                 { Status = No Error }

 @@1:

END; { UnLockFile }


Function shAssign(Var F: File; FName: String): Boolean;
Begin
   Assign(F, FName);
   FileError := IoResult;
   shAssign := (FileError = 0);
End;



Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
Var
   Count: Word;
   Code: Word;

Begin
   Count := Tries;
   Code := 5;
   While ((Count > 0) and (Code = 5)) Do
   Begin
      BlockRead(F,Rec,ReadSize,NumRead);
      Code := IoResult;
   End;
   FileError := Code;
   ShRead := (Code = 0);
End;


Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
Var
   Count: Word;
   Code: Word;

Begin
   Count := Tries;
   Code := 5;
   While ((Count > 0) and (Code = 5)) Do
   Begin
      BlockWrite(F,Rec,ReadSize);
      Code := IoResult;
   End;
   FileError := Code;
   shWrite := (Code = 0);
End;


Procedure CleanDir(FileDir: String);
Var
   SR: SearchRec;
   F: File;

Begin
   FindFirst(FileDir + '*.*', ReadOnly + Archive, SR);
   While DosError = 0 Do
   Begin
      If Not shAssign(F, FileDir + SR.Name) Then;
      Erase(F);
      If IoResult <> 0 Then;
      FindNext(SR);
   End;
End;


Function GetCurrentPath: String;
Var
   CName: NameStr;
   Path: DirStr;
   CExt: ExtStr;

Begin
   FSplit(FExpand('*.*'),Path,CName,CExt);
   GetCurrentPath := Path;
End;


Function shLock(Var F; LockStart,LockLength: LongInt): Word;
Var
   Count: Word;
   Code: Word;

Begin
   Count := Tries;
   Code := $21;
   While ((Count > 0) and (Code = $21)) Do
   Begin
      Code := LockFile(F,LockStart,LockLength);
      Dec(Count);
      If Code = $21 Then
         Delay(TryDelay);
   End;
   If Code = 1 Then
   Code := 0;
   shLock := Code;
End;


Function shReset(Var F: File; RecSize: Word): Boolean;
Var
   Count: Word;
   Code: Word;

Begin
   Count := Tries;
   Code := 5;
   While ((Count > 0) and (Code = 5)) Do
   Begin
      Reset(F,RecSize);
      Code := IoResult;
   End;
   FileError := Code;
   ShReset := (Code = 0);
End;


Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
Var
   Regs: Registers;
   Handle: Word Absolute F;

Begin
   Regs.Ah := $45;
   Regs.Bx := Handle;
   MsDos(Regs);
   If  (Regs.Flags and 1) = 0 Then
   Begin
      Regs.Bx := Regs.Ax;
      Regs.Ah := $3e;
      MsDos(Regs);
   End;
End;


Function LockFileAlt(Var F; LockStart: LongInt; LockLength: LongInt): Word;
Var
   Regs: Registers;
   Handle: Word Absolute F;

Begin
   Regs.Ah := $5c;
   Regs.Al := $00;
   Regs.Bx := Handle;
   Regs.Cx := LongHi(LockStart);
   Regs.Dx := LongLo(LockStart);
   Regs.Si := LongHi(LockLength);
   Regs.Di := LongLo(LockLength);
   MsDos(Regs);
   If ((Regs.Flags and 1) = 0) Then
      LockFileAlt := 0                 {00h = success           }
   Else
      LockFileAlt := Regs.Ax           {01h = share not loaded  }
                                    {06h = invalid handle    }
                                    {21h = lock violation    }
                                    {24h = share buffer full }
End;


Function UnLockFileAlt(Var F; LockStart: LongInt; LockLength: LongInt): Word;
Var
   Regs: Registers;
   Handle: Word Absolute F;
   Code: Word;

Begin
   Regs.Ah := $5c;
   Regs.Al := $01;
   Regs.Bx := Handle;
   Regs.Cx := LongHi(LockStart);
   Regs.Dx := LongLo(LockStart);
   Regs.Si := LongHi(LockLength);
   Regs.Di := LongLo(LockLength);
   MsDos(Regs);
   If ((Regs.Flags and 1) = 0) Then
      UnLockFileAlt := 0               {00h = success           }
   Else
   Begin
      Code := Regs.Ax;              {01h = share not loaded  }
      If Code = 1 Then              {06h = invalid handle    }
         Code := 0;                 {21h = lock violation    }
      UnLockFileAlt := Code            {24h = share buffer full }
   End;
End;


Function LongLo(InNum: LongInt): Word;
Begin
   LongLo := InNum and $FFFF;
End;

Function LongHi(InNum: LongInt): Word;
Begin
   LongHi := InNum Shr 16;
End;

Function  shOpenFile(Var F: File; PathName: String): Boolean;
Begin
   Assign(f,pathname);
   FileMode := fmReadWrite + fmDenyNone;
   shOpenFile := shReset(f,1);
End;


Function  shMakeFile(Var F: File; PathName: String): Boolean;
Begin
   Assign(f,pathname);
   ReWrite(f,1);
   shMakeFile := (IOresult = 0);
End;


Procedure shCloseFile(Var F: File);
Begin
   Close(F);
   If (IOresult <> 0) Then;
End;


Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
Begin
   Seek(F,FPos);
   shSeekFile := (IOresult = 0);
End;



{──────────────────────────────────────────────────────────────────────────────}
{──────────────────────────────────────────────────────────────────────────────}
{──────────────────────────────────────────────────────────────────────────────}


BEGIN
END.