home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / A / ARC20.ARC / ARCDEL.INC < prev    next >
Text File  |  1989-11-10  |  1KB  |  39 lines
  1. (* ARCDEL.INC  TR 101189 *)
  2.  
  3. (* Dateien aus Archiv entfernen (Rest rueckt auf) *)
  4.  
  5. procedure delarc;
  6. var n,i : byte;
  7. begin
  8.   if pcount=0 then begin
  9.     writeln('You must tell me which files to delete!'); halt; end;
  10.   for n:=1 to pcount do begin
  11.     did[n]:=false;
  12.     i:=pos(':',arg[n]);
  13.     if i>0 then delete(arg[n],1,i);
  14.     end;
  15.   if openarc(true) then begin
  16.     while readhdr(header,oldarc) do begin
  17.       found:=false; n:=1;
  18.       repeat
  19.         if match(pstring(header.name),arg[n]) then begin
  20.           found:=true; did[n]:=true; end;
  21.         n:=succ(n);
  22.       until found or (n>pcount);
  23.       if found then begin
  24.         fskip(oldarc,header.size);
  25.         if note then writeln('Deleting file: ',pstring(header.name));
  26.         end
  27.       else begin
  28.         writehdr(header,newarc);
  29.         filecopy(oldarc,newarc,header.size,false);
  30.         end;
  31.       end;
  32.     header.vers:=0;
  33.     writehdr(header,newarc);
  34.     closearc;
  35.     note_notfound;
  36.     end
  37.   else begin close(newarc.id); erase(newarc.id); writeln(empty); end;
  38.   end;
  39.