Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年05月11日] [更新 2015年04月11日] Delphi サンプルプログラム集
   
732_7-zip32.dll を使用したファイルの圧縮・解凍
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + 7-zip32.dll 9.22.1
732_Archiver7-ZIP32.zip [3,662 KB] 2015年04月11日版(EXE同梱)



  • 2015年04月11日
  • 圧縮,解凍,自己解凍書庫作成を別々のサンプルにした
  • 自己解凍書庫の説明を詳しくした




7-zip32.dll を使用したファイルの圧縮・解凍


[総合アーカイバプロジェクト] として提供されている 7-zip32.dll を使用した zip, 7-zip ファイルの圧縮・解凍のテストプログラムです.
7-zip 圧縮ファイルの拡張子は,.7z または .7zip です.DLL は統合アーカイバプロジェクトからダウンロードしたものを使用しています.この DLL の関数類を Delphi から利用するためのユニットを作成しました.本ページのサンプルプログラムでは,このユニットをプロジェクトに追加して使用しています.

DLL を EXE があるフォルダ内に置いてテストしてください.DLL を 他のアプリで使用しなければシステムに登録する必要はありません.
コード内の DLL のコマンドラインスイッチの説明は,DLL に説明書が添付されています.

[総合アーカイバプロジェクト] の 7-zip32.dll は,[744_JEDI プロジェクトを使用したファイルの圧縮・解凍] で使用している本家の 7z.dll の機能全てを持っているわけではありません.



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






01_7-zip32.dll を使用したフォルダ内の圧縮


指定したフォルダ内のフォルダ,ファイルを全て圧縮した書庫を作成する例です.
作成した書庫は,EXE があるフォルダ内に [Temp] という名前のフォルダを自動で作成し,その中に圧縮対象のフォルダ名と同じで保存するようにしています.

作成する圧縮ファイルの拡張子を .zip にして圧縮すれば ZIP 書庫,.7z にして圧縮すれば 7ZIP 書庫の作成となります.



図1
設計時画面
図2
圧縮実行中
  • メッセージ処理でプログレスバー表示
  • Memo1 の表示は前の実行結果
  • 圧縮中に,処理中のファイル名を表示したい場合は,メッセージ処理する
図3
圧縮実行後
  • EXE があるフォルダ内に [Temp] フォルダを自動作成して,その中に,圧縮対象のフォルダ名と同じ名前の書庫を作成
図4
DLL のバージョン情報

リスト1
7-zip32.dll を使用したフォルダ内の圧縮
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls , plArchiever7ZIP, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    RadioGroup1: TRadioGroup;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  ZIPまたは7-zip書庫形式で指定フォルダ下のファイルを圧縮
//
//  TplArchiever7ZIPのPackFilesメソッドは2種類あり,こちらは圧縮するファイル
//  (第1引数)をディレクトリ名またはファイル名を1つだけ渡すメソッド
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcDir    : String;
  LDestFile  : String;
  LArch      : TplArchiever7ZIP;
  LFileDlg   : TFileOpenDialog;
  LRetFlag   : Boolean;
  LResultMsg : String;
begin
  LRetFlag := False;

  if CheckWin32Version(6, 0) then begin
    LFileDlg := TFileOpenDialog.Create(nil);
    try
      LFileDlg.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
      LFileDlg.DefaultFolder := LSrcDir;
      if LFileDlg.Execute then begin
        Update;
        LSrcDir := LFileDlg.FileName;
        LRetFlag := True;
      end;
    finally
      FreeAndNil(LFileDlg);
    end;
  end else begin
    //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', LSrcDir, [sdNewUI])
    //でダイアログを表示すると,指定したフォルダ位置までスクロールしてくれない
    if FileCtrl.SelectDirectory('フォルダ指定', '', LSrcDir, []) then begin
      Update;
      LRetFlag := True;
    end;
  end;


  if LRetFlag then begin
    LArch := TplArchiever7ZIP.Create(Self);
    try
      //圧縮後のファイル名(フルパス)
      //このEXEのフォルダ直下のTempフォルダ内とする
      //そのフォルダ内に元のフォルダの名前で保存する
      LDestFile := ExtractFilePath(Application.ExeName) + 'Temp\';
      LDestFile := LDestFile + ChangeFileExt(ExtractFileName(LSrcDir),
                                 Trim(RadioGroup1.Items[RadioGroup1.ItemIndex]));

      //圧縮
      //PackFilesメソッドはフォルダがないと自動作成するので注意
      LArch.PackFiles(LSrcDir, LDestFile, LResultMsg);
    finally
      FreeAndNil(LArch);
    end;

    //結果を表示(7-zip32.dllからのメッセージ)
    Memo1.Clear;
    Memo1.Text := LResultMsg;
  end;
end;

//=============================================================================
//  7-zip32.DLLのバージョン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LArch : TplArchiever7ZIP;
begin
  LArch := TplArchiever7ZIP.Create(Self);
  try
    MessageBox(Handle, PChar(LArch.GetVersion), '情報', MB_ICONINFORMATION);
  finally
    FreeAndNil(LArch);
  end;
end;

//-----------------------------------------------------------------------------
//  TForm1のWndProcメソッド
//  WndProcメソッドは当サイトの他のサンプルまたはDelphiのヘルプ参照
//  7-zip32.DLLからのメッセージ処理
//  圧縮または解凍作業中に送信してくるWM_ARCEXTRACTメッセージを処理
//
//  WParam  進行状況を表すメッセージ値(本コードの先頭部参照)
//  LParam  EXTRACTINGINFO構造体のポインタ
//          圧縮または解凍中のファイルの情報が格納されているレコード型
//-----------------------------------------------------------------------------
procedure TForm1.WndProc(var Message: TMessage);
var
  LState :  UINT;
  LlpEis :  LPExtractingInfo;
begin
  inherited;

  if Message.Msg = WM_ARCEXTRACT then begin
    LState := Message.wParam;
    LlpEis := LPExtractingInfo(Message.lParam);

    if LState = ARCEXTRACT_OPEN then begin
      ProgressBar1.Position := 0;
    end else
    if LState = ARCEXTRACT_INPROCESS then  begin
      ProgressBar1.Position := Trunc(LlpEis.dwWriteSize / LlpEis.dwFileSize * 100);
    end;

    //処理継続(Message.Result := 1とすれば処理中止)
    Message.Result := 0;
  end;
end;

end.




02_7-zip32.dll を使用したフォルダと複数ファイルの圧縮


エクスプローラで選択したフォルダとファイルを,ドラッグ & ドロップで圧縮します.
ドロップしたファイル類は,TStringList の配列に,そのフルパス名を格納します.その TStringList を圧縮用のメソッドの引数に渡して圧縮します.
圧縮後のファイルは,EXE があるフォルダ内に [Temp] という名前のフォルダを自動で作成して,その中に保存します.書庫の名前はコード内で設定しています.

作成する圧縮ファイルの拡張子を .zip にして圧縮すれば ZIP 書庫,.7z にして圧縮すれば 7ZIP 書庫の作成となりますが,本サンプルでは ZIP に固定しています.



図5
設計時画面
図6
圧縮するファイル類の指定
  • エクスプローラから,選択したフォルダとファイルをドラッグしてドロップ
  • 上部の Panel1 以外ではドロップを受け付けない
図7
圧縮終了
  • メッセージ処理でプログレスバー表示
  • Memo1 の表示は前の実行結果
  • 圧縮中に,処理中のファイル名を表示したい場合は,メッセージで処理する
図8
作成した書庫
  • EXE があるフォルダ内に [Temp] フォルダを自動作成して,その中に保存
  • 書庫名はコード内で設定している

リスト2
7-zip32.dll を使用したフォルダと複数ファイルの圧縮
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls , plArchiever7ZIP, ExtCtrls, ComCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    ApplicationEvents1: TApplicationEvents;
    procedure Button1Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
    FFileList : TStringList;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  ShellAPI;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  DragAcceptFilesの使用にはusesにShellAPIが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileList := TStringList.Create;
  Button1.Visible := False;

  //Panel1へのドラッグアンドドロップを許可
  //対象コントロールはPanel1のみ
  DragAcceptFiles(Panel1.Handle, True);
  Panel1.Caption := 'エクスプローラからドロップ';
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileList);
end;

//=============================================================================
//  ZIP書庫形式で圧縮
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBaseDir   : String;
  LDestFile  : String;
  LArch      : TplArchiever7ZIP;
  LResultMsg : String;
begin
  if FFileList.Count = 0 then exit;

  //圧縮後のファイル名(フルパス)
  //このEXEのTempというファイル内のTestArch.zipとする
  LBaseDir  := ExtractFilePath(Application.ExeName) + 'Temp\';
  LDestFile := LBaseDir + 'TestArch.zip';

  LArch := TplArchiever7ZIP.Create(Self);
  try
    //圧縮
    //FFileListに圧縮するファイル名が格納されている
    //PackFilesメソッドはフォルダがないと自動作成するので注意
    LArch.PackFiles(FFileList, LDestFile, LResultMsg);
  finally
    FreeAndNil(LArch);
  end;

  //結果を表示(7-zip32.dllからのメッセージ)
  Memo1.Clear;
  Memo1.Text := LResultMsg;
end;

//-----------------------------------------------------------------------------
//  TForm1のWndProcメソッド
//  WndProcメソッドは当サイトの他のサンプルまたはDelphiのヘルプ参照
//  7-zip32.DLLからのメッセージ処理
//  圧縮または解凍作業中に送信してくるWM_ARCEXTRACTメッセージを処理
//
//  WParam  進行状況を表すメッセージ値(本コードの先頭部参照)
//  LParam  EXTRACTINGINFO構造体のポインタ
//          圧縮または解凍中のファイルの情報が格納されているレコード型
//-----------------------------------------------------------------------------
procedure TForm1.WndProc(var Message: TMessage);
var
  LState :  UINT;
  LlpEis :  LPExtractingInfo;
begin
  inherited;

  if Message.Msg = WM_ARCEXTRACT then begin
    LState := Message.wParam;
    LlpEis := LPExtractingInfo(Message.lParam);

    if LState = ARCEXTRACT_OPEN then begin
      ProgressBar1.Position := 0;
    end else
    if LState = ARCEXTRACT_INPROCESS then  begin
      ProgressBar1.Position := Trunc(LlpEis.dwWriteSize / LlpEis.dwFileSize * 100);
    end;

    //処理継続(Message.Result := 1とすれば処理中止)
    Message.Result := 0;
  end;
