Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/FILEOBJ.PAS

Pascal/Delphi Source File | 1994-04-10 | 9.9 KB | 368 lines

{$I-}
{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}
{---------------------------------------------------------------------------|

Description:

   This unit has everything to handle Lowlevel access to typed files. It's
   main purpose is to provide filesharing and easy buffered access for
   record and untyped files. Recordlocking procedure are also included.

   Note that the ReadOnly constate redefines the ReadOnly Filemode constate
   of the standard DOS unit!

|--------------------------------------------------------------------------}

Unit FileObj;
Interface
Uses Dos;

{---------------------------------------------------------------------------|
  The filesharing constates. For RA you should open ALL the system files
  with the ShareDenyNone bits set.
|--------------------------------------------------------------------------}

Const ReadOnly           = $00;
      WriteOnly          = $01;
      ReadWrite          = $02;

      ShareCompatible    = $00;
      ShareDenyReadWrite = $10;
      ShareDenyWrite     = $20;
      ShareDenyRead      = $30;
      ShareDenyNone      = $40;

      Inheritance        = $80;

{---------------------------------------------------------------------------|
  UseRecLocking  This boolean determines if Locking is applied when you
                 call the Lock and UnLock procedures. It's an easy way
                 to turn recordlocking on/off

  MaxOpenRetries is the number of retries the OPEN procedure uses when it's
                 trying to open a file. After MaxOpenRetries it aborts
                 with an errorlevel set.

|--------------------------------------------------------------------------}

      UseRecLocking      : Boolean = False;
      MaxOpenRetries     : Byte    = 3;      { the number of tries to open a }
                                             { file.                         }


{---------------------------------------------------------------------------|
  The FileObject.

  See the documentation for a description of all the fields and methodes.
|--------------------------------------------------------------------------}



Type FileObject = Object
                    F      : File;      { File handle   }
                    Error  : Integer;   { Last IOerror  }
                    Size   : Word;      { Record Size   }
                    Mode   : Byte;      { Curr FileMode }
                    IsOpen : Boolean;   { File open ?   }

                    { Open the file with the name NAME  }
                    { The recordsize RECSIZE and the    }
                    { filemode USEMODE                  }

                    Procedure Open( Name    : ComStr;
                                    RecSize : Word;
                                    UseMode : Byte);

                    { Create a new file                }

                    Procedure Create(Name : ComStr);

                    { Reset the filemode to USEMODE     }

                    Procedure ResetMode(UseMode : Byte);

                    { Read the next record              }

                    Procedure Read(Var Rec);
                    Procedure ReadBuffer(Var Rec;Var Amount : Word);

                    { Append a record to the file       }

                    Procedure Append(Var Rec);

                    { Replace a record in the file      }

                    Procedure Replace(Var Rec;RecNo : LongInt);
                    Procedure WriteBuffer(Var Rec; Amount : Word);

                    { Jump to a record in the file      }

                    Procedure GotoRecord(RecNo : LongInt);

                    { Close the file                    }

                    Procedure Close;

                    { Lock or unlock record RECNO       }

                    Procedure Lock(RecNo : LongInt);
                    Procedure UnLock(RecNo : LongInt);

                    Function EOF:Boolean;      { True if EOF             }
                    Function RecordNr:LongInt; { The CURRENT Rec. Nr     }
                    Function IoError:Integer;  { The last ERROR          }
                    Function NoRecords:LongInt;{ Total records in file   }

                    Procedure Erase;           { Erase the file          }
                                               { Rename the file to NAME }
                    Procedure Rename(Name : ComStr);
                    Procedure Skip(B : LongInt);
                  End; { Object }

Function DetectShare:Boolean;

Implementation

{---------------------------------------------------------------------------|
  CompletePath  Complete's the path to a full featured dos path. Including
                the Drive, the full path and a trailing backslash.
|--------------------------------------------------------------------------}

