Thema: Delphi ZLib Problem

Einzelnen Beitrag anzeigen

Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#13

Re: ZLib Problem

  Alt 3. Nov 2007, 07:49
Und was ist an Abbrevia so schlimm? Im Grunde sind doch für das eigentliche Packen / Entpacken nur jeweils 3 Zeilen nötig:
Delphi-Quellcode:
unit Compress;

interface

uses Classes, Sysutils, Abgztyp, Abutils;


function GZipPack(sFile, sArchiv : string) : boolean;
function GZipUnpack(sArchiv, sFilePath : string; var sFileName : string) : boolean;
function IsGzip(sFile : string) : boolean;

implementation

function GZipPack(sFile, sArchiv : string) : boolean;
var
   gArchiv : TAbGzipArchive;
   FileDate : integer;
   DosFileDate : integer;
   FHandle : integer;
begin
   try
      FileDate := FileAge(sFile);
      gArchiv := TAbGZipArchive.Create(ExpandFileName(sArchiv), fmCreate); // Relevante Zeile 1
      gArchiv.AddFiles(sFile, faAnyFile); // Relevante Zeile 2
      gArchiv.Save; // Relevante Zeile 3

      FreeAndNil(gArchiv);

      // Setzen des Archivdatums auf Datum der Eingabedatei
      FHandle := FileOpen(ExpandFileName(sArchiv), fmOpenWrite);
      if FHandle >= 0 then
      begin
         FileSetDate(FHandle, FileDate);
         FileClose(FHandle);
      end;

      result := true;
   finally
      if Assigned(gArchiv) then
         gArchiv.Free;
   end;
end;

function GZipUnpack(sArchiv, sFilePath : string; var sFileName : string) : boolean;
var
   gArchiv : TAbGZipArchive;
   iFile : integer;
begin
   try
      gArchiv := TAbGZipArchive.Create(sArchiv, fmOpenRead); // Relevante Zeile 1
      gArchiv.Load; // Relevante Zeile 2
      // GZip kann nur eine Datei pro Archiv
      iFile := 0;
      if sFilePath = 'then
         sFilePath := GetCurrentDir;

      sFilePath := IncludeTrailingBackslash(sFilePath);
      ForceDirectories(sFilePath);
      sFileName := sFilePath+ExtractFileName(gArchiv.Items[iFile].FileName);
      gArchiv.Extract(gArchiv.Items[iFile], sFileName); // Relevante Zeile 3

      result := true;
   finally
      if Assigned(gArchiv) then
         gArchiv.Free;
   end;
end;

function IsGZip(sFile : string) : boolean;
type
   TGZipBuffer = record
      Id1, Id2, Method : byte;
   end;
var
   FileStream : TFileStream;
   GZipBuffer : TGZipBuffer;
begin
   result := false;
   if FileExists(sFile) then
   begin
      try
         FileStream := TFileStream.Create(sFile, fmOpenRead);
         FileStream.ReadBuffer(GZipBuffer, Sizeof(GZipBuffer));
         result := (GZipBuffer.Id1 = $1F) and
                   (GZipBuffer.Id2 = $8B) and
                   (GZipBuffer.Method = $08)
      finally
         if Assigned(FileStream) then
            FileStream.Free;
      end;
   end;
end;
end.
Packen z.B. mit GzipPack('test.txt', 'test.gz')
Entpacken mit GzipUnpack('test.gz', 'c:\temp', AFileName)
Testen ob es ein GZip ist mit IsGzip('c:\bla.txt')
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat