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.

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.

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.

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.

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.

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.