end;

//=============================================================================
//  TApplicationEventsのOnMessageイベント処理
//  エクスプローラからのファイルのドラッグ・ドロップ処理
//
//  FFileListにファイル名とフォルダ名を格納していく
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  LCount    : Integer;
  LBuffer   : array [0..MAX_PATH-1] of char;
  LFilePath : String;
  i         : Integer;
begin
  if Msg.message = WM_DROPFILES then begin
    //ドラッグドロップしたファイル数を取得
    LCount := DragQueryFile(Msg.wParam, High(Cardinal), nil, 0);
    FFileList.Clear;
    for i := 0 to LCount - 1 do begin
      //ドラッグドロップしたファイル名を取得
      DragQueryFile(Msg.WParam, i, LBuffer, MAX_PATH);
      LFilePath  := LBuffer;
      FFileList.Add(LFilePath);
    end;
    //圧縮を実行
    Button1Click(nil);
    //ドロップが完了したことを伝える
    DragFinish(msg.wParam);
  end;
end;

end.




03_7-zip32.dll を使用した書庫ファイルの解凍


指定した ZIP または 7ZIP 形式の書庫を解凍するサンプルです.
Windows XP では LZH 形式の書庫も解凍できますが,筆者の Windows 7 の環境では,LZH 書庫の解凍はできませんでした.
EXE があるフォルダ内に,[Temp] という名前のフォルダを自動で作成して,更に,その中に,書庫名と同じ名前のフォルダを作成して,そこに解凍したファイルを保存するようにしています.


図9
設計時画面
図10
解凍終了
  • メッセージ処理でプログレスバー表示
  • Memo1 の表示は前の実行結果
  • 解凍中に,処理中のファイル名を表示したい場合は,メッセージ処理する
図11
解凍結果の例
  • EXE があるフォルダ内に [Temp] フォルダを自動作成して,その中に,書庫名と同じ名前のフォルダを作成して,その中に解凍

リスト3
7-zip32.dll を使用した ZIP 書庫または 7ZIP 書庫ファイルの解凍
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls , plArchiever7ZIP, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  ZIP,LZH,7-zip形式の書庫を解凍
//
//  解凍先のディレクトリがない場合は自動作成するので注意
//  テストは,前に解凍したファイルを全て削除してから実行した方がいいだろう
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LArch      : TplArchiever7ZIP;
  LSrcFile   : String;
  LDestDir   : String;
  LResultMsg : string;
begin
  //解凍対象の書庫ファイルを選択
  OpenDialog1.InitialDir := ExtractFileDir(ParamStr(0));
  OpenDialog1.DefaultExt := 'ZIP';
  OpenDialog1.Filter     := 'ZIP書庫ファイル|*.ZIP' +
                            '|7-zip書庫ファイル|*.7z;*.7zip' +
                            '|LZH書庫ファイル|*.LZH' +
                            '|全てのファイル|*.LZH;*.ZIP;*.7z;*7zip';
  OpenDialog1.FileName := '';

  if not OpenDialog1.Execute then exit;

  LArch := TplArchiever7ZIP.Create(Self);
  try
    LSrcFile := OpenDialog1.FileName;
    //解凍したファイルの保存先フォルダの設定
    LDestDir := ExtractFilePath(Application.ExeName)+ 'Temp\';
    LDestDir := LDestDir + ChangeFileExt(ExtractFileName(LSrcFile), '');

    //解凍
    LArch.UnPackFiles(LSrcFile, LDestDir, LResultMsg);
  finally
    FreeAndNil(LArch);
  end;

  //結果を表示(7-zip32.dllからのメッセージ)
  Memo1.Clear;
  Memo1.Text := LResultMsg;
end;

//-----------------------------------------------------------------------------
//  TForm1のWndProcメソッド
//  WndProcメソッドは当サイトの他のサンプルまたはDelphiのヘルプ参照
//  7-zip32.DLLからのメッセージ処理
//  圧縮または解凍作業中に送信してくるWM_ARCEXTRACTメッセージを処理
//
//  WParam  進行状況を表すメッセージ値(本コードの先頭部参照)
//  LParam  EXTRACTINGINFO構造体のポインタ
//          圧縮または解凍中のファイルの情報が格納されているレコード型
//-----------------------------------------------------------------------------
procedure TForm1.WndProc(var Message: TMessage);
var
  LState :  UINT;
  LlpEis :  LPExtractingInfo;
begin
  inherited;

  if Message.Msg = WM_ARCEXTRACT then begin
    LState := Message.wParam;
    LlpEis := LPExtractingInfo(Message.lParam);

    if LState = ARCEXTRACT_OPEN then begin
      ProgressBar1.Position := 0;
    end else
    if LState = ARCEXTRACT_INPROCESS then  begin
      ProgressBar1.Position := Trunc(LlpEis.dwWriteSize / LlpEis.dwFileSize * 100);
    end;

    //処理継続(Message.Result := 1とすれば処理中止)
    Message.Result := 0;
  end;
end;

end.




04_7-zip32.dll を使用した自己解凍書庫の作成


