Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2015年03月22日] [更新 2015年03月22日]　Delphi サンプルプログラム集
   
743_cab32.dll を使用した CAB 書庫の作成・解凍
動作確認等 Windows 7 U64(SP2) + Delphi X(UP1) Pro + cab32.dll 0.98
743_Cab32dll_Test.zip　[1,883 KB]　2015年03月22日版 (EXE 同梱)






cab32.dll を使用した CAB 書庫の作成・解凍


cab32.dll を使用した CAB 書庫の解凍と作成のサンプルです．
cab32.dll は，総合アーカイバプロジェクトで提供されている DLL です．総合アーカイバプロジェクトに準拠した DLL は，書庫の作成や解凍の API の仕様がほとんど共通しているため，同じようなコーディングで解凍や圧縮のプログラムを作成することができます．

当サイトの UNLHA32.DLL, 7-zip32.dll, Tar32.dll を使用したサンプルは全て総合アーカイバプロジェクトの DLL を使用しています．必要があればそれらのサンプルも参考にしてください．
コード内の DLL のコマンドラインスイッチの説明は，DLL に説明書が添付されています．






01_CAB 書庫の解凍


cab32.dll を使用するということは，DLL を使用するということです．DLL を使用するということは，DLL 内の関数類を使用するということになります．

本サンプルでは，DLL をシステムに登録しないで利用することにしています．そこで，DLL を EXE と同じフォルダに置いて使用します．DLL は LoadLibrary でロードし，終了時に FreeLibrary で解放しています．CAB 書庫を解凍するだけのサンプルとなっています．解凍には，cab32.dll 内の Cab という関数を使用します．この関数 Cab の引数の値で圧縮か解凍を指定し，ファイル名やオプション等も関数の引数として指定します．

解凍したファイルは，本プロジェクトのフォルダ直下に[Temp] という名前のフォルダを作成し，そこに保存するようにしています．



[備考]
cab32.dll がシステムに登録されている場合，この cab32.dll を EXE と同じフォルダに置く必要はありません．システムに登録した時の場所から自動的に読み込まれます．



図1
設計時画面

リスト1
cab32.dll 内の Cab 関数を使用した CAB 書庫の解凍		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function ExtractCAB(SrcPath, DestPath: String; var AMsg: String): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  TCabFunc = function (const hWnd: HWND; szCmdLine: LPCSTR; szOutPut: LPSTR;
    constdwSize: DWORD): Integer; stdcall;


//=============================================================================
//  cab32.dllを使用したCAB書庫の解凍のテスト
//  解凍先のディレクトリがない場合は自動作成して上書き保存
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LSrcFile   : String;
  LDestDir   : String;
  LResultMsg : string;
begin
  //解凍対象の書庫ファイルを選択
  OpenDialog1.InitialDir := ExtractFileDir(ParamStr(0));
  OpenDialog1.Filter     := 'CAB 書庫|*.cab|';
  OpenDialog1.FileName   := '';
  if not OpenDialog1.Execute then exit;

  //LSrcFileは解凍する対象のファイルのフルパス
  //LDestDirは解凍したファイルを格納するディレクトリ名のフルパス
  LSrcFile := OpenDialog1.FileName;
  LDestDir := ExtractFilePath(Application.ExeName)+ 'Temp';
  ForceDirectories(LDestDir);

  //解凍
  if ExtractCAB(LSrcFile, LDestDir, LResultMsg) then begin
    MessageBox(Handle, '解凍終了', '実行結果', MB_ICONINFORMATION);
  end else begin
    MessageBox(Handle, '解凍失敗', '実行結果', MB_ICONSTOP);
  end;
end;

//-----------------------------------------------------------------------------
//  cab32.dll内のCabという関数を使用して書庫を解凍する
//
//  SrcPath  : 解凍するCAB書庫のフルパス名
//  DestPath : 解凍先のフォルダ名(デリミタの有無は問わない)
//-----------------------------------------------------------------------------
function TForm1.ExtractCAB(SrcPath, DestPath: String;
  var AMsg: String): Boolean;