Procedure CompletePath(Var Path : ComStr);
Begin
Path:=FExpand(Path);
If (Path[Length(Path)]<>'\') And
   (Path[Length(Path)]<>':')
   Then Path:=Path+'\';
End;

{---------------------------------------------------------------------------|
  The FileObject methodes
|--------------------------------------------------------------------------}

Procedure FileObject.Open( Name     : ComStr;
                           RecSize  : Word;
                           UseMode  : Byte);
Var Tries : Byte;
Begin
Mode:=UseMode;
FileMode:=Mode;
Size:=RecSize;
Tries:=0;
Repeat
  Inc(Tries);
  Error:=0;
  Assign(F,Name);
  Reset(F,RecSize);
  Error:=IoResult;
Until (Tries>MaxOpenRetries) Or (Error=0);
IsOpen:=Error=0;
End;

Procedure FileObject.Create(Name : ComStr);
Begin
FileMode:=WriteOnly+ShareDenyReadWrite;
Assign(F,Name);
Rewrite(F);
System.Close(F);
Error:=IoResult;
End;

Procedure FileObject.Close;
Begin
If IsOpen
   Then Begin
        System.Close(F);
        Error:=IoResult;
        IsOpen:=False;
        End;
End;

Procedure FileObject.ResetMode(UseMode : Byte);
Var OldPtr : LongInt;
    Tries  : Byte;
Begin
OldPtr:=0;
If IsOpen
   Then Begin
        OldPtr:=FilePos(F);
        Close;
        IsOpen:=False;
        End;

Mode:=UseMode;
FileMode:=Mode;
Tries:=0;
Repeat
 Inc(Tries);
 Error:=0;
 Reset(F,Size);
 Error:=IoResult;
Until (Tries>MaxOpenRetries) Or (Error=0);
Seek(F,OldPtr);
Error:=IoResult;
End;

Procedure FileObject.Read(Var Rec);
Begin
BlockRead(F,Rec,1);
Error:=IoResult;
End;

Procedure FileObject.ReadBuffer(Var Rec;Var Amount : Word);
Begin
BlockRead(F,Rec,Amount,Amount);
Error:=IoResult;
End;

Procedure FileObject.WriteBuffer(Var Rec;Amount : Word);
Begin
BlockWrite(F,Rec,Amount,Amount);
Error:=IoResult;
End;

Procedure FileObject.Append(Var Rec);
Begin
Seek(F,FileSize(F));
BlockWrite(F,Rec,1);
Error:=IoResult;
End;

Procedure FileObject.Replace(Var Rec;RecNo : LongInt);
Begin
Seek(F,RecNo);
BlockWrite(F,Rec,1);
Error:=IoResult;
End;

Procedure FileObject.GotoRecord(RecNo : LongInt);
Begin
Seek(F,RecNo);
Error:=IoResult;
End;

Function FileObject.RecordNr:LongInt;
Begin
RecordNr:=FilePos(F);
End;

Function FileObject.EOF:Boolean;
Begin
EOF:=System.Eof(F);
End;

Function FileObject.IoError:Integer;
Begin
IoError:=Error;
Error:=0;
End;

Function FileObject.NoRecords:LongInt;
Begin
NoRecords:=FileSize(F);
End;

Procedure FileObject.Skip(B : LongInt);
Begin
Seek(F,FilePos(F)+B);
End;

Procedure FileObject.Lock(RecNo : LongInt);
Var Regs : Registers;
    Start: LongInt;
Begin
If Not UseRecLocking
   Then Exit;
Dec(RecNo);
Start:=RecNo*FileRec(F).RecSize;
With Regs Do
 Begin
 AH:=$5C;
 AL:=$00;
 BX:=FileRec(F).Handle;
 CX:=(Start And $FFFF0000) Shr 16;
 DX:=(Start And $0000FFFF);
 SI:=0;
 DI:=FileRec(F).RecSize;
 End;
MSDos(Regs);
If (Regs.Flags And FCarry)=FCarry
   Then Error:=Regs.AX+200;
End;

Procedure FileObject.UnLock(RecNo : LongInt);
Var Regs : Registers;
    Start: LongInt;
Begin
If Not UseRecLocking
   Then Exit;
Dec(RecNo);
Start:=RecNo*FileRec(F).RecSize;
With Regs Do
 Begin
 AH:=$5C;
 AL:=$01;
 BX:=FileRec(F).Handle;
 CX:=(Start And $FFFF0000) Shr 16;
 DX:=(Start And $0000FFFF);
 SI:=0;
 DI:=FileRec(F).RecSize;
 End;
MSDos(Regs);
If (Regs.Flags And FCarry)=FCarry
   Then Error:=Regs.AX+200;
End;

Function DetectShare:Boolean;
Var Regs  : Registers;
Begin
With Regs Do
 Begin
 AH:=$5C;
 AL:=$01;
 MSDOS(Regs);
 End;
DetectShare:= ((Regs.Flags And FCarry)=FCarry) And
              (Regs.AX<>$01);
End;

Procedure FileObject.Erase;
Begin
If IsOpen
   Then Begin
        IsOpen:=False;
        System.Close(F);
        End;
System.Erase(F);
Error:=IoResult;
End;

Procedure FileObject.Rename(Name : ComStr);
Begin
If IsOpen
   Then Begin
        IsOpen:=False;
        System.Close(F);
        End;
System.Rename(F,Name);
FileMode:=Mode;
System.Reset(F,Size);
Error:=IoResult;
End;

End.