自己解凍書庫の作成例です.圧縮時ファイル名の拡張子を .exe にすると,自動的に自己解凍形式の書庫が作成されます.自己解凍書庫は,解凍時に DLL を必要としません.アプリケーションのインストーラの作成等で利用されています.

本サンプルでは,指定したフォルダ内のファイルを全て自己解凍式の書庫とします.
書庫名は SelfTest.exe という名前にしています.ここまでのサンプルと同じく,EXE があるフォルダ内に [Temp] というフォルダを自動で作成し,その中に保存するようにしています.



図12
設計時画面
図13
自己解凍書庫作成の時の設定ダイアログ
  • ここでは [タイトル] と [開始メッセージ] だけを設定している

図14
作成した自動解凍形式の書庫

作成した SelfTest.exe を実行すると,まず,書庫の解凍が行われます.
解凍したファイルは,Windows の一時ディレクトリ (テンポラリディレクトリ) に専用のフォルダが作成され,その中に解凍されます.解凍が終了すると,解凍したファイルの保存先を指定するダイアログを表示します.[解凍] ボタンをクリックすると,SetlTest.exe は終了です.
[プログラム互換性アシスタント] のダイアログが表示されますが,[このプログラムは正しくインストールされました] をクリックします.

Windows の一時ディレクトリに作成されたディレクトリやファイルは,解凍用のメソッドの実行が終了すると自動的に削除されます.



図15
自己解凍書庫を実行
  • 一時ディレクトに解凍中
  • この進捗ダイアログは非表示にできる
図16
解凍が終了するとダイアログを表示
  • [解凍] ボタンをクリックすると,指定のフォルダに解凍 (実際にはコピー)
図17
プログラム互換性アシスタント
  • [このプログラムは正しくインストールされました] をクリック
  • このダイアログは,次項のように,自分で実行ファイルを作成して,アプリケーションマニフェストを組み込んでおけば現れない

リスト4
7-zip32.dll を使用した自己解凍書庫の作成
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls , plArchiever7ZIP, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl;

{$R *.dfm}

//=============================================================================
//  自己解凍書庫の作成
//  TplArchiever7ZIPではPackFilesメソッドの作成ファイルの拡張子をEXEにすると
//  自己解凍書庫を作成するようにしている
//
//  作成時に[SFX設定]ダイアログが表示される
//  実行コマンドを省略すると,解凍時に解凍先設定ダイアログが表示される
//  実行コマンドを指定すると,テンポラリディレクトリに一時解凍後,指定されたフ
//  ァイルの実行終了後に一時ファイルは削除される
//  実行コマンドの省略値はsetup.exe(これが書庫内にあること)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcDir    : String;
  LDestFile  : String;
  LArch      : TplArchiever7ZIP;
  LFileDlg   : TFileOpenDialog;
  LRetFlag   : Boolean;
  LResultMsg : String;
begin
  LRetFlag := False;

  if CheckWin32Version(6, 0) then begin
    LFileDlg := TFileOpenDialog.Create(nil);
    try
      LFileDlg.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
      LFileDlg.DefaultFolder := LSrcDir;
      if LFileDlg.Execute then begin
        Update;
        LSrcDir := LFileDlg.FileName;
        LRetFlag := True;
      end;
    finally
      FreeAndNil(LFileDlg);
    end;
  end else begin
    //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', LSrcDir, [sdNewUI])
    //でダイアログを表示すると,指定したフォルダ位置までスクロールしてくれない
    if FileCtrl.SelectDirectory('フォルダ指定', '', LSrcDir, []) then begin
      Update;
      LRetFlag := True;
    end;
  end;


  if LRetFlag then begin
    LArch := TplArchiever7ZIP.Create(Self);
    try
      //圧縮後のファイル名(フルパス)
      //このEXEのフォルダ直下のTempフォルダ内とする
      //圧縮後のファイルの拡張子をEXEにすると自己解凍式の書庫が作成される
      LDestFile := ExtractFilePath(Application.ExeName) + 'Temp\';
      LDestFile := LDestFile + 'SelfTest.exe';

      //圧縮
      //PackFilesメソッドはフォルダがないと自動作成するので注意
      LArch.PackFiles(LSrcDir, LDestFile, LResultMsg);
    finally
      FreeAndNil(LArch);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  TForm1のWndProcメソッド
//  WndProcメソッドは当サイトの他のサンプルまたはDelphiのヘルプ参照
//  7-zip32.DLLからのメッセージ処理
//  圧縮または解凍作業中に送信してくるWM_ARCEXTRACTメッセージを処理
//
//  WParam  進行状況を表すメッセージ値(本コードの先頭部参照)
//  LParam  EXTRACTINGINFO構造体のポインタ
//          圧縮または解凍中のファイルの情報が格納されているレコード型
//-----------------------------------------------------------------------------
procedure TForm1.WndProc(var Message: TMessage);
var
  LState :  UINT;
  LlpEis :  LPExtractingInfo;
