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;

{ 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);
const multitask:boolean=false;

implementation

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);
{$I-} reset(f,1); {$I+}
if ioresult<>0 then begin;
                    nassign:=false;
                   {$i-} rewrite(f,1); {$i+}
                    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
{$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
{$i-} blockwrite(f,g,z); {$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 nread  (Var f:file;var G;z:longint);
var b:longint;
begin
fillchar(g,sizeof(g),#0);
{$i-} if filesize(f)=0 then {$i+} exit;
if ioresult<>0 then writeln('!File Error ',ioresult);
{$i-} blockread(f,g,z); {$i+}
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 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.
