ZIP で圧縮 / 解凍したい (Delphi 6 以降)

 ZIP で圧縮 / 解凍を行う方法はそれこそ幾つもあります。ただ、"商用でも使える事" という縛りがあると中々難しいトコロがあります。

 Delphi には zlib が付属していますが、zlib はいわゆる ZIP ファイルを操作できる訳ではなく ZIP ファイルを操作するには PKZIP のファイルヘッダを自前で処理してやる必要があります。もちろん、自前で PKZIP ヘッダを処理してもいいのですが、既にそれが存在するのならそちらを利用するのが簡単です。今回紹介する SciZipFile は本体に zlib を使った ZIP ファイルを操作するクラスです。

SciZipFile のダウンロード

 ダウンロードは CodeCentral から行えます (http://cc.embarcadero.com/item/21894 )。ダウンロードしたら解凍し、SciZipFile.pas を確保します。必要なのはこのファイルだけです。

圧縮 / 解凍

 SciZipFile.pas 単体のままでは簡単に圧縮/解凍という訳にいきませんので、もう一つユニットを噛ませてやります。

unit ZipFiles;

interface

uses
  Classes, SysUtils, SciZipFile;

procedure DecompressZipFile(const aFileName, aDstDir: TFileName);
procedure CompressZipFile(const aFileName, aSrcDir: TFileName);

implementation

procedure CompressZipFile(const aFileName, aSrcDir: TFileName);
type
  PSearchRec = ^TSearchRec;
var
  i: Integer;
  dSR: TSearchRec;
  Zip: TZipFile;
  Files: TStringList;
  dFileName, dSrcDir: TFileName;
  MS: TMemoryStream;
  {$IFDEF UNICODE}
  Raw: RawByteString;
  {$ELSE}
  Raw: AnsiString;
  {$ENDIF}
  procedure EnumFiles(aDir: TFileName);
  var
    SR: TSearchRec;
    PSR: PSearchRec;
  begin
    aDir := IncludeTrailingPathDelimiter(aDir);
    if FindFirst(aDir + '*.*', faAnyFile, SR) = 0 then
      begin
        repeat
          if StringReplace(SR.Name, '.''', [rfReplaceAll]) = '' then
            Continue;
          New(PSR);
          PSR^ := SR;
          Files.AddObject(aDir + SR.Name, TObject(PSR));
          if (SR.Attr and faDirectory) = faDirectory then
            EnumFiles(aDir + SR.Name);
        until FindNext(SR) <> 0;
        FindClose(SR);
      end;
  end;
begin
  Zip := TZipFile.Create;
  Files := TStringList.Create;
  MS := TMemoryStream.Create;
  try
    EnumFiles(aSrcDir);
    Files.Sort;
    dSrcDir := IncludeTrailingPathDelimiter(aSrcDir);
    for i:=0 to Files.Count-1 do
      begin
        dFileName := StringReplace(Files[i], dSrcDir, '', [rfIgnoreCase]);
        dSR := PSearchRec(Files.Objects[i])^;
        Zip.AddFile(dFileName, dSR.Attr);
        if (dSR.Attr and faDirectory) <> faDirectory then
          begin
            MS.Clear;
            MS.LoadFromFile(Files[i]);
            MS.Position := 0;
            SetLength(Raw, MS.Size);
            MS.Read(Raw[1], MS.Size);
            Zip.Data[i]     := Raw;
          end;
        Zip.DateTime[i] := FileDateToDateTime(dSR.Time);
        Dispose(PSearchRec(Files.Objects[i]));
      end;
    Zip.SaveToFile(aFileName);
  finally
    MS.Free;
    Files.Free;
    Zip.Free;
  end;
end;

procedure DecompressZipFile(const aFileName, aDstDir: TFileName);
var
  i: Integer;
  dDstDir, dFileDir, dFileName: TFileName;
  SS: TStringStream;
  Zip: TZipFile;
begin
  if not DirectoryExists(aDstDir) then
    ForceDirectories(aDstDir);
  if not DirectoryExists(aDstDir) then
    Exit;
  dDstDir := IncludeTrailingPathDelimiter(aDstDir) +
             ExtractFileName(ChangeFileExt(aFileName, '')) + PathDelim;
  Zip := TZipFile.Create;
  try
    Zip.LoadFromFile(aFileName);
    for i:=0 to Zip.Count-1 do
      begin
        SS := TStringStream.Create(Zip.Data[i]);
        try
          dFileName := dDstDir + StringReplace(Zip.Name[i], '/''\', [rfReplaceAll]);
          dFileDir := ExtractFilePath(dFileName);
          if not DirectoryExists(dFileDir) then
            ForceDirectories(dFileDir);
          if dFileName[Length(dFileName)] <> PathDelim then
            SS.SaveToFile(dFileName);
        finally
          SS.Free;
        end;
      end;
  finally
    Zip.Free;
  end;
end;

end.

 CompressZipFile() で圧縮、DeCompressZipFile() で解凍です。どちらも aFileName には ZIP ファイルを指定します。圧縮の場合、aSrcDir に圧縮するファイルを格納したフォルダを指定します (単一のファイルを指定して圧縮する事はできません)。解凍の場合、aDstDir に解凍先のフォルダを指定します。解凍先は存在しないフォルダであっても構いません。

 いざ使ってみると EZDecompressionError ("data error") が出る?そんな方は次項を。

SciZipFile.pas の修正 (Delphi 2009 以降)

 バッファに AnsiString を使っているため、Delphi 2009 以降の場合には SciZipFile.pas の修正が必要となります。

function TZipFile.GetUncompressed(i: integer): ansistring;
var
  ...
begin
  ...
//Aheader := #120 + #156;
  SetLength(Aheader, 2);
  Aheader[1] := #120;
  Aheader[2] := #156;

 修正に意味が無いように思えるかもしれませんが、これでちゃんと動きます。修正の意味が解らない方は "Delphi での文字コードのハンドリングについて" をご覧下さい。

See Also:


 BACK