unit zip;

interface

uses sysutils,
     drlabel,
     gauges,
     abconst,
     abzipper,
     abzbrows,
     abzipprc,
     abunzprc,
     abunzper,
     abarctyp,
     abziptyp,
     abutils,
     drdir;

const copy_chemges_exe: boolean=true;
//{$I Abrccnst.inc}
var Gauges: array [1..2] of tgauge;
    Gaugetitel: array [1..2] of tdrlabel;
procedure komprimiere(var f: ansistring);
procedure entkomprimiere(var f: ansistring);
procedure CreateGaugeFenster(titel: AnsiString; zeilen: Integer);

type tdrzipper = class(tabzipper)
                   public
                     abbrechen: boolean;
                     wechseltext: string[80];
                     xzipfile: string[100];
                     diskette: boolean;
                     _kein_fenster: boolean;
                     fehlermeldung_schreiben: boolean;
                     falschedatei: ansistring;
                   published
                     constructor create(zipfile: shortstring;
                                        vorher_loeschen: boolean;
                                        basisverzeichnis: shortstring;
                                        subdirectories: boolean;
                                        abspeicherung_pfad: boolean;
                                        titel: shortstring;
                                        kein_lowercase: boolean=false;
                                        kein_fenster: boolean=false);
                     destructor destroy; override;
                     procedure add(datei: shortstring);
                     procedure schreiben;
                     procedure oeffne_zip_fenster(zipfile,titel: shortstring);
                     procedure fileprogress(sender: tobject;
                                            item: tabarchiveitem;
                                            progress: byte;
                                            var abort: boolean);
                     procedure programmprogress(sender: tobject;
                                                progress: byte;
                                                var abort: boolean);
                     procedure zipfehler(sender: tobject;
                                         Item: tabarchiveitem;
                                         processtype: tabprocesstype;
                                         errorclass: Taberrorclass;
                                         Errorcode: Integer);
                     procedure neue_disk(sender: Tobject;
                                         var abort: boolean);
     end;

type tdrunzipper = class(tabunzipper)
                     public
                       abbrechen: boolean;
                       diskette: boolean;
                     published
                       constructor create(zipfile: ansistring;
                                          basisverzeichnis: shortstring;
                                          subdirectories: boolean;
                                          titel: shortstring);
                       destructor destroy; override;
                       procedure oeffne_zip_fenster(zipfile,titel: shortstring);
                       procedure fileprogress(sender: tobject;
                                              item: tabarchiveitem;
                                              progress: byte;
                                              var abort: boolean);
                       procedure programmprogress(sender: tobject;
                                                  progress: byte;
                                                  var abort: boolean);
                       procedure zipfehler(sender: tobject;
                                           Item: tabarchiveitem;
                                           processtype: tabprocesstype;
                                           errorclass: Taberrorclass;
                                           Errorcode: Integer);
                       procedure request_last_disk(sender: tobject;
                                                   var abort: boolean);
                       procedure request_disk(sender: tobject;
                                              disknumber: byte;
                                              var abort: boolean);
       end;

procedure dos_delete(was: shortstring;
                     subdirectories: boolean;
                     included_files: included_file_type);
procedure dos_copy(was,
                   zieldirectory: shortstring;
                   subdirectories,
                   nachfolgendes_loeschen,
                   anzeige_gauges: boolean;
                   us: shortstring;
                   included_files: included_file_type;
                   nur_neuere_dateien: boolean;
                   check_screen: boolean=false); //Radlinger CR 16.01.2007 Update Screen
function file_date(datei: shortstring): tdatetime;
function filedir(dateiname: shortstring): shortstring;

function check_update: shortstring;
function update_erlaubt: boolean;
procedure download_update;

function system_copy(von,nach: ansistring): boolean;
function system_move(von,nach: ansistring): boolean;

implementation

uses forms,
     graphics,
     classes,
     drstr,
     common,
     bsdef,
     dateien,
     idcomponent,
     xfiles,
     filectrl,
     winprocs,
     grafiken,
     rout,
     progupd,
     routinen,
     g_immer,
     idhttp, backup;
{------------------------- update_erlaubt - 02/07/15 11:17:AM -------------------------}
function update_erlaubt: boolean;
begin
  result:=( not csb ) and
          ( _default.internetzugriff ) and
          ( parameterwert('internet')<>'0' ) and
          ( prioritaet=9 );
end; {update_erlaubt}
{------------------------- file_date - 04/16/99 12:42:PM -------------------------}
function file_date(datei: shortstring): tdatetime;
var x: integer;
begin
  x:=fileage(datei);
  if x=-1 then result:=0
  else result:=filedatetodatetime(x);
