Compresser/extraire plusieurs fichiers dans une archive

{Compresser plusieurs fichiers un derrière l'autre, puis les extraire vers un repertoire
donnée. Bref un petit Winzip avec un format propriétaire en quelques lignes}

uses
Zlib;

procedure CompressFiles(Files: TStrings; const Filename: string);
var
infile, outfile, tmpFile: TFileStream;
compr: TCompressionStream;
i, l: Integer;
s: string;

begin
if Files.Count > 0 then
begin
outFile := TFileStream.Create(Filename, fmCreate);
try
{ the number of files }
l := Files.Count;
outfile.Write(l, SizeOf(l));
for i := 0 to Files.Count - 1 do
begin
infile := TFileStream.Create(Files[i], fmOpenRead);
try
{ the original filename }
s := ExtractFilename(Files[i]);
l := Length(s);
outfile.Write(l, SizeOf(l));
outfile.Write(s[1], l);
{ the original filesize }
l := infile.Size;
outfile.Write(l, SizeOf(l));
{ compress and store the file temporary}
tmpFile := TFileStream.Create('tmp', fmCreate);
compr := TCompressionStream.Create(clMax, tmpfile);
try
compr.CopyFrom(infile, l);
finally
compr.Free;
tmpFile.Free;
end;
{ append the compressed file to the destination file }
tmpFile := TFileStream.Create('tmp', fmOpenRead);
try
outfile.CopyFrom(tmpFile, 0);
finally
tmpFile.Free;
end;
finally
infile.Free;
end;
end;
finally
outfile.Free;
end;
DeleteFile('tmp');
end;
end;

procedure DecompressFiles( const Filename, DestDirectory: string);
var
dest, s: string;
decompr: TDecompressionStream;
infile, outfile: TFilestream;
i, l, c: Integer;
begin
//version Delphi 5
if length(DestDirectory) = 0 then dest := 'c:';

if DestDirectory[length(DestDirectory)] <> '' then
Dest := DestDirectory + ''
else Dest:= DestDirectory;

// utiliser IncludeTrailingPathDelimiter sous D6/D7
// dest := IncludeTrailingPathDelimiter(DestDirectory);

infile := TFileStream.Create(Filename, fmOpenRead);
try
{ number of files }
infile.Read(c, SizeOf(c));
for i := 1 to c do
begin
{ read filename }
infile.Read(l, SizeOf(l));
SetLength(s, l);
infile.Read(s[1], l);
{ read filesize }
infile.Read(l, SizeOf(l));
{ decompress the files and store it }
s := dest + s; //include the path
outfile := TFileStream.Create(s, fmCreate);
decompr := TDecompressionStream.Create(infile);
try
outfile.CopyFrom(decompr, l);
finally
outfile.Free;
decompr.Free;
end;
end;
finally
infile.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
//creer une archive de fichiers
var
slFile: TStringList;
begin
slFile := TStringList.Create;
try
//ajouter les fichiers à compresser à la liste
slFile.add('c:image.bmp');
slFile.Add('c: exte.txt');
CompressFiles(slFile, 'c: est.zip');
finally
slFile.FRee;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
//extraire les fichiers vers un répertoire
begin
DecompressFiles('c: est.zip', 'c: emp');
end;