unit GS_FileH;

{
                                   Changes

      5 Jan 91 -  Corrected GS_FileWrite error is processing memo files
                  greater than 64K.  Changed variable MovLth from type
                  word to type longint.

}

interface
uses
   Dos,
   GS_Strng,
   GS_Error;

var
   BRCmd,
   BWCmd,
   IOAsk,
   IORed,
   IOWri,
   IOPhy  : word;

Procedure GS_FileAssign(var dF : file; Fname : string; BufSize : longint);
Procedure GS_FileClose(var dF : file);
Procedure GS_FileErase(var dF : file);
Function  GS_FileExists(var dF : file; Fname : string) : boolean;
Procedure GS_FileRead(var dF : file; blk : longint; var dat; len : longint;
                       var RtnRslt : word);
Procedure GS_FileRename(var dF : file; FName : string);
Procedure GS_FileReset(var dF : file; len : longint);
Procedure GS_FileRewrite(var dF : file; len : longint);
Function  GS_FileSize(var dF : file) : longint;
Procedure GS_FileTruncate(var dF : file; loc : longint);
Procedure GS_FileWrite(var dF : file; blk : longint; var dat; len : longint;
                       var RtnRslt : word);

implementation

type
   BufferPointer = ^BufferArray;
   BufferArray   = array[0..32767] of char;
   BufrRec = record
                Size   : word;        {Size of buffer}
                CntByt : word;        {Bytes stores in buffer}
                Posn   : longint;     {Beginning byte of file in buffer}
                FPosn  : longint;     {Last byte read + 1 in buffer}
                BufPtr : BufferPointer;
             end;

var
   Bufr  : BufrRec;
   dbfErr : integer;
   Blok,
   TPosS,
   TPosE  : longint;
   StrFil : string[80];
   istrue : boolean;

Function InRam(var dF : file; blk, len : longint; rf : boolean) : boolean;
var
   dFa    : FileRec absolute dF;
   RorW   : string[4];
begin
   istrue := false;
   inc(IOAsk);
   if rf then RorW := 'Read' else RorW := 'Writ';
   move(dFa.UserData, Bufr, sizeof(Bufr));
   if blk > -1 then TPosS := dFa.RecSize * blk
      else TPosS := Bufr.FPosn;
   Blok := TPosS div dFa.RecSize;
   Bufr.FPosn := TPosS + dFa.RecSize * len;
   if Bufr.CntByt > 0 then
   begin
      TPosS := TPosS - Bufr.Posn;
      if (TPosS >= 0) and (TPosS < Bufr.CntByt) then
      begin
         TPosE := (TPosS + dFa.RecSize * len) - 1;
         if TPosE <= Bufr.CntByt then istrue := true;
      end;
   end;
   if not istrue then inc(IOPhy);
   if rf then inc(IORed) else inc(IOWri);
   InRam := istrue;
end;

Procedure GS_FileAssign(var dF : file; Fname : string; BufSize : longint);
var
   dFa    : FileRec absolute dF;
begin
   Assign(df, FName);
   Bufr.Posn  := 0;
   Bufr.FPosn := 0;
   Bufr.CntByt := 0;
   Bufr.Size  := BufSize;
   GetMem(Bufr.BufPtr, BufSize);
   move(Bufr, dFa.UserData, sizeof(Bufr));
end;

Procedure GS_FileClose(var dF : file);
var
   dFa    : FileRec absolute dF;
begin
   Close(df);
   move(dFa.UserData, Bufr, sizeof(Bufr));
   FreeMem(Bufr.BufPtr, Bufr.Size);
end;

Procedure GS_FileErase(var dF : file);
begin
   Erase(df);
end;

Function  GS_FileExists(var dF : file; Fname : string) : boolean;
begin
   if (FName <> '') then
   begin
      {$I-}
      Assign(dF, FName);
      Reset(dF);
      Close(dF);
      {$I+}
      GS_FileExists := (IOResult = 0);
   end else GS_FileExists := false;
end;

Procedure GS_FileRead(var dF : file; blk : longint; var dat; len : longint;
                      var RtnRslt : word);
var
   dFa    : FileRec absolute dF;
   Result,
   LthHld : word;

   StrFil : string[80];
