Hallo,
Ich schreibe gerade eine Methode zum erstellen eines Komprimierten Archives mit Verzeichnisstrukturen. Ohne Kompressione funzt das ganze schon ganz gut aber mit Kompression macht es Probleme.
Das ganze basiert auf Luckies TArchiv.
Hier die Compressionsmethode die
nicht funktioniert:
Delphi-Quellcode:
procedure TArchive.AddCompressedFiles(Files,ArchFileNames: TStrings);
var
i: Integer;
fs2: TFileStream;
fs: TMemorystream;
FilesCnt: Cardinal;
FileSize: Int64;
Filename: string[255];
FileToAdd: TStreamProgressAdapter; // TFileStream;
compressin: TFilestream;
compressout: TMemorystream;
CompressionStream: TZCompressionStream;
begin
fs2 := TFileStream.Create(FArchiveFile, fmCreate or fmShareExclusive);
fs := TMemorystream.create;
try
FilesCnt := Files.Count;
// write number of files at offset 0
fs2.WriteBuffer(FilesCnt, sizeof(Cardinal));
// write files at offset 0 + offset number of files + offset filesizes + offset filenamens
for i := 0 to FilesCnt - 1 do
begin
if FCancel then exit;
FFilename := Files[i];
//Add Compression here!
CompressIn :=Tfilestream.create(Files[i],fmOpenRead);
compressout :=Tmemorystream.create;
try
CompressionStream := TZCompressionStream.Create(compressout, zcMax);
try
CompressionStream.CopyFrom(compressin, compressin.Size);
finally
CompressionStream.Free;
end;
// write filesizes at offset 0 + offset number of files
FSize :=compressout.size;
Filesize :=compressout.size;
fs2.WriteBuffer(FileSize, sizeof(Int64));
FileToAdd := TStreamProgressAdapter.Create(compressout);
finally
FreeAndNil(CompressOut);
FreeAndNil(CompressIn);
end;
try
FileToAdd.OnProgress := FileAddProgress;
fs.CopyFrom(FileToAdd, FileToAdd.Size);
showmessage('test');
finally
FreeAndNil(FileToAdd);
end;
if Assigned(OnTotalProgress) then
OnTotalProgress(self, FilesCnt, i);
end;
// write filenames at offset 0 + offset number of files + offset filesizes
for i := 0 to FilesCnt - 1 do
begin
Filename := (ArchFileNames[i]);
fs2.WriteBuffer(Filename, 255);
end;
fs2.CopyFrom(fs,fs.size);
finally
FreeAndNil(fs);
FreeAndNil(fs2);
end;
end;
Hier die normale Schreibmethode, welche funktioniert:
Delphi-Quellcode:
procedure TArchive.AddFiles(Files,ArchFileNames: TStrings);
var
i: Integer;
fs: TFileStream;
FilesCnt: Cardinal;
FileSize: Int64;
Filename: string[255];
FileToAdd: TStreamProgressAdapter; // TFileStream;
begin
fs := TFileStream.Create(FArchiveFile, fmCreate or fmShareExclusive);
try
FilesCnt := Files.Count;
// write number of files at offset 0
fs.WriteBuffer(FilesCnt, sizeof(Cardinal));
// write filesizes at offset 0 + offset number of files
for i := 0 to FilesCnt - 1 do
begin
FileSize := GetFileSize(Files[i]);
fs.WriteBuffer(FileSize, sizeof(Int64));
end;
// write filenames at offset 0 + offset number of files + offset filesizes
for i := 0 to FilesCnt - 1 do
begin
Filename := (ArchFileNames[i]);
fs.WriteBuffer(Filename, 255);
end;
// write files at offset 0 + offset number of files + offset filesizes + offset filenamens
for i := 0 to FilesCnt - 1 do
begin
if FCancel then exit;
FSize := GetFileSize(Files[i]);
FFilename := Files[i];
FileToAdd := TStreamProgressAdapter.Create(TFileStream.Create(Files[i],
fmOpenRead));
try
FileToAdd.OnProgress := FileAddProgress;
fs.CopyFrom(FileToAdd, FileToAdd.Size);
finally
FreeAndNil(FileToAdd);
end;
if Assigned(OnTotalProgress) then
OnTotalProgress(self, FilesCnt, i);
end;
finally
FreeAndNil(fs);
end;
end;
Ich würde es sehr begrüßen wenn mir jemand bei der Fehlerbeseitigung im obigen Code helfen könnte.
Achja, zu den Fehlern: Das sind so tolle Exceptions aus denen keiner Schlau wird.
Danke schonmal,
Gruß,
Max