Thema: Delphi Streams

Einzelnen Beitrag anzeigen

Prototypjack

Registriert seit: 2. Feb 2003
611 Beiträge
 
Delphi 2009 Professional
 
#1

Streams

  Alt 14. Okt 2005, 13:15
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
Max
„If you have any great suggestions, feel free to mail me, and I'll probably feel free to ignore you.“ . Linus Torvalds
  Mit Zitat antworten Zitat