begin
  inherited;

  if Message.Msg = WM_ARCEXTRACT then begin
    LState := Message.wParam;
    LlpEis := LPExtractingInfo(Message.lParam);

    if LState = ARCEXTRACT_OPEN then begin
      ProgressBar1.Position := 0;
    end else
    if LState = ARCEXTRACT_INPROCESS then  begin
      ProgressBar1.Position := Trunc(LlpEis.dwWriteSize / LlpEis.dwFileSize * 100);
    end;

    //処理継続(Message.Result := 1とすれば処理中止)
    Message.Result := 0;
  end;
end;

end.




05_7-zip32.dll を使用した自己解凍書庫の作成 - 実行ファイル指定


上のテストは,[インストーラを作成] とは言っても,指定したフォルダに解凍したファイルを保存するだけでした.
実際のインストーラは,Program Files に保存したり,レジストリへの登録,アプリケーションのショートカットを作成したりするかも知れません.場合によっては,COM の登録,ActiveX や DLL をシステムに登録する作業も必要かも知れません.
そのような場合は,それらの作業を実行するコードを実装したプログラムを別に用意して,それを圧縮するファイルに含めておきます.そして,下図のように,自己伊藤書庫を作成する際のダイアログで,そのプログラムを指定します.


図18
自己解凍書庫作成の時の設定ダイアログ
  • [インストーラを作成] をチェック
  • [実行ファイル名] を入力
    ここでは setup.exe
    このファイルは書庫に格納しておく必要がある

下図は,添付の [TestFolder] フォルダを,上の図の設定で自己解凍書庫を作成して,作成した自己解凍書庫である SelfTest.exe を実行した結果です.
作成した自己解凍書庫を起動すると,解凍の進捗ダイアログが表示されます.その後に書庫内に格納していた setup.exe が実行された結果です.


図19
自動解凍書庫を実行した時の画面
  • これが表示される前に,解凍の進捗ダイアログが表示される

下図は,この [実行ファイル名] に指定したプログラムの設計時の画面とコードです.
このコードは,実際には,Windows の一時ディレクトリ内に解凍したファイルを TFileOpenDialog で指定したフォルダにコピーするだけです.つまり,前項のサンプルと動作は同じです.7-zip32.dll が内部で行う動作を,自前のコードで実行しているだけです.

Windows の一時ディレクトリ内には,解凍したファイルがあります.それらのファイルを操作する必要があるかも知れません.一時ディレクトリ内の,それらのファイルは,本サンプルの場合,setup.exe が終了するまでは存在します.
自分で一時ディレクトリ内にファイル等を作成した場合は,自前で削除しておく必要があります.そうしないと,一時ディレクトリ内に不要なファイル類が残されたままとなります.



[備考]
インストール用のプログラムには,アプリケーションマニフェストを組み込んでおきます.そうすれば [プログラム互換性アシスタント] のダイアログは現れません.



図20
setup.exe の設計時画面

リスト5
自己解凍書庫を作成する際 (圧縮時) に指定する実行ファイルのコード例
unit setupUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  FileCtrl, IOUtils;

{$R *.dfm}

//=============================================================================
//  自己解凍書庫で実行するプログラムに指定するコードの例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcTempDir : String;
  LDestDir    : String;
  LThisFile   : String;
  LFileDlg    : TFileOpenDialog;
  LRetFlag    : Boolean;
begin
  LRetFlag := False;

  //展開先のフォルダの指定
  if CheckWin32Version(6, 0) then begin
    LFileDlg := TFileOpenDialog.Create(nil);
    try
      LFileDlg.Options := [fdoPickFolders, fdoPathMustExist, fdoForceFileSystem];
      if LFileDlg.Execute then begin
        Update;
        LDestDir := LFileDlg.FileName;
        LRetFlag := True;
      end;
    finally
      FreeAndNil(LFileDlg);
    end;
  end else begin
    //Vista以降で FileCtrl.SelectDirectory('フォルダ指定', '', LSrcTempDir, [sdNewUI])
    //でダイアログを表示すると,指定したフォルダ位置までスクロールしてくれない
    if FileCtrl.SelectDirectory('フォルダ指定', '', LDestDir, []) then begin
      Update;
      LRetFlag := True;
    end;
  end;


  if LRetFlag then begin
    //本プログラム実行開始時には,すでに一時ディレクトリに展開したファイルがある
    //それを展開先のフォルダにコピー
    LSrcTempDir := ExtractFileDir(Application.ExeName);
    TDirectory.Copy(LSrcTempDir, LDestDir);

    //コピー先のこのプログラムファイルは削除
    LThisFile := IncludeTrailingPathDelimiter(LDestDir)
               + ExtractFileName(Application.ExeName);
    TFile.Delete(LThisFile);

    //-------------------------------------------------------------------------
    //  ここに各種の処理コードを書く
    //-------------------------------------------------------------------------
  end;
end;

end.




06_圧縮・解凍用のユニット ( クラス )


テストで使用したユニットのコードです.7-zip32.dll の API を使用した圧縮・解凍のみのコードです.他の機能は実装していません.
DLL 内の API に,Windows API の FindFirst,FindNext のような関数や,ファイルの削除・追加の関数があります.これらを使用すれば書庫内のファイルのリストや操作が可能となります.
筆者の Windows 7 U64 では LZH の解凍ができませんでした.

このユニットのように,[統合アーカイバ・プロジェクト] のサイトの [個別ライブラリ] のページにある DLL 関数類を使用して,圧縮・解凍のルーチンを作成することができます.


