home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / a / arc20.arc / ARCADD.INC < prev    next >
Encoding:
Text File  |  1989-11-11  |  3.6 KB  |  116 lines
  1. (* ARCADD.INC  TR 101189 *)
  2.  
  3. (* Angegebene Dateien in Archiv einfuegen (Rest wird verschoben) *)
  4.  
  5. procedure addarc;
  6. type liste     = ^listel;
  7.      listel    = record
  8.                    pfad : str4;
  9.                    name : filenam;
  10.                    next : liste;
  11.                    end;
  12. var  path      : str4;
  13.      namlist   : liste;
  14.      n,i       : byte;
  15.      s         : filenam;
  16.      ohdrvalid : boolean;
  17.      nhdr      : headtype;
  18.  
  19.   (* Dateinamen mit Pfad alphabetisch sortiert in Liste einfuegen *)
  20.  
  21.   procedure addname;
  22.   var h1,h2,h3 : liste;
  23.   begin
  24.     h1:=namlist; h3:=nil;
  25.     if (s<>arcname) and (s<>newname) and (s<>bakname) then begin
  26.       while (h1<>nil) and (s>=h1^.name) do begin
  27.         if h1^.name=s then exit;
  28.         h3:=h1; h1:=h1^.next; end;
  29.       new(h2);
  30.       h2^.name:=s; h2^.pfad:=path; h2^.next:=h1;
  31.       if h3=nil then namlist:=h2 else h3^.next:=h2;
  32.       end;
  33.     end;
  34.  
  35.   (* Datei aus Liste an der richtigen Stelle in Archiv einfuegen *)
  36.  
  37.   procedure addfile(var p:str4; var nam:filenam);
  38.   label notime;
  39.   var ch : char;
  40.   begin
  41.     s:=p+nam; fillchar(nhdr.name,13,0);
  42.     move(nam[1],nhdr.name,length(nam));
  43.     nhdr.size:=long_null; nhdr.crc:=0;
  44.     if time then begin
  45.       build_fcb(s);
  46.       bdos(102,addr(dirfcb));              (* read update stamps   *)
  47.       if dirfcb.date=0 then goto notime;   (* use global date/time *)
  48.       dirfcb.s:=0;                         (* no seconds supported *)
  49.       cpm_date(dirfcb.date,datum,uhrzeit);
  50.       nhdr.date:=calc_date(datum);
  51.       nhdr.time:=calc_time(uhrzeit);
  52.       end
  53.     else
  54. notime: begin nhdr.date:=arcdate; nhdr.time:=arctime;
  55.       end;
  56.     while ohdrvalid and (header.name<nhdr.name) do begin
  57.       writehdr(header,newarc);
  58.       filecopy(oldarc,newarc,header.size,false);
  59.       ohdrvalid:=readhdr(header,oldarc);
  60.       end;
  61.     if pstring(header.name)=pstring(nhdr.name) then begin
  62.       if warn then begin
  63.         write('Overwrite existing file : ',pstring(header.name),' (Y/N) ? ');
  64.         repeat read(kbd,ch); ch:=upcase(ch) until (ch='Y') or (ch='N');
  65.         writeln(ch);
  66.         end
  67.       else ch:='Y';
  68.       if ch='N' then begin
  69.         writehdr(header,newarc);
  70.         filecopy(oldarc,newarc,header.size,false);
  71.         ohdrvalid:=readhdr(header,oldarc);
  72.         exit; end;
  73.       fskip(oldarc,header.size);
  74.       ohdrvalid:=readhdr(header,oldarc);
  75.       end;
  76.     write('Adding file : ',s:15,' , ');
  77.     if fopen_read(s,orgfile) then pack(orgfile,newarc,nhdr);
  78.     if cmd='M' then begin close(orgfile.id); erase(orgfile.id); end;
  79.     end;
  80.  
  81.   (* Dateien aus Liste nacheinander in Archiv einfuegen *)
  82.  
  83.   procedure addbunch;
  84.   begin
  85.     if openarc(true) then ohdrvalid:=readhdr(header,oldarc)
  86.     else begin ohdrvalid:=false; header.name[1]:=#0; end;
  87.     while namlist<>nil do begin
  88.       addfile(namlist^.pfad,namlist^.name);
  89.       namlist:=namlist^.next;
  90.       end;
  91.     while ohdrvalid do begin
  92.       writehdr(header,newarc);
  93.       filecopy(oldarc,newarc,header.size,false);
  94.       ohdrvalid:=readhdr(header,oldarc);
  95.       end;
  96.     header.vers:=0;
  97.     writehdr(header,newarc);
  98.     closearc;
  99.     end;
  100.  
  101. begin  { arcadd }
  102.   namlist:=nil;
  103.   if pcount=0 then begin pcount:=1; arg[1]:='*.*'; end;
  104.   for n:=1 to pcount do begin
  105.     path:='';
  106.     i:=pos(':',arg[n]);
  107.     if i<>0 then path:=copy(arg[n],1,i);
  108.     s:=first_dir(arg[n]);
  109.     while s<>'' do begin
  110.       addname; s:=next_dir; end;
  111.     end;
  112.   if namlist=nil then writeln('I have nothing to add!')
  113.   else addbunch;
  114.   (* dispose(namlist) unnoetig wegen Programmende! *)
  115.   end;
  116.