Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2015年03月29日] [更新 2015年03月29日]　Delphi サンプルプログラム集
748_TurboPower Abbrevia を使用したファイルの圧縮・解凍
動作確認等 Windows 7 U64(SP2) + Delphi XE(UP1) Pro + TurboPower Abbrevia 5.2
748_TurboPower_Abbrevia.zip　[2,102 KB]　2015年03月29日版 (EXE 同梱)






TurboPower プロジェクトの TurboPower Abbrevia コンポーネント


TurboPower Abbrevia (ターボパワー アヴィリービア) は，TurboPower プロジェクトの 1 つとして提供されているアーカイブファイルの圧縮・解凍・展開用のコンポーネントです．
ZIP, TAR, GZ (GZip), BZ2 (BZip2), ZLIB, CAB 書庫の操作，ZIP 形式の自己解凍式の書庫の作成も可能です．32 ビットのアプリ，64 ビットのアプリの作成にも利用でき，DLL を必要としません．OS X の開発にも利用可能となっています．

本ページのサンプルは，TAbZipper と TAbUnZipper コンポーネントだけを使用するサンプルですが，Windows CAB 書庫を扱うための専用のコンポーネントもあります．また，書庫内を表示するためのビジュアルなコンポーネントも用意されています．
下図は TurboPower Abbrevia に添付されている ComCtrlsDemo というサンプルプログラムをコンパイルして実行した画面です．このサンプルでは，TAbListView, TAbListView というコンポーネントを使用しています．



図1
サンプルの例

TurboPower Abbrevia には多くのサンプルが添付されいますが，プロジェクトのソースコードにリソースの定義がないプロジェクトがあります．この定義がないと，リソースが作成されず，ランタイムテーマを有効にできません．必要があれば，以下のように追加してください．
コンソールアプリケーションには，このコードは必要ありません．


リスト1
TurboPower Abbrevia に添付のサンプルには，{$R *.res} の記述がないプロジェクトがある		 
program Abbrexam;

uses
  Forms,
  udemodlg in 'udemodlg.pas' {DemoDlg},
  uexample in 'Uexample.pas' {Form1};

{$R *.res}   //追加する

begin
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TDemoDlg, DemoDlg);
  Application.Run;
end.


当サイトには，この他，以下のようなファイルの圧縮・解凍関係のサンプルがあります．これらの記事中のリンクも参考にしてください．





01_TurboPower Abbrevia のインストール


インストールの手順は，TurboPower Abbrevia に添付の Readme.html にも書いてあります．
  • (1) 下の参考リンクの SourceForge.net から TurboPower Abbrevia をダウンロードする
  • (2) ダウンロードしたファイルを任意のフォルダ内に解凍・展開する
  • (3) Delphi の IDE を起動して，[source] フォルダにライブラリのパスを通す
  • (4) 3 つのパッケージをコンパイルして AbbreviaVCLDesignXXX.bpl をインストールする
    XXX の部分は Delphi のバージョンによって異なる
Readme.html にはコンパイル済みパッケージファイル (拡張子は .bpl) の出力先のバスを確認するように書いてありますが，Delphi をインストールした時のデフォルトの設定のままであれば問題ないと思われます．出力先をカスタマイズしている場合は確認した方がいいでしょう．