begin
   if InRam(dF, blk, len, true) then
   begin
      move(Bufr.BufPtr^[TPosS],dat,dFa.RecSize * len);
      move(Bufr, dFa.UserData, sizeof(Bufr));
      RtnRslt := len;
      exit;
   end;
   dbfErr := 0;
   begin
      (*$I-*) Seek(dF, Blok); (*$I+*)
      dbfErr := IOResult;
   end;
   IF dbfErr = 0 THEN               {If seek ok, read the record}
   BEGIN
      inc(BRCmd);
      LthHld := dFa.RecSize;
      dFa.RecSize := 1;
      (*$I-*)
      BlockRead(dF, Bufr.BufPtr^, Bufr.Size, Result);
      (*$I+*)
      RtnRslt := Result div LthHld;
      if RtnRslt > len then RtnRslt := len;
      dbfErr := IOResult;
      if dbfErr = 0 then
      begin
         move(Bufr.BufPtr^,dat,LthHld * len);
         Bufr.CntByt := Result;
         Bufr.Posn := Blok * LthHld;
         Bufr.FPosn := (Blok * LthHld)+(LthHld * len);
         move(Bufr, dFa.UserData, sizeof(Bufr));
      end;
      dFa.RecSize := LthHld;
   end;
   if dbfErr <> 0 then
   begin
      CnvAscToStr(dFa.Name,StrFil,64);
      ShowError(dbfErr,StrFil);
   end;
end;

Procedure GS_FileRename(var dF : file; Fname : string);
begin
   Rename(df, FName);
end;

Procedure GS_FileReset(var dF : file; len : longint);
var
   dFa    : FileRec absolute dF;
   i      : integer;
   StrFil : string[80];
begin
   (*$I-*) Reset(dF, len); (*$I+*)
   dbfErr := IOResult;
   if dbfErr <> 0 then
   begin
      CnvAscToStr(dFa.Name,StrFil,64);
      ShowError(dbfErr,StrFil);
   end;
end;

Procedure GS_FileRewrite(var dF : file; len : longint);
var
   dFa    : FileRec absolute dF;
   i      : integer;
   StrFil : string[80];
begin
   (*$I-*) Rewrite(dF, len); (*$I+*)
   dbfErr := IOResult;
   if dbfErr <> 0 then
   begin
      CnvAscToStr(dFa.Name,StrFil,64);
      ShowError(dbfErr,StrFil);
   end;
end;

Function GS_FileSize(var dF : file) : longint;
begin
   GS_FileSize := FileSize(df);
end;


Procedure GS_FileTruncate(var dF : file; loc : longint);
var
   dFa    : FileRec absolute dF;
begin
   dbfErr := 0;
   if loc <> -1 then
   begin
      (*$I-*) Seek(dF, loc); (*$I+*)
      dbfErr := IOResult;
   end;
   IF dbfErr <> 0 THEN
   begin
      CnvAscToStr(dFa.Name,StrFil,64);
      ShowError(dbfErr,StrFil);
   end;
   Truncate(df);
end;


Procedure GS_FileWrite(var dF : file; blk : longint; var dat; len : longint;
                       var RtnRslt : word);
var
   dFa    : FileRec absolute dF;
   i      : integer;
   Result : word;
   MovLth : longint;
   StrFil : string[80];
begin
   if InRam(dF, blk, len, false) then
         move(dat,Bufr.BufPtr^[TPosS],dFa.RecSize * len)
      else
      begin
         MovLth := (dFa.RecSize * len) + (dFa.RecSize *  Blok);
         if Bufr.Size >= MovLth then
         begin
            move(dat,Bufr.BufPtr^[dFa.RecSize * Blok],dFa.RecSize * len);
            Bufr.CntByt := MovLth;
            Bufr.Posn := 0;
            Bufr.FPosn := MovLth;
         end;
      end;
      move(Bufr, dFa.UserData, sizeof(Bufr));
   dbfErr := 0;
   begin
      (*$I-*) Seek(dF, Blok); (*$I+*)
      dbfErr := IOResult;
   end;
   IF dbfErr = 0 THEN               {If seek ok, read the record}
   BEGIN
      inc(BWCmd);
      (*$I-*) BlockWrite(dF, dat, len, Result); (*$I+*)
      RtnRslt := Result;
      dbfErr := IOResult;
   end;
   if dbfErr <> 0 then
   begin
      CnvAscToStr(dFa.Name,StrFil,64);
      ShowError(dbfErr,StrFil);
   end;
end;

begin
   IOAsk := 0;
   IOPhy := 0;
   IORed := 0;
   IOWri := 0;
   BRCmd := 0;
   BWCmd := 0;
end.