DP Tool Club 31/CDASC_31_1996_juillet_aout.iso/internet/rnr214.zip/RNRFILE.PAS

Pascal/Delphi Source File | 1996-01-21 | 3KB | 181 lines

unit rnrfile;

{

rnrfile.pas - rnr file procedures

}

{ split off from the file:  rnrproc.pas - rnr procedures }

{$I rnr-def.pas}

interface

uses dos,rnrglob,genericf { ,rnrfunc,rnrio,rnrproc,rnrmous } ;

procedure mkhier(hier: string);
procedure copyfile(oldfn,newfn: string);
procedure deletefile(fn: string);
procedure emptyfile(fn: string);
procedure movefile(oldfn,newfn: string);
procedure copyfilethenempty(oldfn,newfn: string);
procedure safereset(var f: text; fn: string);
procedure saferesetsize(var f: file; fn: string; size: integer);
procedure saferewrite(var f: text; fn: string);

implementation

procedure mkhier;

var
  s: string;
  i: integer;
  fileinfo: searchrec;
  dir: string;

begin

{$I-}

{if the directory already exists, don't worry about an error}

{WHY DOESN'T THIS WORK WITH TP6 ?!?!?!}

  s := hier;

  for i := 1 to length(s) do
    if s[i]='/' then
      s[i] := '\';

  if length(s)>0 then
    if s[length(s)]='\' then
      s := copy(s,1,length(s)-1);

  for i := 2 to length(s) do
    if (s[i]='\') and (s[i-1]<>':') then
      begin
        dir := copy(s,1,i-1);
        findfirst(dir,directory,fileinfo);
        if doserror<>0 then
          mkdir(dir);
      end;

  findfirst(s,directory,fileinfo);
  if doserror<>0 then
    mkdir(s);

{$I+}

end;

procedure copyfile;

const
  bufsize=1024;

var
  infile, outfile: file;
  done: boolean;
  numread: word;
  buffer: array[1..bufsize] of char;

begin
  assign(outfile,newfn);
  rewrite(outfile,1);

  assign(infile,oldfn);
  reset(infile,1);

  done := false;
  while not done do
    begin
      blockread(infile,buffer,bufsize,numread);
      blockwrite(outfile,buffer,numread);
      done := (numread<bufsize);
    end;

  close(infile);
  close(outfile);
end;

procedure deletefile;

var
  f: file;

begin
  assign(f,fn);
  erase(f);
end;

procedure emptyfile;

var
  f: file;

begin
  assign(f,fn);
  rewrite(f);
  close(f);
end;

procedure movefile;

begin
  copyfile(oldfn,newfn);
  deletefile(oldfn);
end;

procedure copyfilethenempty;

begin
  copyfile(oldfn,newfn);
  emptyfile(oldfn);
end;

procedure safereset;

{no device checking done yet, since no reset routines need it}

begin
  assign(f,fn);
{$I-}
  reset(f);
{$I+}
  fileresult := ioresult;
end;

procedure saferesetsize;

{no device checking done yet, since no reset routines need it}

begin
  assign(f,fn);
{$I-}
  reset(f,size);
{$I+}
  fileresult := ioresult;
end;

procedure saferewrite;

{make sure it's not a device first}

begin
  if isdev(fn) then
    begin
      fileresult := 199;  {use an error code tpascal doesn't}
    end
  else
    begin
      assign(f,fn);
{$I-}
      rewrite(f);
{$I+}
      fileresult := ioresult;
    end;
end;

end.