[packages] フォルダ内に Delphi のバージョンごとにプロジェクトグループのプロジェクトが用意されています．これが利用できます．
今回は Delphi XE ですので，下図のように，[packages] の中の [Delphi XE.groupproj を IDE で開きました．管理者権限で起動可能な Delphi のショートカットを作成していれば，そのショートカットにドラッグ & ドロップして起動できます．



[備考]
2 番目のリンクから tpabbrevia_docs.zip をダウンロードすると，PDF 文書と .HLP 形式のヘルプファイルがあります．



図2
プロジェクトグループを IDE で開く
  • Delphi 7 のパッケージもあるが，インストールできない

3 つのプロジェクトを全てビルドまたはコンパイルします．パッケージ名 (プロジェクト名) を選択して，ポップアップメニューを表示し，[ビルド] または [コンパイル] を選択します．
次に AbbreviaVCLDesign150.bpl をインストールします．これも，AbbreviaVCLDesign150.bpl を選択して，ポップアップメニューを表示して，[インストール] を選択すればインストールできます．



図3
プロジェクトグループの構成
  • ポップアップメニューから以下をビルドまたはコンパイル
    Abbrevia150.bpl
    AbbreviaVCL150L.bpl
    AbbreviaVCLDesign150.bpl
  • AbbreviaVCLDesign150.bpl (赤枠) をインストールする
  • 操作対象は選択中のプロジェクトだけであることに注意
    反転表示が選択中を意味する

このコンポーネントのように，複数のプロジェクトがある場合，下図のように，一番上のプロジェクトのメニューから [ここから下...] を実行すれば，その下のプロジェクトを同時にコンパイル，あるいはビルドできます．



図4
プロジェクトを全てコンパイルまたはビルドする

インストールはすぐに終了します．すると下図のような確認のダイアログが現れます．
[OK] ボタンをクリックしてダイアログを閉じたら，また各々のプロジェクト名を選択して，同じくポップアップメニューから [上書き保存] を選択して保存します．保存したら IDE を閉じます．



図5
インストール成功
図6
保存を忘れた場合
  • IDE を閉じる時に確認のダイアログが現れる
  • もちろん保存する

インストールの結果，下図のようにコンポーネントパレットにコンポーネント類が登録されます．
一部のコンポーネントアイコンが正しく表示されていませんが，気にしないことにします．
これらのコンポーネント以外にも，アーカイブに対する詳細な操作を可能にする，低レベルでの操作用のクラスが実装されています．



図7
コンポーネント類
図8
コンポーネント一覧




02_TAbZipper を使用したファイルの圧縮・書庫作成


TurboPower Abbrevia の TAbZipper コンポーネントを使用して，指定フォルダ内のファイルを全てアーカイブまたは圧縮するサンプルです．
書庫は EXE があるフォルダ階層下の [Temp] というフォルダに保存するようにしています．

.tgz, tbz2, tar.gz は直接作成できません．そこで，まず，指定フォルダ内の全てのファイルを格納した TAR 形式の書庫ファイルを作成します．その書庫ファイルを GZ (GZip) または BZ2 (BZip2) 形式で圧縮するようにしています．
この手法は，[JEDI プロジェクトを使用したファイルの圧縮・書庫作成] でも使用していますが，JEDI の方は，アーカイブのルーチンを再帰的に実行しています．一方，本サンプルでは，TAR 書庫ファイル作成に続けて圧縮の処理コードを書いています．



[備考]
TurboPower Abbrevia には専用の TAbProgressBar コンポーネントがありますが，本ページのサンプルでは使用していません．TAbProgressBar を使用する場合は，TAbZipper.ArchiveProgressMeter プロパティ等にこのプログレスバーを指定します．イベントの設定は必要ありません．
TAbMeter という，進捗状態の表示用コンポーネントもありますが，デザインが違います．



図9
設計時画面
図10
同じフォルダ内のファイルを異なる書庫形式でアーカイブした結果の例


リスト2
TurboPower Abbrevia の TAbZipper コンポーネントを使用したファイルの圧縮・書庫作成		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, AbBase, AbBrowse, AbZBrows, AbZipper,
  AbArcTyp;

type
  TForm1 = class(TForm)
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    AbZipper1: TAbZipper;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AbZipper1ArchiveItemProgress(Sender: TObject;
      Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);
    procedure AbZipper1ArchiveProgress(Sender: TObject; Progress: Byte;
      var Abort: Boolean);
  private
    { Private 宣言 }
    function CompressSaveArchive(Zipper: TAbZipper; SourcePath, ArchiveName,
      Password: String): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl, IOUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RadioGroup1.ItemIndex := 0;
end;

//=============================================================================
//  圧縮(書庫作成)
//  選択したフォルダ内の全てのファイルを格納した書庫を作成
//  書庫の作成先はプロジェクトフォルダ内の[Temp]フォルダ内
//  書庫ファイル名は元のフォルダ名に書庫形式の拡張子を付加
//
//  SelectDirectoryの使用にはusesにFileCtrlが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LArchiveFileName : String;
  LSoureDir        : String;
  LOutBaseDir      : String;
  LResult          : Boolean;
begin
  LSoureDir := ExtractFileDir(Application.ExeName);
  if not SelectDirectory('フォルダ選択', '', LSoureDir, [sdNewUI], Self) then exit;


  //作成する書庫名のフルパス
  LOutBaseDir := ExtractFilePath(Application.ExeName) + 'Temp';
  LArchiveFileName := IncludeTrailingPathDelimiter(LOutBaseDir)
                    + ExtractFileName(LSoureDir)
                    + Trim(RadioGroup1.Items[RadioGroup1.ItemIndex]);


  Screen.Cursor := crHourGlass;
  ProgressBar1.Position := 0;

  //書庫作成用のルーチンを実行
  LResult :=  CompressSaveArchive(AbZipper1, LSoureDir, LArchiveFileName, '');

  Screen.Cursor := crDefault;
  ProgressBar1.Position := 100;

  if LResult = False then begin
    MessageBox(Handle, '書庫作成失敗', '結果', MB_ICONSTOP);
  end;
end;

//-----------------------------------------------------------------------------
//  書庫作成用のルーチン
//
//  Zipper      : TAbZippeのインスタンス
//  SourcePath  : 圧縮対象のファイルのフルパス
//  ArchiveName : 圧縮後のファイル名
//  Password    : パスワード
//
//  TFileの使用にはusesにIOUtilsが必要
//-----------------------------------------------------------------------------
function TForm1.CompressSaveArchive(Zipper: TAbZipper; SourcePath,
  ArchiveName, Password: String): Boolean;
var
  LFileName     : TFileName;
  LSaveFileName : string;
  LFileExtTar   : String;
  LFileExt      : string;
  LSourcePath   : string;
  LArchiveName  : String;
begin
  Result := True;

  LArchiveName := ArchiveName;
  LSourcePath  := IncludeTrailingPathDelimiter(SourcePath);
  LFileExt     := ExtractFileExt(LArchiveName);
  LFileExtTar  := '';

  //作成した書庫ファイルの保存先のフォルダを作成
  SysUtils.ForceDirectories(ExtractFileDir(LArchiveName));

  //同名の書庫があった場合は削除
  if TFile.Exists(LArchiveName) then begin
    TFile.Delete(LArchiveName);
  end;


  //作成するのが.TAR.GZ, TGZ, TBZ2かを調べる
  //LFileExtTarが空文字のままなら.TAR.GZ, TGZ, TBZ2ではない
  LFileExtTar := ExtractFileExt(ChangeFileExt(LArchiveName, ''));
  if UpperCase(LFileExtTar) = '.TAR' then begin
    LArchiveName := ChangeFileExt(ChangeFileExt(LArchiveName, ''), LFileExtTar);
    LFileExtTar  := LFileExtTar + LFileExt;
  end else
  if Pos('.T', UpperCase(LFileExt)) > 0 then begin
    if Pos('Z', UpperCase(LFileExt)) > 0 then begin
      LFileExtTar  := LFileExt;
      LArchiveName := ChangeFileExt(LArchiveName, '.tar');
    end;
  end else begin
    LFileExtTar := '';
  end;

  //--------------------------------------------------------------------------
  //  以下のコードはZIP書庫とTAR書庫の作成用
  //---------------------------------------------------------------------------
  try
    Zipper.TempDirectory := TPath.GetTempPath;
    Zipper.BaseDirectory := LSourcePath;
    Zipper.FileName      := LArchiveName;
    Zipper.Password      := AnsiString(Password);
    Zipper.AutoSave      := False;
    Zipper.DOSMode       := False;

    for LFileName in TDirectory.GetFiles(
       LSourcePath, '*.*', TSearchOption.soAllDirectories) do begin

       //書庫内に対象のディレクトリ名のディレクトリを作成しない場合
       //作成してもいいのであればこのコードは不要
       //その場合はZipper.AddFilesの引数にLFileNameを渡す
      LSaveFileName := StringReplace(LFileName, LSourcePath, '', [rfIgnoreCase]);
      Zipper.AddFiles(LSaveFileName, 0);
    end;
    Zipper.Save;
    Zipper.CloseArchive;
  except
    Result := False;
  end;
  //---------------------------------------------------------------------------
  //  ZIP書庫またはTAR書庫の作成終了
  //---------------------------------------------------------------------------
  if Result = False then exit;


  //--------------------------------------------------------------------------
  //  以下のコードはGZ, BZ2の単一圧縮ファイル作成用
  //  .TAR.GZ, TGZ, TBZ書庫作成の時はこの処理を実行する
  //  上のアーカイブ作成コードで.TARの書庫が出来ている．それを圧縮する
  //--------------------------------------------------------------------------
  if LFileExtTar <> '' then begin
    LSourcePath  := LArchiveName;
    if Pos('.TAR.', UpperCase(LFileExtTar)) > 0 then begin
      LArchiveName := ChangeFileExt(LArchiveName, LFileExt);
    end else begin
      LFileExt     := StringReplace(LFileExt, '.T', '.', [rfIgnoreCase]);
      LArchiveName := ChangeFileExt(LArchiveName, LFileExt);
    end;

    try
      Zipper.BaseDirectory := ExtractFileDir(LSourcePath);
      Zipper.FileName      := LArchiveName;
      Zipper.Password      := AnsiString(Password);
      Zipper.AddFiles(ExtractFileName(LSourcePath), 0);
      Zipper.Save;
      Zipper.CloseArchive;
    except
      Result := False;
    end;

    //作成した書庫の名前を本来の書庫形式の拡張子に変更する
    if TFile.Exists(LArchiveName) then begin
      TFile.Move(LArchiveName, ChangeFileExt(LArchiveName, LFileExtTar));
    end;
    //作成したTARファイルは削除
    TFile.Delete(LSourcePath);
  end;
end;

//=============================================================================
//  TAbZippeのOnArchiveProgressイベント
//  Progressの最大値は100
//  AbortをTrueにすると強制終了する
//=============================================================================
procedure TForm1.AbZipper1ArchiveProgress(Sender: TObject; Progress: Byte;
  var Abort: Boolean);
begin
  ProgressBar1.Position := Progress;
end;

//=============================================================================
//  TAbZippeのOnArchiveItemProgressイベント
//  Progressの最大値は100
//
//  書庫作成時にItemで格納するファイルの情報が取得できる
//  Progressの最大値は100
//
//  このイベントを使用するにはusesにAbArcTypが必要
//=============================================================================
procedure TForm1.AbZipper1ArchiveItemProgress(Sender: TObject;
  Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);
begin
//
end;

end.



03_TAbZipper を使用した単一ファイルの圧縮  -  GZip・BZip2


GZ (GZip) と BZ2 (BZip2) は，単一ファイルの圧縮の書庫形式です．
TAbZipper コンポーネントを使用して，これらの書庫を作成するサンプルです．上のサンプルの該当処理部分だけをサンプルにしたものです．
書庫は EXE があるフォルダ階層下の [Temp] というフォルダに保存するようにしています．
BZ2 (BZip2) は圧縮率が高いのですが，処理に時間がかかるようです．



図11
設計時画面
図12
約 10 MB のテキストファイルを圧縮した結果


リスト3
TurboPower Abbrevia の TAbZipper コンポーネントを使用した単一ファイルの圧縮		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, AbBase, AbBrowse, AbZBrows, AbZipper;

type
  TForm1 = class(TForm)
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    OpenDialog1: TOpenDialog;
    AbZipper1: TAbZipper;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AbZipper1ArchiveProgress(Sender: TObject; Progress: Byte;
      var Abort: Boolean);
  private
    { Private 宣言 }
    function CompressSaveArchive(Zipper: TAbZipper; SourcePath, ArchiveName,
      Password: String): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  IOUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RadioGroup1.ItemIndex := 0;
end;

//=============================================================================
//  選択したファイルの圧縮
//  書庫の作成先は，プロジェクトフォルダ内の[Temp]フォルダ内
//  圧縮後のファイル名は元のファイル名に拡張子を付加
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LArchiveFileName : String;
  LSouceFileName   : String;
  LOutBaseDir      : String;
  LResult          : Boolean;
begin
  if not OpenDialog1.Execute then exit;


  //圧縮対象のファイル名
  LSouceFileName := OpenDialog1.FileName;

  //圧縮後のファイルのフルパス名を設定
  LOutBaseDir := ExtractFilePath(Application.ExeName) + 'Temp';
  LArchiveFileName := IncludeTrailingPathDelimiter(LOutBaseDir)
                    + ExtractFileName(LSouceFileName)
                    + Trim(RadioGroup1.Items[RadioGroup1.ItemIndex]);

  Screen.Cursor := crHourGlass;
  ProgressBar1.Position := 0;

  //圧縮ファイル作成用のルーチンを実行
  LResult :=  CompressSaveArchive(AbZipper1, LSouceFileName, LArchiveFileName, '');

  Screen.Cursor := crDefault;
  ProgressBar1.Position := 100;

  if LResult = False then begin
    MessageBox(Handle, '圧縮失敗', '結果', MB_ICONSTOP);
  end;
end;

//-----------------------------------------------------------------------------
//  圧縮ファイル作成用のルーチン
//
//  Zipper      : TAbZippeのインスタンス
//  SourcePath  : 圧縮対象のファイルの振るパス
//  ArchiveName : 圧縮後のファイル名
//  Password    : パスワード
//
//  TurboPower Abbreviaがサポートしている単一ファイルの圧縮形式
//  GZ   (Gzip)
//  BZ2  (Bzip2)
//
//  TFileの使用にはusesにIOUtilsが必要
//-----------------------------------------------------------------------------
function TForm1.CompressSaveArchive(Zipper: TAbZipper; SourcePath,
  ArchiveName, Password: String): Boolean;
begin
  Result := True;

  //作成したファイルを保存するフォルダを作成
  SysUtils.ForceDirectories(ExtractFileDir(ArchiveName));

  //同名の書庫があった場合は削除
  if TFile.Exists(ArchiveName) then begin
    TFile.Delete(ArchiveName);
  end;

  try
    Zipper.BaseDirectory := ExtractFileDir(ExcludeTrailingPathDelimiter(SourcePath));
    Zipper.Password      := AnsiString(Password);
    Zipper.FileName      := ArchiveName;
    Zipper.AddFiles(ExtractFileName(SourcePath), 0);
    Zipper.Save;
    Zipper.CloseArchive;
  except
    Result := False;
  end;
end;

//=============================================================================
//  TAbZippeのOnArchiveProgressイベント
//  Progressの最大値は100
//  AbortをTrueにすると強制終了する
//=============================================================================
procedure TForm1.AbZipper1ArchiveProgress(Sender: TObject; Progress: Byte;
  var Abort: Boolean);
begin
  ProgressBar1.Position := Progress;
end;

end.



04_TAbUnZipper を使用したファイルの解凍・書庫展開


TAbUnZipper コンポーネントを使用して，書庫の解凍・展開をするサンプルです．
解凍・展開したファイルは，EXE があるフォルダの階層下の [Temp] フォルダ内としています．

本サンプルには，.tgz, tbz2, tar.gz の解凍・展開の処理コードはありません．
.tgz, tbz2, tar.gz は，ArchiveType を指定すれば解凍はできますが，TAR 書庫の展開まではしてくれません．TAR 書庫も同時に展開するのであれば，本ページの最初のサンプルと逆の操作を実行することになります．
まず，GZ (GZip) または BZ2 (BZip2) を解凍して，TAR 形式の書庫を取り出します．その TAR 書庫を展開することになります．
.tar.gz または tar.bz2 であれば，本サンプルの EXE を 2 回実行すれば解凍・展開できます．最初の実行で解凍すると TAR 書庫が取り出せます．その TAR 書庫を展開します．



図13
設計時画面
図14
test.zip を展開した結果


リスト4
TurboPower Abbrevia の TAbUnZipper コンポーネントを使用したファイルの解凍・展開		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, AbBase, AbBrowse, AbZBrows, AbUnzper,
  AbArcTyp;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    AbUnZipper1: TAbUnZipper;
    procedure Button1Click(Sender: TObject);
    procedure AbUnZipper1ArchiveItemProgress(Sender: TObject;
      Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);
    procedure AbUnZipper1ArchiveProgress(Sender: TObject; Progress: Byte;
      var Abort: Boolean);
  private
    { Private 宣言 }
    function ExtractArchive(UnZipper: TAbUnZipper; ArchiveFileName, DestDir,
      Password: String): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  IOUtils, AbUtils;

{$R *.dfm}

//=============================================================================
//  選択した書庫ファイルを解凍または展開
//  書庫の作成先は，プロジェクトフォルダ階層下の[Temp]フォルダ内
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBaseDir         : String;
  LArchiveFileName : string;
  LDestDirectory   : string;
  LResult          : Boolean;
begin
  OpenDialog1.Filter := '|*.gz;*.bz2;*.tar;*.zip|';
  if not OpenDialog1.Execute then exit;


  //解凍または展開対象のアーカイブ名
  LArchiveFileName := OpenDialog1.FileName;

  //解凍または展開先のフォルダ
  LBaseDir       := ExtractFilePath(Application.ExeName) + 'Temp';
  LDestDirectory := IncludeTrailingPathDelimiter(LBaseDir)
                  + ExtractFileName(ChangeFileExt(LArchiveFileName, '')) ;

  Screen.Cursor := crHourGlass;
  ProgressBar1.Position := 0;

  //解凍・展開用のルーチンを実行
  LResult := ExtractArchive(AbUnZipper1, LArchiveFileName, LDestDirectory, ' ');

  Screen.Cursor := crDefault;
  ProgressBar1.Position := 100;

  if LResult = False then begin
    MessageBox(Handle, '書庫展開・解凍失敗', '結果', MB_ICONSTOP);
  end;
end;

//-----------------------------------------------------------------------------
//  解凍・展開用のルーチン
//
//  UnZipper        : TAbUnZippeのインスタンス
//  ArchiveFileName : 解凍または展開する書庫ファイルのフルパス名
//  DestDir         : 解凍または展開したファイルを格納するディレクトリ名
//  Password        : パスワード
//
//  TDirectoryの使用にはusesにIOUtilsが必要
//  eoCreateDirs, eoRestorePath等の使用にはusesにAbArcTypが必要
//  atGzip, atBzip2, atTar等の使用にはusesにAbUtilsが必要
//-----------------------------------------------------------------------------
function TForm1.ExtractArchive(UnZipper: TAbUnZipper; ArchiveFileName, DestDir,
  Password: String): Boolean;
var
  LArchiveName : String;
  LDestDir     : String;
  LFileExt     : String;
begin
  Result := True;

  LArchiveName := ArchiveFileName;
  LDestDir     := DestDir;
  LFileExt     := UpperCase(ExtractFileExt(LArchiveName));

  //出力先のディレクトリを作成
  TDirectory.CreateDirectory(LDestDir);

  try
    if LFileExt = '.ZIP' then begin
      UnZipper.TempDirectory  := TPath.GetTempPath;
      UnZipper.BaseDirectory  := LDestDir;
      UnZipper.ExtractOptions := [eoCreateDirs, eoRestorePath];
      UnZipper.FileName       := LArchiveName;
      UnZipper.Password       := AnsiString(Password);
    end else begin
      UnZipper.TempDirectory := TPath.GetTempPath;
      UnZipper.BaseDirectory := LDestDir;
      UnZipper.Password      := AnsiString(Password);
      UnZipper.ForceType     := True;

      //書庫の形式を指定しないと失敗する
      //FileNameはArchiveTypeの後に設定しないと展開に失敗する場合がある
      if LFileExt = '.GZ' then begin
        UnZipper.ArchiveType := atGzip;
        UnZipper.FileName    := LArchiveName;
      end else
      if LFileExt = '.BZ2' then begin
        UnZipper.ArchiveType := atBzip2;
        UnZipper.FileName    := LArchiveName;
      end else
      if LFileExt = '.TAR' then begin
        UnZipper.ArchiveType    := atTar;
        UnZipper.FileName       := LArchiveName;
        UnZipper.ExtractOptions := [eoCreateDirs, eoRestorePath];
      end;
    end;

    //実際の展開または解凍
    UnZipper.ExtractFiles('*.*');
  except
    Result := False;
  end;
end;

//=============================================================================
//  TAbUnZippeのOnArchiveProgressイベント
//  Progressの最大値は100
//  AbortをTrueにすると強制終了する
//=============================================================================
procedure TForm1.AbUnZipper1ArchiveProgress(Sender: TObject; Progress: Byte;
  var Abort: Boolean);
begin
  ProgressBar1.Position := Progress;
end;

//=============================================================================
//  TAbUnZippeのOnArchiveItemProgressイベント
//  Progressの最大値は100
//
//  書庫の解凍・展開時にItemで格納するファイルの情報が取得できる
//  Progressの最大値は100
//
//  このイベントを使用するにはusesにAbArcTypが必要
//=============================================================================
procedure TForm1.AbUnZipper1ArchiveItemProgress(Sender: TObject;
  Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);
begin
//
end;

end.