telegard/archive3.pas

{$A+,B+,E+,F+,I+,L-,N-,O+,R-,S+,V-}
unit archive3;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  archive1,
  common,
  execbat,
  file0, file11;

procedure rezipstuff;

implementation

var rezipcmd:string;

procedure cvtfiles(b:integer; fn:astr; var c_files,c_oldsiz,c_newsiz:longint;
                   var abort,next:boolean);
var fi:file of byte;
    f:ulfrec;
    s,ps,ns,es:astr;
    oldsiz,newsiz:longint;
    oldboard,pl,rn,atype:integer;
    ok:boolean;
begin
  oldboard:=fileboard;
  if (fileboard<>b) then changefileboard(b);
  if (fileboard=b) then begin
    recno(fn,pl,rn); { loads in memuboard }
    abort:=FALSE; next:=FALSE;
    while (fn<>'') and (rn<>0) and (not abort) and (not hangup) do begin
      seek(ulff,rn); read(ulff,f);
      fn:=memuboard.dlpath+f.filename;
      atype:=arctype(fn);
      if (atype<>0) then begin
        pbn(abort,next); nl;
        star('Converting "'+sqoutsp(fn)+'"');
        ok:=FALSE;
        if (not exist(fn)) then
          star('File "'+sqoutsp(fn)+'" doesn''t exist.')
        else begin
          if (rezipcmd<>'') then begin
            assign(fi,sqoutsp(fn));
            {$I-} reset(fi); {$I+}
            if (ioresult=0) then begin
              oldsiz:=trunc(filesize(fi));
              close(fi);
            end;
            shel1;
            {rcg11242000 DOSism}
            {
	    execbatch(ok,TRUE,'tgtemp1.bat','tgtest1.$$$',systat.temppath+'1\',
                      rezipcmd+' '+sqoutsp(fn),-1);
            }
            execbatch(ok,TRUE,'tgtemp1.bat','tgtest1.$$$',systat.temppath+'1/',
                      rezipcmd+' '+sqoutsp(fn),-1);
            shel2;
            assign(fi,sqoutsp(fn));
            {$I-} reset(fi); {$I+}
            if (ioresult=0) then begin
              newsiz:=trunc(filesize(fi));
              f.blocks:=trunc((filesize(fi)+127.0)/128.0);
              close(fi);
              seek(ulff,rn); write(ulff,f);
            end;
          end else begin
            ok:=TRUE;
            s:=fn;
            {rcg11242000 DOSism}
            {conva(ok,atype,atype,systat.temppath+'1\',sqoutsp(fn),sqoutsp(s));}
            conva(ok,atype,atype,systat.temppath+'1/',sqoutsp(fn),sqoutsp(s));
            if (ok) then begin
              fsplit(fn,ps,ns,es); fn:=ps+ns+'.#$%';
              assign(fi,sqoutsp(fn));
              {$I-} reset(fi); {$I+}
              ok:=(ioresult=0);
              if (ok) then begin
                oldsiz:=trunc(filesize(fi));
                close(fi);
              end else
                star('Unable to access "'+sqoutsp(fn)+'"');
              if (ok) then
                if (not exist(sqoutsp(s))) then begin
                  star('Unable to access "'+sqoutsp(s)+'"');
                  sysoplog('Unable to access "'+sqoutsp(s)+'"');
                  ok:=FALSE;
                end;
            end;
            if (ok) then begin
              f.filename:=align(stripname(sqoutsp(s)));
              seek(ulff,rn); write(ulff,f);

              fsplit(fn,ps,ns,es); fn:=ps+ns+'.#$%';
              assign(fi,fn); {$I-} erase(fi); {$I+}

              if (ioresult<>0) then begin
                star('Unable to erase "'+sqoutsp(fn)+'"');
                sysoplog('Unable to erase "'+sqoutsp(fn)+'"');
              end;

              assign(fi,sqoutsp(s));
              {$I-} reset(fi); {$I+}
              ok:=(ioresult=0);
              if (not ok) then begin
                star('Unable to access "'+sqoutsp(s)+'"');
                sysoplog('Unable to access "'+sqoutsp(s)+'"');
              end else begin
                newsiz:=trunc(filesize(fi));
                f.blocks:=trunc((filesize(fi)+127.0)/128.0);
                close(fi);
                seek(ulff,rn); write(ulff,f);
                arccomment(ok,atype,memuboard.cmttype,sqoutsp(s));
              end;
            end else begin
              sysoplog('Unable to convert "'+sqoutsp(fn)+'"');
              star('Unable to convert "'+sqoutsp(fn)+'"');
            end;
          end;
          if (ok) then begin
            inc(c_oldsiz,oldsiz);
            inc(c_newsiz,newsiz);
            inc(c_files);
            star('Old total space took up  : '+cstrl(oldsiz)+' bytes');
            star('New total space taken up : '+cstrl(newsiz)+' bytes');
            if (oldsiz-newsiz>0) then
              star('Space saved              : '+cstrl(oldsiz-newsiz)+' bytes')
            else
              star('Space wasted             : '+cstrl(newsiz-oldsiz)+' bytes');
          end;
        end;
      end;
      nrecno(fn,pl,rn);
      wkey(abort,next);
    end;
    close(ulff);
  end;
  fileboard:=oldboard;
end;

procedure rezipstuff;
var fn:astr;
    c_files,c_oldsiz,c_newsiz:longint;
    i:integer;
    abort,next,ok1:boolean;
begin
  nl;
  print('Re-compress archives -');
  nl;
  print('Filespec:');
  prt(':'); mpl(78); input(fn,78);
  c_files:=0; c_oldsiz:=0; c_newsiz:=0;
  if (fn<>'') then begin
    nl;
    sprint(#3#7+'Do you wish to use a REZIP external utility?');
    if pynq('(such as REZIP.EXE) ? (Y/N) : ') then begin
      nl;
      prt('Enter commandline (example: "REZIP") : ');
      input(rezipcmd,100);
      if (rezipcmd='') then exit;
    end else
      rezipcmd:='';
    nl;
    abort:=FALSE; next:=FALSE;
    ok1:=pynq('Search all directories? ');
    nl;
    sysoplog('Conversion process began at '+date+' '+time+'.');
    print('Conversion process began at '+date+' '+time+'.');
    nl;
    if (ok1) then begin
      i:=0; abort:=FALSE; next:=FALSE;
      while ((not abort) and (i<=maxulb) and (not hangup)) do begin
        if (fbaseac(i)) then
          cvtfiles(i,fn,c_files,c_oldsiz,c_newsiz,abort,next);
        inc(i);
        wkey(abort,next);
        if (next) then abort:=FALSE;
      end;
    end else
      cvtfiles(fileboard,fn,c_files,c_oldsiz,c_newsiz,abort,next);
  end;
  nl;
  sysoplog('Conversion process ended at '+date+' '+time+'.');
  print('Conversion process ended at '+date+' '+time+'.');
  nl;
  nl;
  star('Total archives converted : '+cstr(c_files));
  star('Old total space took up  : '+cstrl(c_oldsiz)+' bytes');
  star('New total space taken up : '+cstrl(c_newsiz)+' bytes');
  if (c_oldsiz-c_newsiz>0) then
    star('Space saved              : '+cstrl(c_oldsiz-c_newsiz)+' bytes')
  else
    star('Space wasted             : '+cstrl(c_newsiz-c_oldsiz)+' bytes');
  sysoplog('Converted '+cstr(c_files)+' archives; old size='+
           cstrl(c_oldsiz)+' bytes, new size='+cstrl(c_newsiz)+' bytes');
end;

end.