KAZip Open Archiv

[ascotlx]

Moin little_buddah,

ich hab's mal so gelöst ....
Hab es aber gerade aus einem Projekt herausgelöst... nicht getestet. ...

Es gibt ein Verzeichnis indem die Dateien liegen, die archiviert werden sollen.
Es wird in das Verzeichnis gewechselt ...
Das ZipFilename sieht so aus: <übergebenerName>_<Datum>.zip

Delphi-Quellcode:

//==============================================================================
// Dateien packen
procedure TForm1.packer(IniAList:TStrings; name, ldate, base: string);
var str2, str3, str4: string; // str2: Zipdateiname, str3: e:\projekt\ZipOutput, str4: e:\projekt\sammel\,
    i, fcount : integer;      // Filecount
    Alist: TStringlist;       // Dateiliste zum packen
    SKBase, SKsrPath, SKzipPath : string;
begin
 SKBase   : string = 'e:\projekt';
 SKsrPath : string = 'sammel\';
 SKzipPath : string = 'ZIPoutput\';

 KAZip1:=TKAZip.Create(nil);
 AList:=TStringlist.Create;
 AList.Assign(IniAList);

 str2:=name+'_'+ldate;     // ZipArchiv
 str3:=base+'\'+SKsrPath;  // dateien die eingepackt werden sollen
 str4:=base+'\'+SKzipPath; // Verzeichnis, wo das ZIP Archiv abgelegt werden soll 

 if DirectoryExists(str3) then
  begin
   KAZip1.CreateZip(str4+str2+'.zip');
   KAZip1.FileName:=str4+str2+'.zip';
   KAZip1.Active:=true;

   Form1.ProgressBar1.Min:=0;
   Form1.Show;
   Form1.ProgressBar1.Max:=AList.Count;
   fcount:=0;

   for i := 0 to AList.Count -1 do
    begin
     // und ab zu den Logdateien
     chdir(str3);
     if FileExists(Alist[i]) then
      begin
       KAZip1.AddFile(Alist[i]);
       if fcount = 50 then
        begin
         Application.ProcessMessages;
         fcount:=0;
        end;
       fcount:=fcount + 1;
      end;
     // und wieder zurück
     chdir(ExtractFilePath(ParamStr(0)));
     Form1.Label1.Refresh;
     Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position + 1;
    end;

   KAZip1.Active:=false;
   KAZip1.Close;
   KAZip1.Free;
   Form1.ProgressBar1.Position:=0;
   AList.Free;
  end
 else
  begin
   MessageDlg('Verzeichnis existiert nicht',mtInformation, [mbOk], 0);
  end;
end;

cu && HTH
ascotlx