unit filehandle;
interface

{ Lucid BBS File Handle Routins By Judge Dredd }
{ These will Help out alot because it has all  }
{ the ERROR checking remade so you dont have   }
{ have to add the checking everytime time you  }
{ handle a file.  These will soon have         }
{ MULTI-TASKING support built right in!        }

uses dos,crt;

const multitask:boolean=false;
  {File mode def's}
  fmReadOnly  = $00;
  fmWriteOnly = $01; {Use one of these}
  fmReadWrite = $02;

  fmDenyAll   = $10; {with one of these}
  fmDenyWrite = $20;
  fmDenyRead  = $30;
  fmDenyNone  = $40;

type
  LockAction = (Lock, Unlock);

var Fpos:longint;

{ New Assign, Only does TEXT}
function  tassign (Var f:text;s:string):boolean;
procedure treset  (var f:text);
procedure tread   (Var f:text;var G:string);
procedure treadln (Var f:text;var G:string);
procedure twrite  (var f:text;var G:string);
procedure tclose  (var f:text);
procedure trewrite(var f:text);
{ New Assign, Only does BINARY}
function nassign (var f:file;s:string):boolean;
{ Reset file, will Rewrite if have to }
procedure nreset  (var f:file);
{ Read file info in, Like Blockread but with error checking }
procedure nread   (Var f:file;var G;z:longint);
{ Write file info in, Like Blockread but with error checking }
procedure nwrite  (var f:file;var G;z:longint);
{ Close the File }
procedure nclose(var f:file);
{ Seek file position }
procedure nseek(var f:file;x:longint);
{ truncate a file }
procedure ntruncate(var f:file);
{ Is share installed }
function ShareIn: Boolean;
{ File Locker }
function FLock(var F; Action: LockAction; FPos,Len: Longint): Word;

implementation

function ShareIn: Boolean; assembler;
asm
  mov ax, 1000h  {Test for share}
  int 2fh        {Call multiplex interrupt}
  cmp al, 0ffh   {ShareIn = AL=$FF}
  xor al, al     {Default is false}
  jne @@Done     {False}
  mov al, 01h    {True}
@@Done:
  mov ax, 01h
end;

function FLock(var F; Action: LockAction; FPos,Len: Longint): Word;
  assembler;
asm
  je @@End
  mov al, Action  {0=Lock,1=Unlock}
  mov ah, $5C     {Dos lock function}
  les si, F       {Load F}
  mov bx, es:[si] {Get file handle}
  les dx, Fpos
  mov cx, es      {CX:DI=Begin position}
  les di, len
  mov si, es      {SI:DI length lock area}
  int 21h         {MS-DOS}
  jc @@End        {If error, return AX}
  xor ax, ax      {Else, return 0}
@@End:
end;

procedure trewrite(var f:text);
begin
{$i-} rewrite(f); {$i+}
if ioresult<>0 then writeln('^File Error ',ioresult);
end;

function nassign(var f:file;s:string):boolean;
begin
nassign:=true;
assign(f,s);
FileMode := $02;
{$I-} reset(f,1); {$I+}
FileMode := fmDenyNone + fmReadWrite;
if ioresult<>0 then begin;
                    FileMode := $02;
                    nassign:=false;
                   {$i-} rewrite(f,1); {$i+}
                    FileMode := fmDenyNone + fmReadWrite;
                    Reset(F,1);
                    end;
end;

function tassign(var f:text;s:string):boolean;
begin
tassign:=true;
assign(f,s);
{$I-} reset(f); {$I+}
if ioresult<>0 then begin;
                    tassign:=false;
                    {$i-} rewrite(f); {$i+}
                    end;
end;

procedure treset  (var f:text);
begin
filemode := fmDenyNone and fmReadWrite;
{$I-} reset(f); {$I+}
if ioresult<>0 then rewrite(f);
end;

procedure nreset  (var f:file);
begin
{$I-} reset(f,1); {$I+}
if ioresult<>0 then rewrite(f,1);
end;

procedure nwrite (var f:file;var G;z:longint);
begin
fpos:=filepos(f);
{Flock(F,Lock,FPos,FPos+SizeOf(g));}
{FileMode := 2;}
FileMode := fmDenyNone + fmReadWrite;
{$i-} blockwrite(f,g,z); {$I+}
FileMode := fmDenyNone + fmReadWrite;
{Flock(F,unLock,FPos,FPos+SizeOf(g));}

if ioresult<>0 then writeln('*File Error ',ioresult);
end;

procedure nread  (Var f:file;var G;z:longint);
var b:longint;
begin
fpos:=filepos(f);
fillchar(g,sizeof(g),#0);
{$i-} if filesize(f)=0 then {$i+} exit;
if ioresult<>0 then writeln('!File Error ',ioresult);
Flock(F,Lock,FPos,FPos+SizeOf(g));
{$i-} blockread(f,g,z); {$i+}
Flock(F,unLock,FPos,FPos+SizeOf(g));
if ioresult<>0 then writeln('+File Error ',ioresult);
end;

procedure nclose(var f:file);
begin
{$i-} close(f); {$i+}
if ioresult<>0 then writeln('@File Error ',ioresult);
end;

procedure twrite (var f:text;var G:string);
begin
{$i-} write(f,g); {$I+}
if ioresult<>0 then writeln('*File Error ',ioresult);
end;

procedure tread  (Var f:text;var G:string);
var b:longint;
begin
fillchar(g,sizeof(g),#0);
{$i-} read(f,g); {$i+}
if ioresult<>0 then writeln('+File Error ',ioresult);
end;

procedure treadln(Var f:text;var G:string);
var b:longint;
begin
fillchar(g,sizeof(g),#0);
{$i-} readln(f,g); {$i+}
if ioresult<>0 then writeln('+File Error ',ioresult);
end;

procedure tclose(var f:text);
begin
{$i-} close(f); {$i+}
if ioresult<>0 then writeln('@File Error ',ioresult);
end;

procedure nseek(var f:file;x:longint);
begin
{$i-} if filesize(f)=0 then {$i+} exit;
if ioresult<>0 then writeln('-File Error ',ioresult);
{$i-} seek(f,x); {$i+}
if ioresult<>0 then writeln('$File Error ',ioresult);
end;

procedure ntruncate(var f:file);
begin
{$i-} if filesize(f)=0 then {$i+} exit;
{$i-} truncate(f); {$i+}
if ioresult<>0 then writeln('%File Error ',ioresult);
end;

begin
end.