リスト6
7-zip32.dll を使用した圧縮と解凍用処理ユニット
unit plArchiever7ZIP;

interface

uses
    Windows, Messages, SysUtils, Classes, Controls, Forms;

const
  //外部で使用する定数(EXTRACTINGINFO構造体用)
  FNAME_MAX32 = 513 -1;
  ARCEXTRACT_BEGIN     = 0; //該当ファイルの処理開始
  ARCEXTRACT_INPROCESS = 1; //該当ファイルの展開中
  ARCEXTRACT_END       = 2; //処理終了.関連メモリを開放
  ARCEXTRACT_OPEN      = 3; //該当書庫の処理の開始
  ARCEXTRACT_COPY      = 4; //ワークファイルの書き戻し

//-----------------------------------------------------------------------------
//  進行状況の情報格納用構造体の定義
//  Delphi2009以降の使用を考慮してAnsiCharと明記
//-----------------------------------------------------------------------------
type
  PEXTRACTINGINFO = ^TEXTRACTINGINFO;
  TEXTRACTINGINFO = record
    dwFileSize       : DWORD;                                //全処理合計サイズ
    dwWriteSize      : DWORD;                                //全処理済みサイズ
    szSourceFileName : array [0..FNAME_MAX32-1] of AnsiChar; //処理中のファイル名
    dummy1           : array [0..2] of AnsiChar;             //ダミー
    szDestFileName   : array [0..FNAME_MAX32-1] of AnsiChar; //そのフルパス
    dummy            : array [0..2] of AnsiChar;             //ダミー
  end;
  LPEXTRACTINGINFO = ^TExtractingInfo;

//-----------------------------------------------------------------------------

var
  //このユニットを使用するアプリ側で受取る進行状況用メッセージ定義
  WM_ARCEXTRACT : Cardinal;

type
  TplArchiever7ZIP = class(TComponent)
  private
    FHandle : HWND;
  protected
    FDllHandle : THandle;
    function Execute(Cmd: String; var AMsg: String): Boolean;
    function GetBasePath(PathList: TStrings): String;
  public
    constructor Create( AOwner:TComponent ); override;
    destructor Destroy(); override;
    function PackFiles(SrcPathList: TStrings; DestFile: String; var AMsg: String): 
      Boolean; overload;
    function PackFiles(SrcPath: String; DestFile: String; var AMsg: String): 
      Boolean; overload;
    function UnPackFiles(SrcPath, DestPath: String; var AMsg: String): Boolean;
    function GetVersion: String;
  end;

implementation

{ TplArchiever7ZIP }

type
  TSevenZip                 = function (const hWnd: HWND; szCmdLine: LPCSTR; 
                              szOutPut:LPSTR;constdwSize: DWORD):Integer;stdcall;
  TSevenZipGetVersin        = function : WORD; stdcall;
  TSevenZipGetSubVersin     = function : WORD; stdcall;
  TSevenZipSetOwnerWindow   = function (_hwnd: HWND): BOOL; stdcall;
  TSevenZipClearOwnerWindow = function : BOOL; stdcall;

var
  FSevenZip                 : TSevenZip;
  FSevenZipGetVersion       : TSevenZipGetVersin;
  FSevenZipGetSubVersion    : TSevenZipGetSubVersin;
  FSevenZipSetOwnerWindow   : TSevenZipSetOwnerWindow;
  FSevenZipClearOwnerWindow : TSevenZipClearOwnerWindow;

const
  BUFF_SIZE = 8192;


//=============================================================================
//  Create処理
//=============================================================================
constructor TplArchiever7ZIP.Create(AOwner: TComponent);
begin
  inherited;

  FDllHandle := LoadLibrary('7-zip32.dll');
  if FDllHandle < HINSTANCE_ERROR then begin
    FDllHandle := 0;
  end else begin
    FHandle := TWinControl(AOwner).Handle;

    if WM_ARCEXTRACT = 0 then
      WM_ARCEXTRACT := RegisterWindowMessage('wm_arcextract');

    @FSevenZip                 := GetProcAddress(FDllHandle, 
                                  'SevenZip');
    @FSevenZipGetVersion       := GetProcAddress(FDllHandle, 
                                  'SevenZipGetVersion');
    @FSevenZipGetSubVersion    := GetProcAddress(FDllHandle, 
                                  'SevenZipGetSubVersion');
    @FSevenZipSetOwnerWindow   := GetProcAddress(FDllHandle, 
                                  'SevenZipSetOwnerWindow');
    @FSevenZipClearOwnerWindow := GetProcAddress(FDllHandle, 
                                  'SevenZipClearOwnerWindo');

    FSevenZipSetOwnerWindow(FHandle);
  end;
end;


//=============================================================================
//  Destroy処理
//=============================================================================
destructor TplArchiever7ZIP.Destroy;
begin
  if FDllHandle <> 0 then begin
    FreeLibrary(FDllHandle);
  end;
  FDllHandle := 0;

  inherited;
end;