end; {file_date}
{------------------------- filedir - 8/10/98 8:48AM -------------------------}
function filedir(dateiname: shortstring): shortstring;
var verz: shortstring;
begin
  verz:=extractfilepath(dateiname);
  if ( verz>'' ) and
     ( verz[length(verz)]<>'\' )then
    verz:=verz+'\';
  result:=verz;
end; {filedir}
{------------------------- dos_delete - 8/10/98 8:31AM -------------------------}
procedure dos_delete(was: shortstring;
                     subdirectories: boolean;
                     included_files: included_file_type);
var dateien: tdrdirectory;
    verz: string[100];
    x: integer;
begin
  verz:=filedir(was);
  dateien:=tdrdirectory.create(was,tdralles,included_files);
  for x := 1 to dateien.count do begin
    if ( dateien.directory[x] ) then begin
      if ( subdirectories ) then begin
        dos_delete(verz+dateien[x]+'\*.*',subdirectories,included_files);
        rmdir(verz+dateien[x]);
      end; {if}
    end {if}
    else begin
      filesetattr(verz+dateien[x],faarchive);
      erase_file(verz+dateien[x]);
    end;
    application.processmessages;
  end; {for x}
  dateien.free;
end; {dos_delete}
{------------------------- CreateGaugeFenster - 5/8/98 6:06PM -------------------------}
procedure CreateGaugeFenster(titel: AnsiString; zeilen: Integer);
var x,l: integer;
begin
  check_updatefunktionen;
  l:=laenge_text(all('X',60));
  haendisches_fenster(0,0,l+bs_abstand*6,(bs_zeilenhoehe*(3+zeilen)),titel,2,false,false);
  for x := 1 to zeilen do begin
    Gaugetitel[x]:=tdrlabel.create(bs_fenstertabelle[bs_offene_fenster]^.bs_hintergrund);
    with Gaugetitel[x] do begin
      fieldtype:=type_label;
      font.assign(bs_systemschrift);
      left:=bs_abstand*3;
      if ( x=1 ) then top:=bs_zeilenhoehe div 2
      else top:=bs_zeilenhoehe*2+bs_zeilenhoehe div 2;
      width:=l;
      height:=bs_zeilenhoehe-bs_rand_bei_zeile;
      visible:=true;
      parent:=bs_fenstertabelle[bs_offene_fenster]^.bs_hintergrund;
    end; {with Gaugetitel}
    Gauges[x]:=tgauge.create(bs_fenstertabelle[bs_offene_fenster]^.bs_hintergrund);
    with Gauges[x] do begin
      backcolor:=clwhite;
      borderstyle:=bssingle;
      color:=clbtnface;
      enabled:=true;
      font.assign(bs_systemschrift);
      forecolor:=clblue;
      height:=Gaugetitel[1].height;
      kind:=gkhorizontalbar;
      left:=Gaugetitel[1].left;
      maxvalue:=100;
      minvalue:=0;
      progress:=0;
      showtext:=true;
      if ( x=1 ) then top:=bs_zeilenhoehe+bs_zeilenhoehe div 2
      else top:=bs_zeilenhoehe*3+bs_zeilenhoehe div 2;
      width:=l;
      visible:=true;
      parent:=bs_fenstertabelle[bs_offene_fenster]^.bs_hintergrund;
    end; {with Gauges[x]}
  end; {for x}
  meld_esc;                                      //[Esc] Abbruch
  senden_message;
  bs_fenstertabelle[bs_offene_fenster]^.buttons[1].default:=true;
  close_all_files(true);
  close_file(m_);
end; {oeffne_zip_fenster}
{------------------------- _fileprogress - 9/20/98 3:35PM -------------------------}
procedure _fileprogress(item: tabarchiveitem;
                        progress: byte;
                        var abort: boolean;
                        var abbrechen: boolean;
                        zeile: byte);
begin
  if ( abbrechen ) or
     ( unterbrechung ) then abort:=true;
  item.diskfilename:=ansilowercase(item.diskfilename);
  Gaugetitel[zeile].caption:=item.diskfilename;
  Gauges[zeile].progress:=progress;
end; {_fileprogress}
{------------------------- dos_copy - 8/10/98 8:50AM -------------------------}
procedure dos_copy(was,
                   zieldirectory: shortstring;
                   subdirectories,
                   nachfolgendes_loeschen,
                   anzeige_gauges: boolean;
                   us: shortstring;
                   included_files: included_file_type;
                   nur_neuere_dateien: boolean;
                   check_screen: boolean=false); //Radlinger CR 16.01.2007 Update Screen

  function check_same_dir: boolean;
  var d1,d2: ansistring;
  begin
    result:=false;
    d1:=extractfiledir(was);
    if ( d1<>'' ) then begin
      d2:=ansilowercase(zieldirectory);
      result:=( ansilowercase(d1)=d2 );
    end;
  end;

  function check_same_file(fn1,fn2: ansistring): boolean;
    function chk(fn: ansistring): boolean;
    var h: integer;
    begin
      h:=fileopen(fn1,GENERIC_READ);
      result:=h>0;
      if ( result ) then fileclose(h);
    end;
  var h1,h2: integer;
  begin
    result:=( ansilowercase(fn1)=ansilowercase(fn2) );
    if ( result ) or
       ( not fileexists(fn2) ) or
       ( not fileexists(fn1) ) or
       ( not chk(fn2) ) or
       ( not chk(fn1) ) or
       ( FileAge(fn1)<>FileAge(fn2) ) then
      exit;

    h1:=fileopen(fn1,GENERIC_READ);
    if ( h1>0 ) then try
      h2:=fileopen(fn2,GENERIC_READ);
      if ( h2<0 ) then result:=true
      else fileclose(h2);
    finally
      fileclose(h1);
    end;
  end;

var dateien: tdrdirectory;
    verz: string[100];
    handle,erg,x,y: integer;
    ein,aus: file;
    feld: pansichar;
    ok,dummy: boolean;
    item: tabarchiveitem;
    age,summe,gesamt: longint;
    screen_immer_kopieren: boolean; //Radlinger CR 16.01.2007 Update Screen
    ist_DBIsam: boolean;
label loeschen;
begin
  if ( check_same_dir ) then exit;
  if ( subdirectories ) then anzeige_gauges:=false;
  if ( anzeige_gauges ) then begin
    CreateGaugeFenster(us,1);
    item:=tabarchiveitem.create;
    dummy:=false;
  end;
  close_all_files(true);
  verz:=filedir(was);
  if ( zieldirectory>'' ) and
     ( zieldirectory[length(zieldirectory)]<>'\' )then
    zieldirectory:=zieldirectory+'\';
  ist_DBIsam:=false;
  if ( pos('*',was)=0 ) and
     ( not exist(was) ) and
     ( ExistDBI(was) ) then begin
    was:=was+'.*';
    ist_DBIsam:=true;
  end;
  dateien:=tdrdirectory.create(was,tdralles,included_files);
  //Radlinger CR 16.01.2007 Update Screen - begin ==============================
  screen_immer_kopieren:=
    ( check_screen ) and
    ( dateien.count>0 ) and
    ( file_date(verz+'chemges.exe')>file_date(zieldirectory+'chemges.exe') );
  //Radlinger CR 16.01.2007 Update Screen - end ================================
  for x := 1 to dateien.count do begin
    application.processmessages;
    if ( dateien.directory[x] ) then begin
      if ( subdirectories ) then begin
        dos_copy(verz+dateien[x]+'\*.*',
                 zieldirectory+dateien[x],
                 subdirectories,
                 nachfolgendes_loeschen,
                 false,
                 '',
                 included_files,
                 nur_neuere_dateien,
                 check_screen); //Radlinger CR 16.01.2007 Update Screen
        if ( nachfolgendes_loeschen ) then rmdir(verz+dateien[x]);
      end; {if}
    end {if}
    else begin
      if not copy_chemges_exe and
         (ansilowercase(dateien[x])='chemges.exe') then
        continue;
      if ( ist_DBIsam ) then begin
        ok:=false;
        for y:=1 to high(DBIext) do begin
          if ( AnsiLowerCase(ExtractFileExt(dateien[x]))=DBIext[y] ) then begin
            ok:=true;
            break;
          end;
        end;
        if ( not ok ) then continue;
      end;
      if length(zieldirectory)>3 then forcedirectories(zieldirectory);
      getmem(feld,16384);
      ok:=false;
      if ( nur_neuere_dateien ) and
         ( file_date(zieldirectory+dateien[x])>=file_date(verz+dateien[x])) then begin
        //Radlinger CR 16.01.2007 Update Screen - begin ========================
        if ( pos('screen.',ansilowercase(dateien[x]))<>1 ) or
           ( not screen_immer_kopieren ) then begin
          ok:=true;
          goto loeschen;
        end;
        //Old code -------------------------------------------------------------
        (*
        ok:=true;
        goto loeschen;
        *)
        //Radlinger CR 16.01.2007 Update Screen - end ==========================
      end; {if}
      if ( not check_same_file(verz+dateien[x],
                               zieldirectory+dateien[x]) ) then begin
        assign(ein,verz+dateien[x]);
        resultat:=ioresult;
        filemode:=0;
        {$i-}
        reset(ein,1);
        {$i+}
        filemode:=66;
        if ioresult=0 then begin
          assign(aus,zieldirectory+dateien[x]);
          resultat:=ioresult;
          {$i-}
          rewrite(aus,1);
          {$i+}
          if ioresult=0 then begin
            if anzeige_gauges then begin
              summe:=0;
              gesamt:=filesize(ein);
              item.diskfilename:=verz+dateien[x];
            end;
            while ( not eof(ein) ) do begin
              blockread(ein,feld^,16384,erg);
              if ( erg>0 ) then begin
                blockwrite(aus,feld^,erg);
                if ( anzeige_gauges ) and
                   ( erg>0 ) then begin
                  inc(summe,erg);
                  _fileprogress(item,round(summe/gesamt*100),dummy,dummy,1);
                end; {if}
              end;
            end; {while}
            close(aus);
            ok:=true;
          end;
          close(ein);
          if ( ok ) then begin
            handle:=fileopen(verz+dateien[x],0);
            age:=filegetdate(handle);
            fileclose(handle);
            handle:=fileopen(zieldirectory+dateien[x],1);
            filesetdate(handle,age);
            fileclose(handle);
          loeschen:
            if nachfolgendes_loeschen then begin
              filesetattr(verz+dateien[x],faarchive);
              erase_file(verz+dateien[x]);
            end;
          end; {if}
        end;
      end;
      freemem(feld,16384);
    end; {else}
  end; {for x}
  dateien.free;
  if ( anzeige_gauges ) then begin
    item.free;
    closefenster;
    bs_unterbrechung_erlaubt:=false;
  end;
end; {dos_copy}
{------------------------------- Zippen --------------------------------------------------}
{------------------------- _zipfehler - 5/9/98 8:47AM -------------------------}
procedure _zipfehler(Item: tabarchiveitem;
                     const processtype: tabprocesstype;
                     errorclass: Taberrorclass;
                     Errorcode: Integer;
                     var abbrechen: boolean);
var feld: string[80];
begin
  feld:='';
  case ( errorclass ) of
    ecabbrevia:        case ( errorcode ) of
                         abduplicatename,
                         abuserabort:                exit;
                         abinvalidpassword:          feld:=lesen_message(3,10,''); //Falsches Passwort
                         abnosuchdirectory:          feld:=lesen_message(3,11,''); //Verzeichnis existiert nicht
                         AbUnknownCompressionMethod: feld:=lesen_message(3,14,''); //Unbekannte Kompressionsmethode
                         abzipbadcrc:                feld:=lesen_message(3,13,'');
                                                                         //Prüfsummenfehler bei gepackter Datei
                       end; {case}
    ecinouterror:      feld:=lesen_message(3,1002,''); //E/A-Fehler
    ecfilererror:      feld:='Filererror';
    ecfilecreateerror: feld:=lesen_message(3,353,''); //Datei konnte nicht angelegt werden!
    ecfileopenerror:   feld:=lesen_message(3,354,''); //Datei konnte nicht geöffnet werden
    else feld:=lesen_message(3,355,'');          //Datei # kann nicht angelegt werden
  end; {case}
  lesen_message(3,351,ansilowercase(item.diskfilename)); //Fehler bei Datei #
  etab[2]:=feld;
  mitteilungsfenster(mf_Fehler,etab,2);          //Voriger Text
  abbrechen:=true;
end; {_zipfehler}
{------------------------- _programmprogress - 9/20/98 3:36PM -------------------------}
procedure _programmprogress(progress: byte;
                            var abort: boolean;
                            var abbrechen: boolean;
                            zeile: byte);
begin
  if ( abbrechen ) or
     ( unterbrechung ) then
    abort:=true;
  Gauges[zeile].progress:=progress;
end; {_programmprogress}
{------------------------- oeffne_zip_fenster - 5/8/98 6:06PM -------------------------}
procedure tdrzipper.oeffne_zip_fenster(zipfile,titel: shortstring);
begin
  if ( _kein_fenster ) then exit;
  CreateGaugeFenster(titel,2);
  Gaugetitel[2].caption:=zipfile;
end; {oeffne_zip_fenster}
{------------------------- tdrzipper.neue_disk - 5/9/98 1:16PM -------------------------}
procedure tdrzipper.neue_disk(sender: Tobject;
                              var abort: boolean);
var meldung: boolean;
begin
  etab[1]:=wechseltext;
  mitteilungsfenster(mf_OK_Abbruch,etab,1);      //Abbruch
  if ( esc ) then begin
    abort:=true;
    abbrechen:=true;
  end {if}
  else begin
    application.processmessages;
    if ( diskette ) then dos_delete(copy(xzipfile,1,2)+'\*.*',true,nil);
  end;
end; {tdrzipper.neue_disk}
{------------------------- tdrzipper.zipfehler - 5/9/98 8:47AM -------------------------}
procedure tdrzipper.zipfehler(sender: tobject;
                              Item: tabarchiveitem;
                              processtype: tabprocesstype;
                              errorclass: Taberrorclass;
                              Errorcode: Integer);
begin
  if fehlermeldung_schreiben then _zipfehler(item,processtype,errorclass,errorcode,abbrechen)
  else begin
    abbrechen:=true;
    falschedatei:=extractfilename(Item.DiskFileName);
  end;
end; {tdrzipper.zipfehler}
{------------------------- tdrzipper.fileprogress - 9/20/98 3:34PM -------------------------}
procedure tdrzipper.fileprogress(sender: tobject;
                                 item: tabarchiveitem;
                                 progress: byte;
                                 var abort: boolean);
begin
  if ( _kein_fenster ) then exit;
  _fileprogress(item,progress,abort,abbrechen,1);
end; {tdrzipper.fileprogress}
{------------------------- tdrzipper.programmprogress - 9/20/98 3:36PM -------------------------}
procedure tdrzipper.programmprogress(sender: tobject;
                                     progress: byte;
                                     var abort: boolean);
begin
  if ( _kein_fenster ) then exit;
  _programmprogress(progress,abort,abbrechen,2);
end; {tdrzipper.programmprogress}
{------------------------- create_zipfile - 5/8/98 4:24PM -------------------------}
constructor tdrzipper.create(zipfile: shortstring;
                             vorher_loeschen: boolean;
                             basisverzeichnis: shortstring;
                             subdirectories: boolean;
                             abspeicherung_pfad: boolean;
                             titel: shortstring;
                             kein_lowercase: boolean=false;
                             kein_fenster: boolean=false);
var Item: tabarchiveitem;
    typ: tabprocesstype;
begin
  inherited create(application);
  fehlermeldung_schreiben:=true;
  falschedatei:='';
  abbrechen:=false;
  _kein_fenster:=kein_fenster;
  if ( not kein_lowercase ) then zipfile:=ansilowercase(zipfile)+'.zip'
  else zipfile:=zipfile+'.zip';
  xzipfile:=zipfile;
  diskette:=( length(zipfile)>1 ) and
            ( zipfile[1] in ['a','b'] ) and
            ( zipfile[2]=':' );
  if ( diskette ) then wechseltext:=lesen_message(2,75,'') //Bitte legen Sie eine formatierte Diskette ein
  else wechseltext:=lesen_message(2,76,'');      //Bitte legen Sie einen neuen, formatierten Datenträger ein
  if ( not kein_fenster ) then oeffne_zip_fenster(zipfile,titel);
  if ( diskette ) then neue_disk(self,abbrechen)
  else
    if ( vorher_loeschen ) then erase_file(zipfile);
  if abbrechen then exit;
  try
    filename:=zipfile;
  except
    lesen_message(3,355,zipfile);                //Datei # kann nicht angelegt werden
    mitteilungsfenster(mf_Fehler,etab,1);        //Abbruch
    abbrechen:=true;
    exit;
  end;

  if ( subdirectories ) then storeoptions:=[sorecurse];
  if ( not abspeicherung_pfad ) then storeoptions:=[sostrippath];
  StoreOptions:=StoreOptions+[soReplace];
  deflationoption:=domaximum;
  if ( basisverzeichnis>'' ) then basedirectory:=basisverzeichnis;
  dosmode:=false;
  onarchiveitemprogress:=fileprogress;
  onarchiveprogress:=programmprogress;
  onprocessitemfailure:=zipfehler;
  onrequestblankdisk:=neue_disk;
end; {create_zipfile}
{------------------------- zip_add - 5/8/98 5:03PM -------------------------}
procedure tdrzipper.add(datei: shortstring);
var CurDateityp: TDRDateityp;
    x: integer;
begin
  try
    if ( abbrechen ) then exit;
    if ( exist(datei,@CurDateityp) ) then begin
      if ( CurDateityp=dbDBIsam ) then begin
        for x:=1 to DBIcount do
          addfiles(DBIFilename(datei,x),$3f);
      end
      else addfiles(datei,$3f);
    end;
  except
    abbrechen:=true;
  end;
end; {zip_add}
{------------------------- zip_close - 5/8/98 5:05PM -------------------------}
procedure tdrzipper.schreiben;
begin
  if not abbrechen then begin
    try
      save;
    except
      if not abbrechen then begin
        lesen_message(3,352,'');                 //Komprimierung abgebrochen
        mitteilungsfenster(mf_Fehler,etab,1);    //Abbruch
      end;
    end;
  end;
  if ( not _kein_fenster ) then closefenster;
end; {zip_close}
{------------------------- destroy - 9/12/98 10:04AM -------------------------}
destructor tdrzipper.destroy;
var feld: ^shortstring;
begin
  new(feld);
  feld^:=extractfilepath(application.exename);
  if (length(feld^)>3) and
     (feld^[length(feld^)]='\') then
    dec(byte(feld^[0]));
  chdir(feld^);
  dispose(feld);
  inherited destroy;
end; {destroy}
{------------------------------------- Unzippen -----------------------------------}
constructor tdrunzipper.create(zipfile: ansistring;
                               basisverzeichnis: shortstring;
                               subdirectories: boolean;
                               titel: shortstring);
var Item: tabarchiveitem;
    typ: tabprocesstype;
    dir: shortstring;
begin
  inherited create(hilfsmaske);
  abbrechen:=false;
  zipfile:=ansilowercase(zipfile);
  pos_hinten('.zip',zipfile,true);
  if ( pos('\',zipfile)=0 ) and
     ( pos('/',zipfile)=0 ) then begin
    getdir(0,dir);
    zipfile:=dir+'\'+zipfile;
  end;
  filename:=zipfile;
  diskette:=( length(zipfile)>1 ) and
            ( zipfile[1] in ['a','b'] ) and
            ( zipfile[2]=':' );
  oeffne_zip_fenster(zipfile,titel);
  {if ( diskette ) then neue_disk(self,abbrechen)
  if abbrechen then exit;}
  try
    filename:=zipfile;
  except
    lesen_message(3,355,zipfile);                //Datei # kann nicht angelegt werden
    mitteilungsfenster(mf_Fehler,etab,1);        //Abbruch
    abbrechen:=true;
    exit;
  end;
  if ( subdirectories ) then extractoptions:=[eocreatedirs,eorestorepath]
  else extractoptions:=[];
  if ( basisverzeichnis>'' ) then begin
    forcedirectories(basisverzeichnis);
    try
      basedirectory:=basisverzeichnis;
    except
      mitteilungsfenster(mf_Fehler,713);         //Ausgabeverzeichnis existiert nicht!
      exit;
    end;
  end;
  onarchiveitemprogress:=fileprogress;
  onarchiveprogress:=programmprogress;
  onprocessitemfailure:=zipfehler;
  if diskette and
     not exist(zipfile) then begin
    request_last_disk(self,abbrechen);
    if abbrechen then exit;
  end;
  Gauges[1].progress:=1;
  Gauges[1].progress:=0;
  try
    extractfiles('*.*');
  except
  end;
end; {create_zipfile}
{------------------------- destroy - 9/12/98 10:04AM -------------------------}
destructor tdrunzipper.destroy;
var feld: ^shortstring;
begin
  new(feld);
  feld^:=extractfilepath(application.exename);
  if (length(feld^)>3) and
     (feld^[length(feld^)]='\') then
    dec(byte(feld^[0]));
  chdir(feld^);
  dispose(feld);
  if ( bs_aktuelle_maske<>nil ) and
     ( bs_aktuelle_maske.tag=0 ) then closefenster;
  inherited destroy;
end; {destroy}
{------------------------- oeffne_zip_fenster - 5/8/98 6:06PM -------------------------}
procedure tdrunzipper.oeffne_zip_fenster(zipfile,titel: shortstring);
begin
  CreateGaugeFenster(titel,2);
  Gaugetitel[1].caption:=zipfile;
end; {oeffne_zip_fenster}
{------------------------- tdrunzipper.zipfehler - 5/9/98 8:47AM -------------------------}
procedure tdrunzipper.zipfehler(sender: tobject;
                                Item: tabarchiveitem;
                                processtype: tabprocesstype;
                                errorclass: Taberrorclass;
                                Errorcode: Integer);
begin
  _zipfehler(item,processtype,errorclass,errorcode,abbrechen);
end; {tdrunzipper.zipfehler}
{------------------------- tdrunzipper.fileprogress - 9/20/98 3:34PM -------------------------}
procedure tdrunzipper.fileprogress(sender: tobject;
                                 item: tabarchiveitem;
                                 progress: byte;
                                 var abort: boolean);
begin
  _fileprogress(item,progress,abort,abbrechen,2);
end; {tdrunzipper.fileprogress}
{------------------------- tdrunzipper.programmprogress - 9/20/98 3:36PM -------------------------}
procedure tdrunzipper.programmprogress(sender: tobject;
                                     progress: byte;
                                     var abort: boolean);
begin
  _programmprogress(progress,abort,abbrechen,1);
end; {tdrunzipper.programmprogress}
{------------------------- tdrunzipper.request_disk - 5/9/98 1:16PM -------------------------}
procedure tdrunzipper.request_disk(sender: Tobject;
                                   disknumber: byte;
                                   var abort: boolean);
begin
  if ( disknumber=99 ) then mitteilungsfenster(mf_OK_Abbruch,711) //Bitte legen Sie die LETZTE Datendiskette ein
  else begin
    lesen_mess(712,ber_justl(disknumber,'z9'));  //Bitte legen Sie die Datendiskette mit der Nummer # ein.
    mitteilungsfenster(mf_OK_Abbruch,etab,1);    //Abbruch
  end;
  if ( esc ) then begin
    abort:=true;
    abbrechen:=true;
  end {if}
  else application.processmessages;
end; {tdrunzipper.request_disk}
{------------------------- tdrunzipper.request_last_disk - 5/9/98 1:16PM -------------------------}
procedure tdrunzipper.request_last_disk(sender: Tobject;
                                        var abort: boolean);
begin
  request_disk(sender,99,abort);
end; {tdrunzipper.request_last_disk}

{------------------------- komprimiere - 12/20/03 11:59:AM -------------------------}
procedure komprimiere(var f: ansistring);
var komp,entkomp: tmemorystream;
begin
  komp:=tmemorystream.create;
  entkomp:=tmemorystream.create;
  entkomp.writebuffer(f[1],length(f));
  entkomp.position:=0;
  deflatestream(entkomp,komp);
  setlength(f,komp.size);
  komp.position:=0;
  komp.readbuffer(f[1],komp.size);
  komp.free;
  entkomp.free;
end; {komprimiere}
{------------------------- entkomprimiere - 12/20/03 11:59:AM -------------------------}
procedure entkomprimiere(var f: ansistring);
var komp,entkomp: tmemorystream;
begin
  komp:=tmemorystream.create;
  entkomp:=tmemorystream.create;
  komp.writebuffer(f[1],length(f));
  komp.position:=0;
  try
    inflatestream(komp,entkomp);
  except
    f:='';
    exit;
  end;
  setlength(f,entkomp.size);
  entkomp.position:=0;
  entkomp.readbuffer(f[1],entkomp.size);
  komp.free;
  entkomp.free;
end; {komprimiere}
{------------------------- check_update - 08/22/14 3:42:PM -------------------------}
const neueste_version: byte=0;
function check_update: shortstring;
var http: tidhttp;
    f: ansistring;
    x: integer;
begin
  result:='';
  if ( _default.internetzugriff ) and
     ( parameterwert('internet')<>'0' ) then begin      //nur vorsichtshalber, falls wer nicht
                                                        //mehr ins Programm kommt
     //and ( language[1] in ['D','E'] )*) then begin
    http:=tidhttp.create(nil);
    try
      http.ConnectTimeout:=1000;
      http.ReadTimeout:=1000;
      f:=http.get('http://www.dr-software.com/downloads/downloads-d.htm');
      x:=pos('auf Version',f);
      if ( x>0 ) then begin
        delete(f,1,x+11);
        x:=pos(' ',f);
        if ( x>1 ) then begin
          setlength(f,x-1);
          if ( f>versionsnummer ) then result:=f;
          f:=replace(f,'.','x');
          neueste_version:=value(f);
        end; {if}
      end; {if}
    except
    end;
    http.free;
  end;
end; {check_update}
{---------------------------------------------------------------------------------------}
type tdridhttp = class(tidhttp)
     private
       lfd,anz,geslaenge: integer;
       ms: TMemoryStream;
       abbrechen: boolean;
       downloadtab: array [1..5] of record
         name: ansistring;
         groesse: longint;
         datum: tdatetime;
       end;
       procedure Work5(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: longint);
       procedure Work(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
     public
       constructor Create(AOwner: TComponent);
     end;
constructor tdridhttp.create;
begin
  inherited create(AOwner);
  ms:=nil;
  anz:=0;
  geslaenge:=0;
  {$IFDEF VER130}
  OnWork:=Work5;
  {$ELSE}
  OnWork:=Work;
  {$ENDIF}
end;

procedure tdridhttp.Work5(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: longint);
var x,ges: integer;
  {------------------------- kb - 02/02/15 3:35:PM -------------------------}
  function kb(zahl: integer): ansistring;
  begin
    result:=ber_justl(zahl/1024/1024,'zz9,9')+' MB';
  end; {kb}
begin
  ges:=AWorkCount;
  for x := 1 to lfd-1 do inc(ges,downloadtab[x].groesse);
  Gaugetitel[1].caption:=kb(ges)+'/'+kb(geslaenge);
  Gauges[1].progress:=round(ges/geslaenge*100);
  Gaugetitel[2].caption:=ansilowercase(downloadtab[lfd].name)+'.zip - '+kb(AWorkCount)+'/'+kb(downloadtab[lfd].groesse);
  Gauges[2].progress:=round(AWorkCount/downloadtab[lfd].groesse*100);
  application.processmessages;
  if ( unterbrechung ) then begin
    abbrechen:=true;
    try
      disconnect;
    except
    end;
  end;
end;

procedure tdridhttp.Work(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var x,ges: integer;
  {------------------------- kb - 02/02/15 3:35:PM -------------------------}
  function kb(zahl: integer): ansistring;
  begin
    result:=ber_justl(zahl/1024/1024,'zz9,9')+' MB';
  end; {kb}
begin
  ges:=AWorkCount;
  for x := 1 to lfd-1 do inc(ges,downloadtab[x].groesse);
  Gaugetitel[1].caption:=kb(ges)+'/'+kb(geslaenge);
  Gauges[1].progress:=round(ges/geslaenge*100);
  Gaugetitel[2].caption:=ansilowercase(downloadtab[lfd].name)+'.zip - '+kb(AWorkCount)+'/'+kb(downloadtab[lfd].groesse);
  Gauges[2].progress:=round(AWorkCount/downloadtab[lfd].groesse*100);
  application.processmessages;
  if ( unterbrechung ) then begin
    abbrechen:=true;
    try
      disconnect;
    except
    end;
  end;
end;
{------------------------- download_update - 08/22/14 4:04:PM -------------------------}
procedure download_update;
var http: tdridhttp;
    handle,x,y: integer;
    gauge_offen: boolean;
    f: ansistring;
    unzip: tdrunzipper;
    verg: tdatetime;
  {------------------------- datname - 02/02/15 3:49:PM -------------------------}
  function datname_website(dateiname: ansistring): ansistring;
  begin
    result:='http://www.dr-software.com/downloads/'+dateiname+'.zip';
  end; {datname}
  function datname_computer(dateiname: ansistring; temp: boolean=false): ansistring;
  begin
    if ( temp ) then result:=dir_temp+'\'+dateiname+'.zip'
    else result:=dateienzuordnung.dat[1]+'\'+dateiname+'.zip';
  end; {datname}
  function datname_chm: ansistring;
  begin
    result:=dateienzuordnung.dat[1]+'\chem_'+trim(language)+'.chm';
  end; {datname}

  function vgl_Zeitstempel(dat,verg: TDateTime): boolean; //result: dat>verg
  const dtf='yyyymmdd_hhnn';
  var s_dat,s_verg: ansistring;
  begin
    DateTimeToString(s_dat,dtf,dat);
    DateTimeToString(s_verg,dtf,verg);
    result:=s_dat>s_verg;
  end;

  {------------------------- add - 02/01/15 11:06:AM -------------------------}
  procedure add(Dateiname: ansistring; vergleichen: boolean=false);
  var laenge: integer;
      dat: tdatetime;
  begin
    with http do begin
      laenge:=0;
      try
        head(datname_website(Dateiname));
        dat:=response.LastModified;
        if ( vergleichen ) and
           ( vgl_Zeitstempel(dat,verg) ) or
           ( not vergleichen ) then
          laenge:=response.contentlength;
      except
        exit;
      end;
      if ( laenge>0 ) then begin
        inc(anz);
        inc(geslaenge,laenge);
        downloadtab[anz].name:=dateiname;
        downloadtab[anz].groesse:=laenge;
        if ( vergleichen ) then downloadtab[anz].datum:=dat
        else downloadtab[anz].datum:=0;
      end; {if}
    end; {with http}
  end; {add}
  function chonl_lang: shortstring;
  begin
    result:=trim(language);
    if ( result='ENG' ) then result:='EN';
  end;
begin
  if ( _default.internetzugriff ) and
     ( parameterwert('internet')<>'0' ) then begin
    sicherung(saVorUpdate);
    http:=tdridhttp.create(nil);
    with http do try
      gauge_offen:=false;
      add('32');
      if ( geslaenge>0 ) then begin
        if ( neueste_version>0 ) then begin
          f:=replace(versionsnummer,'.','x');
          if ( neueste_version-value(f)>2 ) then add('32old');
        end; {if}
        add('FR/screen');
        add('IT/screen');
        x:=fileage(datname_chm);
        if ( x<>-1 ) then verg:=filedatetodatetime(x)
        else verg:=0;
        add('chonl_'+chonl_lang,true);

        CreateGaugeFenster('Update',2);
        gauge_offen:=true;
        abbrechen:=false;
        for x := 1 to anz do begin
          lfd:=x;
          ms:=TMemoryStream.Create;
          try
            get(datname_website(downloadtab[x].name),ms);
          except
            drerrorlog('Update: Download error "'+downloadtab[x].name+'"');
            abbrechen:=true;
          end;
          downloadtab[x].name:=replace(downloadtab[x].name,'/','-');
          erase_file(datname_computer(downloadtab[x].name));
          if ( not abbrechen ) then try
            ms.SaveToFile(datname_computer(downloadtab[x].name));
          except
            drerrorlog('Update: Could not save the update file to "'+datname_computer(downloadtab[x].name)+'"');
            try
              ms.SaveToFile(datname_computer(downloadtab[x].name,true));
              dos_copy(datname_computer(downloadtab[x].name,true),dateienzuordnung.dat[1],false,true,false,'',nil,false);
              if ( not exist(datname_computer(downloadtab[x].name)) ) then begin
                drerrorlog('Update: Could not move the update file to "'+datname_computer(downloadtab[x].name)+'"');
                abbrechen:=true;
              end;
            except
              drerrorlog('Update: Could not save the update file to "'+datname_computer(downloadtab[x].name,true)+'"');
              abbrechen:=true;
            end;
          end;
          freeandnil(ms);
          if ( abbrechen ) then begin
            for y := 1 to x-1 do erase_file(datname_computer(downloadtab[y].name));
            break;
          end;
        end; {for x}

        if ( not abbrechen ) then begin
          if ( copy(downloadtab[anz].name,1,5)='chonl' ) then begin
            if ( gauge_offen ) then closefenster;
            gauge_offen:=false;
            forget_file(maskhlp_);
            try
              unzip:=tdrunzipper.create(datname_computer(downloadtab[anz].name),'',false,'');
              unzip.free;
              try
                handle:=fileopen(datname_chm,1);
                filesetdate(handle,DateTimeToFileDate(downloadtab[anz].datum));
                fileclose(handle);
              except
              end;
            except
              drerrorlog('Invalid zip: '+datname_computer(downloadtab[anz].name)+'.zip');
            end;
          end; {if}
          check_update_verzeichnis;
        end; {if}
      end;
    finally
      if ( ms<>nil ) then ms.free;
      free;
      if ( gauge_offen ) then closefenster;
    end; {with http}
  end; {if}
end; {download_update}
function system_copymove(von,nach: ansistring; art: ansichar): boolean;
var oldf,newf: array [0..255] of ansichar;
begin
  move_max0(von.Trim_S,oldf);
  move_max0(nach.Trim_S,newf);
  ForceDirectories(ExtractFilePath(nach));
  erase_file(nach);
  if ( art='C' ) then Result:=copyfileA(@oldf,@newf,false)
  else Result:=movefileA(@oldf,@newf);
end;

function system_move(von,nach: ansistring): boolean;
begin
  Result:=system_copymove(von,nach,'M');
end;

function system_copy(von,nach: ansistring): boolean;
begin
  Result:=system_copymove(von,nach,'C');
end;

end.