const
  BUFF_SIZE = 8192;
var
  LDllHandle : THandle;
  LCabFunc   : TCabFunc;
  LCabPath   : String;
  LBaseDir   : String;
  LCommand   : AnsiString;
  LOutput    : array[0..BUFF_SIZE-1] of AnsiChar;
begin
  Result := False;

  //DLLをロード
  LDllHandle := LoadLibrary('cab32.dll');
  if LDllHandle < HINSTANCE_ERROR then exit;

  try
    //DLL内のCabという関数のアドレスを取得
    @LCabFunc := GetProcAddress(LDllHandle, 'Cab');
    if @LCabFunc = nil then exit;

    Screen.Cursor := crHourGlass;
    LCabPath  := SrcPath;
    LBaseDir  := IncludeTrailingPathDelimiter(DestPath);

    //ヒントや警告が表示されるので明示的にキャストしておく
    LCommand :=  AnsiString('-x -r -o -i '
               + AnsiQuotedStr(LCabPath, '"') + ' '
               + AnsiQuotedStr(LBaseDir, '"'));

    FillChar(LOutput, SizeOf(LOutput), 0);
    try
      //実際にDLL内の関数を実行する部分
      if LCabFunc(Handle, PAnsiChar(LCommand), LOutput, BUFF_SIZE) = 0 then begin
        AMsg   := String(LOutput);
        Result := True;
      end;
    except
    end;
  finally
    FreeLibrary(LDllHandle);
    Screen.Cursor := crDefault;
  end;
end;

end.



02_CAB 書庫の作成


CAB 書庫を作成するサンプルです．
上サンプルと同じように，cab32.dll の Cab 関数を使用して CAB 書庫を作成します．
フォルダの選択ダイアログで選択したフォルダ内のファイルを全て CAB 書庫内に圧縮します．作成した CAB 書庫は，本プロジェクトのフォルダ直下に [Temp] という名前のフォルダを作成し，そのフォルダ内こ test.cab という名前で保存するようにしています．


図2
設計時画面
図3
作成した CAB 書庫の保存先


リスト2
cab32.dll 内の Cab 関数を使用して CAB 書庫を作成する		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function PackCAB(SrcPath, DestPath: String; var AMsg: String): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TCabFunc = function (const hWnd: HWND; szCmdLine: LPCSTR; szOutPut: LPSTR;
    constdwSize: DWORD): Integer; stdcall;


//=============================================================================
//  cab32.dllを使用したCAB書庫の作成のテスト
//  格納先のディレクトリがない場合は自動作成して上書き
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFileDlg   : TFileOpenDialog;
  LRetFlag   : Boolean;
  LSrcDir    : String;
  LDestPath  : String;
  LResultMsg : string;
begin
  LRetFlag := False;
  //圧縮対象のフォルダを選択
  //ここで選択したフォルダ内のファイルを圧縮する
  //Windows Vista以降専用コード
  LFileDlg := TFileOpenDialog.Create(nil);
  try
    LFileDlg.Options := [fdoPickFolders,
                        fdoPathMustExist,
                        fdoForceFileSystem];
    if LFileDlg.Execute then begin
      Update;
      LSrcDir  := LFileDlg.FileName;
      LRetFlag := True;
    end;
  finally
    FreeAndNil(LFileDlg);
  end;
  if not LRetFlag then exit;

  //圧縮後の保存パス名の指定とディレクトリの作成
  LDestPath := ExtractFilePath(Application.ExeName)+ 'Temp\test.cab';
  ForceDirectories(ExtractFileDir(LDestPath));

  //圧縮
  if PackCAB(LSrcDir, LDestPath, LResultMsg) then begin
    MessageBox(Handle, '圧縮終了', '実行結果', MB_ICONINFORMATION);
  end else begin
    MessageBox(Handle, '圧縮失敗', '実行結果', MB_ICONSTOP);
  end;