//=============================================================================
//  圧縮メソッド
//  作成可能な書庫ファイルは.7z,ZIP,GZIP,BZIP2,TAR,EXE 拡張子で判定する
//  省略すると7zになる
//  同じ名前で格納ファイルを変更する場合は書庫ファイルを削除しないと前のファイ
//  ルが残ったままとなる
//
//  SrcPathList
//    圧縮対象のファイルまたはディレクトリのリスト.フルパスで指定
//    または基準ディレクトリを除いたパス名で指定する
//  DestFile
//    圧縮後のファイル名.フルパスで指定する
//  AMsg
//    7-zip.dllが返すメッセージ文字列
//
//  HogeDirのようなディレクトリも含める場合は以下のようにする
//  パス名の最後のデリミタ(\)の有無は問わない
//  [例]
//  SrcPathList.Add('D:\000\AAA.txt');
//  SrcPathList.Add('D:\000\BBB.doc');
//  SrcPathList.Add('D:\000\CCC.xls');
//  SrcPathList.Add('D:\000\HogeDir');
//
//  使用しているスイッチの意味(aは圧縮コマンド)
//  -hide   処理進行状況のダイアログを表示しない
//  -r      サブディレクトリの再帰的検索
//  -y      全ての質問にYesを仮定
//  -ms=off 7-zip形式の場合はこのスイッチを指定
//
//  自己解凍書庫の場合は,作成時に[SFX設定]ダイアログが表示される
//  実行コマンドを省略すると,解凍時に解凍先設定ダイアログが表示される
//  実行コマンドを指定すると,テンポラリディレクトリに一時解凍後,指定されたフ
//  ァイルの実行終了後に一時ファイルは削除される.つまり,圧縮EXEファイルには
//  このコマンドの実行に必要なファイルを格納することになる
//  この設定は,使用する-sfxの形式による
//  詳細は7-zip32.dllのコマンドの説明を参照のこと
//=============================================================================
function TplArchiever7ZIP.PackFiles(SrcPathList: TStrings; DestFile: String;
  var AMsg: String): Boolean;
var
  AExt      : String;
  BasePath  : String;
  Str       : String;
  FListStr  : String;
  i         : Integer;
  FCommand  : String;
begin
  Result := False;
  //DLLがロードできていないかロードに失敗
  if FDllHandle = 0 then exit;

  FListStr := '';
  if SrcPathList.Count = 1 then begin
    BasePath := ExcludeTrailingPathDelimiter(SrcPathList[0]);
    if DirectoryExists(BasePath) then begin
      BasePath := IncludeTrailingPathDelimiter(SrcPathList[0]);
      FListStr := '*';
    end else begin
      BasePath := ExtractFilePath(SrcPathList[0]);
      FListStr := SysUtils.AnsiQuotedStr(ExtractFileName(SrcPathList[0]), '"');
    end;
  end else begin
    //基準ディレクトリを求め,その基準ディレクトリを削除したパス名リストを作成
    BasePath := GetBasePath(SrcPathList);
    //DLLの関数に渡す"で囲んだ文字列を作成(空白があることを考慮して)
    for i := 0 to SrcPathList.Count - 1 do begin
      Str := SrcPathList[i];
      FListStr := FListStr +
                  SysUtils.AnsiQuotedStr(ExcludeTrailingPathDelimiter(Str), '"') + ' ';
    end;
  end;

  AExt := UpperCase(Trim(ExtractFileExt(DestFile)));
  if AExt = '' then AExt := '.7Z';

  if AExt = '.7Z' then begin
    FCommand := 'a -r -hide -y -ms=off ';
  end else
  if AExt = '.EXE' then begin
    FCommand := 'a -r -hide -sfx -y ';
  end else begin
    FCommand := 'a -r -hide -y ';
  end;

  FCommand := FCommand +
              SysUtils.AnsiQuotedStr(DestFile, '"') + ' '+
              SysUtils.AnsiQuotedStr(BasePath, '"') + ' '+
              FListStr;

  //引数を与えて関数を実行
  Result := Execute(FCommand, AMsg);
end;

//=============================================================================
//  圧縮メソッド
//  単一ディレクトリまたは単一ファイル用
//=============================================================================
function TplArchiever7ZIP.PackFiles(SrcPath: String; DestFile: String;
  var AMsg: String): Boolean;
var
  SL : TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Add(SrcPath);
    Result := PackFiles(SL, DestFile, AMsg);
  finally
    FreeAndNil(SL);
  end;
end;

//=============================================================================
//  解凍メソッド
//  解凍時の進捗バーをプログレスバー非表示で上書きモード
//
//  SrcPath
//    解凍対象のファイルのフルパス
//  DestPath
//    解凍後先のディレクトリ名(最後にデリミタは不要)
//    ディレクトリがない場合は自動で作成
//  AMsg
//    7-zip.dllが返すメッセージ文字列
//
//  使用しているスイッチの意味(xはディレクトリ情報付きの解凍コマンド)
//  -aoa  上書きの確認ダイアログを表示しない
//  -hide 処理進行状況のダイアログを表示しない
//  -o    解凍先ディレクトリの指定
//  -r    サブディレクトリの再帰的検索
//  -y    全ての質問にYesを仮定
//=============================================================================
function TplArchiever7ZIP.UnPackFiles(SrcPath, DestPath: String;
  var AMsg: String): Boolean;
var
  FCommand : String;
begin
  //DLLがロードできていないかロードに失敗
  Result := False;
  if FDllHandle = 0 then exit;

  FCommand := 'x -r -hide -aoa -y ' +
              SysUtils.AnsiQuotedStr(SrcPath, '"') + ' ' +
              '-o' + SysUtils.AnsiQuotedStr(DestPath, '"');

  //引数を与えて関数を実行
  Result := Execute(FCommand, AMsg);
end;

//=============================================================================
//  圧縮または解凍の実行ルーチン
//  圧縮か解凍かは引数のコマンドで決まる
//  引数のAMsgに結果の文字列を戻す
//
//  7-zip.dllの扱う文字コードはデフォルトでは,Windowsのデフォルトの文字コード
//  ユニコードを指定した場合はUTF-8となる
//
//  自己解凍書庫を作成すれば,7z展開ソフトウェアを持たない利用者も圧縮されたフ
//  ァイルを展開(解凍)できる
//=============================================================================
function TplArchiever7ZIP.Execute(Cmd: String; var AMsg: String): Boolean;
var
  ACommand : AnsiString;
  Output   : array[0..BUFF_SIZE-1] of AnsiChar;
begin
  Result := False;

  if @FSevenZip <> nil then begin
    FillChar(Output, SizeOf(Output), 0);
    //ヒントや警告が表示されるので明示的にキャストしておく
    ACommand := AnsiString(Cmd);
    try
      FSevenZip(FHandle, PAnsiChar(ACommand), OutPut, BUFF_SIZE);
      Result := True;
    except
    end;
  end;
  AMsg := String(OutPut);
end;

//=============================================================================
//  7-zip.dllのバージョン文字列を取得
//=============================================================================
function TplArchiever7ZIP.GetVersion: String;
var
  AVer    : WORD;
  ASubVer : WORD;
begin
  if @FSevenZipGetVersion <> nil then begin
    try
      AVer := FSevenZipGetVersion;

      //サブバージョンの取得
      ASubVer := FSevenZipGetSubVersion;
      Result  := 'Ver. ' + 
                 FormatFloat('#.##' , AVer / 100) + '.' + IntToStr(ASubVer);
    except
    end;
  end;
end;

//=============================================================================
//  PathListのフルパス文字列から,先頭が一致するディレクトリ名を切出す
//  PathListにはそ基準ディレクトリを削除したパス名を返す
//
//  ファイルのリストの基準ディレクトリを取得
//  圧縮はこの基準ディレクトリ階層下にあるものだけと仮定する
//  パスを比較して一番短いものを基準ディレクトリとする
//  ただし念のため先頭からのディレクトリ名で比較する
//  長さで比較するとD:\000\BBBBBBとD:\000\A\C とでは後者が短くなってしまう
//
//  7-zip.dllでは外部のファイルリストからも圧縮が可能
//  コマンドラインからのファイル数制限の記載はないが,大量のファイルを圧縮する
//  場合は考慮する価値がある
//=============================================================================
function TplArchiever7ZIP.GetBasePath(PathList: TStrings): String;
var
  i     : integer;
  APath : String;
  Str   : String;
  ALen  : Integer;
begin
  Result := '';
  if (PathList.Count = 0) then exit;;

  //ExtractFileDirでは更に上の階層になってしまう
  APath := ExtractFilePath(ExcludeTrailingPathDelimiter(PathList[0]));

  for i := 0 to PathList.Count - 1 do begin
    Str := ExtractFilePath(ExcludeTrailingPathDelimiter(PathList[i]));

    //APathの文字列を比較
    //等しくない場合はStrの方が短いパスなのでAPathを上の階層に移動して短くする
    //これを一致するまで繰り返す
    while True do begin
      ALen := Length(APath);
      if (Copy(Str, 1, ALen) = APath) then begin
        break;
      end else begin
        APath := ExtractFilePath(ExcludeTrailingPathDelimiter(APath));
      end;
    end;
  end;
  Result := APath;

  //基準ディレクトリ階層下のファイルやディレクトリのみを対象とするので
  //基準ディレクトリを除いたパス名をPahtListに格納する
  ALen := Length(Result);
  for i := 0 to PathList.Count - 1 do begin
    Str := PathList[i];
    if Copy(Str, 1, ALen) = Result then begin
      System.Delete(Str, 1, ALen);
      PathList[i] := Str;
    end;
  end;
end;

end.




07_自己解凍書庫とインストーラの作成


自己解凍書庫は,解凍の際に DLL を必要としません.配布用として便利です.また,上のサンプルで確認できるように,インストーラの作成を意識したものとなっています.

Delphi には,InstallShield Express Delphi Edition というインストーラが付属していたことがあります.Delphi 2007 では,代わりに InstallAware RAD Studio Edition が付属するようになりましたが,Delphi XE2(UP4) でバンドルされなくなりました.
これらは別途入手することになります.

インストーラの作成ツールは,下記のリンクのように,ネット上で見つけることができます.
Inno Setup は Delphi で開発されていて,ソースコードも公開されています.EXEpress には法人利用・商用利用の Pro エディションと,個人作成のフリーソフトウェア用の Lite エディションがあります.Lite エディションは無料です.どちらも,よく見かけるインストーラです.
Wix は MSI 形式のインストーラの作成用ツールですが,単独ではなく,WixEdit も使用した方がいいようです.