end;

//-----------------------------------------------------------------------------
//  cab32.dll内のCabという関数を使用して書庫を作成する
//
//  SrcPath  : このフォルダ内のファイル全てを圧縮(デリミタの有無は問わない)
//  DestPath : 書庫の作成先のフォルダ名(デリミタの有無は問わない)
//-----------------------------------------------------------------------------
function TForm1.PackCAB(SrcPath, DestPath: String; var AMsg: String): Boolean;
const
  BUFF_SIZE = 8192;
var
  LDllHandle : THandle;
  LCabFunc   : TCabFunc;
  LCabPath   : String;
  LBaseDir   : String;
  LSrcFiles  : String;
  LCommand   : AnsiString;
  LOutput    : array[0..BUFF_SIZE-1] of AnsiChar;
begin
  Result := False;

  //DLLをロード
  LDllHandle := LoadLibrary('cab32.dll');
  if LDllHandle < HINSTANCE_ERROR then exit;

  try
    //DLL内のCabという関数のアドレスを取得
    @LCabFunc := GetProcAddress(LDllHandle, 'Cab');
    if @LCabFunc = nil then exit;

    Screen.Cursor := crHourGlass;
    LCabPath  := DestPath;
    LBaseDir  := IncludeTrailingPathDelimiter(SrcPath);
    LSrcFiles := '*.*';

    //ヒントや警告が表示されるので明示的にキャストしておく
    LCommand :=  AnsiString('-a -r -o -i '
               + AnsiQuotedStr(LCabPath, '"') + ' '
               + AnsiQuotedStr(LBaseDir, '"') + ' '
               + AnsiQuotedStr(LSrcFiles, '"'));

    FillChar(LOutput, SizeOf(LOutput), 0);
    try
      //実際にDLL内の関数を実行する部分
      if LCabFunc(Handle, PAnsiChar(LCommand), LOutput, BUFF_SIZE) = 0 then begin
        AMsg   := String(LOutput);
        Result := True;
      end;
    except
    end;
  finally
    FreeLibrary(LDllHandle);
    Screen.Cursor := crDefault;
  end;
end;

end.



03_cab32.dll のバージョンの取得


cab32.dll のバージョンを取得するサンプルです．
cab32.dll 内の CabGetVersion 関数を使用します．DLL の使用法，あるいは DLL 内の関数の使用方法の基本的なサンプルとも言えます．



図4
実行結果


リスト3
cab32.dll 内の CabGetVersion 関数を使用して DLL のバージョンを取得		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TCabGetSubVersin = function : WORD; stdcall;


//=============================================================================
//  cab32.dllのバージョン取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LVersion : String;
begin
  LVersion := GetVersionCAB;
  MessageBox(Handle, PChar(LVersion), '情報', MB_ICONINFORMATION);
end;

//-----------------------------------------------------------------------------
//  cab32.dll内のCabGetVersionという関数でDLLのバージョンを取得
//-----------------------------------------------------------------------------
function TForm1.GetVersionCAB: String;
var
  LDllHandle : THandle;
  LCabFunc   : TCabGetSubVersin;
  LVer       : Single;
begin
  Result := '';

  //DLLをロード
  LDllHandle := LoadLibrary('cab32.dll');
  if LDllHandle < HINSTANCE_ERROR then exit;

  try
    //DLL内のCabという関数のアドレスを取得
    @LCabFunc := GetProcAddress(LDllHandle, 'CabGetVersion');
    if @LCabFunc = nil then exit;

    //バージョンの取得
    LVer   := LCabFunc / 100;
    Result := 'Ver. ' + FormatFloat('#0.##' , LVer);
  finally
    FreeLibrary(LDllHandle);
  end;
end;

end.