|
Delphi Programming / Object Pascal
  
[掲載 2014年10月28日] [更新 2015年04月07日] Delphi サンプルプログラム集 |
| 744_JEDI プロジェクトを使用したファイルの圧縮・解凍 |
| 動作確認等 |
Windows 7 U64(SP2) + Delphi XE(UP1) Pro + JCL 2.7.0.5300 |
 |
744_JEDIArchiver.zip [4,282 KB] 2015年04月07日版 (EXE 同梱) |
- 2015年03月26日
- 進捗状況を表示するコードを変更 (プログレスバー)
JEDI に添付のサンプルを真似ていたのであるが，処理方法が明確でないので
- .tar.gz 等の書庫作成と展開を可能にするために，書庫作成と展開のルーチンを別にした
- 2015年04月07日
- ZLIB のサンプルを追加．ただし，Delphi に実装されている Zlib ユニットを使用
|
| JEDI プロジェクトを使用したファイルの圧縮・解凍 |
JEDI プロジェクトの JCL のアーカイブ関係のライブラリを使用したサンプルです．JCL は，JEDI プロジェクトの非ビジュアルコンポーネント関係のライブラリです．
TJclCompressionArchive という基本クラスとその派生クラスを利用しています．派生クラス等についてはソースコード等で確認してください．
JEDI のアーカイブの操作関係の関数類は，主に 7z.dll を使用して，その機能を使用しています．
7z.dll は 7-Zip という圧縮・解凍ツールで使用されている DLL です．これは，総合アーカイバプロジェクトで提供されている DLL とは違います．
添付の 7z.dll を，EXE のあるフォルダに置いてテストしてください．DLL は，JEDI プロジェクトのページからもダウンロードできます．
今回使用した JEDI JCL, JEDI JVCL は以下の GitHubからダウンロードしています．
JEDI JVCL を使用するには JEDI JCL のインストールも必要です．3 番目のリンクは DLL 関係のダウンロードのリンクです．最後のリンクは 7-Zip 本家のサイトです．7z.dll はこちらでもダウンロードできます．
|
以下は，JEDI プロジェクトのサイトへのリンクと関係記事へのリンクです．
|
| [備考]
2015年03月26日
--- JEDI コードライブラリとコンポーネントライブラリ (JCL/JVCL) のインストール ---
今回の更新では [JCL: JEDI Code Library 2.7.0.5300, JVCL: JEDI Visual Component Library 3.48] をインストールしてサンプルプログラムをテストしています．ダウンロードした JCL に添付されている readme.md にも書いてありますが，インストールには jedi.inc というファイルが必要です．このファイルを以下からダウンロードして，[...\jcl\jcl\source\include\jedi] フォルダ内に置きます．
具体的なインストール
方法は，上の参考リンクの記事で確認してください．
|
下図は，JEDI プロジェクトに添付されているサンプルプロジェクトを，Delphi XE(UP1) Pro でコンパイルして実行した画面です．
|
- 図1
- [examples] [windows] [compression] [archive] のプロジェクトををコンパイルして実行
|
 |
| 当サイトには，この他，以下のようなアーカイブファイルの圧縮・解凍関係のサンプルがあります．これらの記事中のリンクも参考にしてください． |
| 01_JEDI プロジェクトを使用したファイルの圧縮・書庫作成 |
拡張子が .zip, .7z その他，いくつかの書庫ファイルを作成するサンプルです．
これ以外の書庫形式については，各自で確認してください．
フォルダの選択ダイアログで選択したフォルダ内のファイル全て含む書庫を作成，または，ファイルの選択ダイアログで選択した単一のファイルを圧縮します．書庫名は元のフォルダ名に拡張子を付加したものにしています．単一ファイルの場合は，元のファイル名に拡張子を付加します．
|
 |
図2
設計時画面
- 書庫の作成には 7z.dll が必要
- 書庫によっては bzip2.dll, zlib1.dll も必要な場合がある
|
 |
図3
実行中の画面
- 書庫が作成できても，その書庫特有の情報が書かれたファイル等がないと，本来の書庫として機能しない形式もあるので注意
- GZ, GZIP, BZ2, BZIP2 は単一ファイルの圧縮用
- GZ, GZIP は同じ形式の書庫．拡張子が違うだけ
- BZ2, BZIP2 は同じ形式の書庫．拡張子が違うだけ
- .TAR.GZ と .TGZ も同じ形式の書庫
|
リスト1
JEDI プロジェクトを使用したファイルの圧縮・書庫作成 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, JclCompression, Contnrs;
const
WM_SYNC_ARCHIVE_PROGRESS = WM_USER + 153;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
function CompressSaveArchive(SourcePath, ArchiveName, Password: String;
ProgressEvent: TJclCompressionProgressEvent=nil): Integer;
procedure Archive_AddFiles(Archive: TJclCompressArchive;
BaseDir, ADir: String; var ASumSize: Int64);
procedure WmSyncArchiveProgress(var Message: TMessage);
message WM_SYNC_ARCHIVE_PROGRESS;
public
{ Public 宣言 }
procedure ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
end;
var
Form1: TForm1;
implementation
uses
FileCtrl, IOUtils, StrUtils;
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1.ItemIndex := 0;
RadioGroup2.ItemIndex := 0;
end;
//=============================================================================
// 圧縮(書庫作成)
// フォルダ内の全てのファイルを格納した書庫を作成
// 書庫の作成先は，プロジェクトフォルダ内の[Temp]フォルダ内
// 書庫ファイル名は元のフォルダ名に書庫の拡張子を付加
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LArchiveFileName : String;
LSoureDir : String;
LOutBaseDir : String;
LResult : Integer;
begin
ProgressBar1.Position := 0;
ProgressBar1.Max := 1000;
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]);
//書庫作成用のルーチンを実行
LResult := CompressSaveArchive(LSoureDir,
LArchiveFileName,
'',
ArchiveProgress);
if LResult < 0 then begin
MessageBox(Handle, '未サポート書庫形式', '結果', MB_ICONWARNING);
end else
if LResult > 0 then begin
MessageBox(Handle, '書庫作成失敗', '結果', MB_ICONSTOP);
end;
end;
//=============================================================================
// 圧縮(書庫作成)
// 1つのファイルだけを圧縮(.gz等)
// 書庫の作成先は，プロジェクトフォルダ内の[Temp]フォルダ内
// 書庫ファイル名は元のフォルダ名に書庫の拡張子を付加
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LArchiveFileName : String;
LSouceFileName : String;
LOutBaseDir : String;
LResult : Integer;
begin
if not OpenDialog1.Execute then exit;
ProgressBar1.Position := 0;
ProgressBar1.Max := 1000;
//展開対象のアーカイブ名
LSouceFileName := OpenDialog1.FileName;
//作成する書庫名のフルパス
//拡張子を変更するとその拡張子の書庫を作成する
LOutBaseDir := ExtractFilePath(Application.ExeName) + 'Temp';
LArchiveFileName := IncludeTrailingPathDelimiter(LOutBaseDir)
+ ExtractFileName(LSouceFileName)
+ Trim(RadioGroup2.Items[RadioGroup2.ItemIndex]);
//書庫作成用のルーチンを実行
LResult := CompressSaveArchive(LSouceFileName,
LArchiveFileName,
'',
ArchiveProgress);
if LResult < 0 then begin
MessageBox(Handle, '未サポート書庫形式', '結果', MB_ICONWARNING);
end else
if LResult > 0 then begin
MessageBox(Handle, '書庫作成失敗', '結果', MB_ICONSTOP);
end;
end;
//-----------------------------------------------------------------------------
// 書庫作成・解凍用のルーチン
//
// SourcePath : フォルダ内のファイルが対象の場合はそのフォルダのフルパス
// デリミタの有無は問わない
// 単一のファイルの圧縮の場合はそのファイルのフルパス
// ArchiveName : 作成する書庫のフルパス(つまり保存名)
// Password : パスワード
// ProgressEvent : TJclCompressionArchive.OnProgressイベント用のメソッド名
// イベントを使用しない場合はnilにする
//
// 戻り値
// 0 : 成功(多分)
// -1 : サポートしていない書庫形式
// 1 : 操作失敗
//-----------------------------------------------------------------------------
function TForm1.CompressSaveArchive(SourcePath, ArchiveName, Password: String;
ProgressEvent: TJclCompressionProgressEvent): Integer;
var
LSavePath : String;
LSourcePath : String;
LSingleFilePath : String;
LFileExt : String;
LFileExtTar : String;
LPassword : String;
LRetFormat : Boolean;
LFormat : TJclUpdateArchiveClass;
LArchive : TJclCompressionArchive;
LCompArchive : TJclCompressArchive;
LTotalFileSize : Int64;
begin
Result := 0;
LPassword := Password;
LSavePath := ArchiveName;
LFileExt := ExtractFileExt(LSavePath);
LFileExtTar := '';
LSingleFilePath := '';
//ディレクトリが存在すればディレクトリ内のファイルの書庫作成と見なす
//そうでない場合は単一のファイルの圧縮と見なす
if SysUtils.DirectoryExists(SourcePath) then begin
LSourcePath := IncludeTrailingPathDelimiter(SourcePath);
end else begin
LSingleFilePath := SourcePath;
end;
//.tar.gz, tgz等かを調べる
//LFileExtTarが空文字のままなら.tar.gz, tgz等ではない
LFileExtTar := ExtractFileExt(ExtractFileName(ChangeFileExt(LSavePath, '')));
if UpperCase(LFileExtTar) = '.TAR' then begin
LSavePath := ChangeFileExt(ChangeFileExt(LSavePath, ''), LFileExtTar);
LFileExtTar := LFileExtTar + LFileExt;
end else
if Pos('.T', UpperCase(LFileExt)) > 0 then begin
if Pos('Z', UpperCase(LFileExt)) > 0 then begin
LFileExtTar := LFileExt;
LFileExt := StringReplace(LFileExt, '.T', '.', [rfIgnoreCase]);
LSavePath := ChangeFileExt(LSavePath, '.tar');
end;
end else begin
//tar関係の書庫作成ではない場合
LFileExtTar := '';
end;
//作成した書庫ファイルの保存先のフォルダを作成
SysUtils.ForceDirectories(ExtractFileDir(LSavePath));
//.tar.xx, txx形式の場合は.tar書庫を作成してそこにファイルを格納
//本ルーチン自身を呼び出して処理
if LFileExtTar <> '' then begin
Result := CompressSaveArchive(LSourcePath, LSavePath, LPassword, ProgressEvent);
LSingleFilePath := LSavePath;
LSavePath := ChangeFileExt(LSavePath, '') + LFileExt;
end;
if Result = 0 then begin
Result := -1;
//拡張子に応じたフォーマットオブジェクトを検索
LFormat := GetArchiveFormats.FindUpdateFormat(LSavePath);
LRetFormat := False;
if LFormat <> nil then begin
//アーカイバのインスタンスを生成
LArchive := LFormat.Create(LSavePath);
LArchive.Password := LPassword;
LArchive.OnProgress := ProgressEvent;
try
//書庫作成用のオブジェクト
LCompArchive := LArchive as TJclCompressArchive;
//単一のファイルはTJclCompressArchive.AddFileでそのファイルを書庫に追加
//指定フォルダ内のファイルの場合(複数のファイル)は専用のメソッドで処理
if LSingleFilePath <> '' then begin
if Assigned(ProgressEvent) then begin
LCompArchive.OnProgress(nil, 0, 0);
end;
LCompArchive.AddFile(ExtractFileName(LSingleFilePath), LSingleFilePath);
end else begin
LTotalFileSize := 0;
Archive_AddFiles(LCompArchive, LSourcePath, LSourcePath, LTotalFileSize);
end;
LRetFormat := True;
except
FreeAndNil(LArchive);
end;
end;
if LRetFormat then begin
try
try
Screen.Cursor := crHourGlass;
//実際の書庫の作成
(LArchive as TJclCompressArchive).Compress;
if LFileExtTar <> '' then begin
RenameFile(LSavePath, ChangeFileExt(LSavePath, LFileExtTar));
end;
Result := 0;
except
//書庫作成失敗
Result := 1;
end;
finally
Screen.Cursor := crDefault;
FreeAndNil(LArchive);
end;
end;
end;
//.tar.xx形式で生成したファイルは削除
if LFileExtTar <> '' then begin
if FileExists(LSingleFilePath) then begin
DeleteFile(LSingleFilePath);
end;
if FileExists(LSavePath) then begin
DeleteFile(LSavePath);
end;
end;
end;
//-----------------------------------------------------------------------------
// 指定ディレクトリ内のファイルを書庫に追加するルーチン
// ついでにファイルサイズの合計を計算して返す
//
// Archive : TJclCompressArchiveのインスタンス;
// BaseDir : 基準ディレクトリ．書庫に格納するファイルがあるディレクトリ
// デリミタの有無は問わない
// ADir : 同上．こちらの値は再帰処理によって変化する
// var ASumSize : 書庫に格納するファイルのサイズの合計
// 呼び出し側で0にしておく
//
// [備考]
// TJclCompressArchive.AddDirectoryというメソッドがあるが，エラーなしで終了し
// ても，書庫の展開ができなかったりするので，このルーチンで，ファイルを1つづ
// つ処理することにした
//-----------------------------------------------------------------------------
procedure TForm1.Archive_AddFiles(Archive: TJclCompressArchive;
BaseDir, ADir: String; var ASumSize: Int64);
var
LSearchPath : string;
LSearchRec : TSearchRec;
LFullPath : String;
LFilePath : String;
begin
LSearchPath := IncludeTrailingPathDelimiter(ADir) + '*.*';
if FindFirst(LSearchPath, faAnyFile, LSearchRec) = 0 then
begin
repeat
if not ((LSearchRec.Name = '..') or (LSearchRec.Name = '.')) then begin
if (LSearchRec.Attr and faDirectory) = faDirectory then begin
LFullPath := IncludeTrailingPathDelimiter(ADir) + LSearchRec.Name;
//パス名を与えて自分自身を呼出(再帰処理)する
Archive_AddFiles(Archive, BaseDir, LFullPath, ASumSize);
end else begin
LFilePath := LSearchRec.Name;
if Trim(LSearchRec.Name) <> '' then begin
LFullPath := IncludeTrailingPathDelimiter(ADir) + LSearchRec.Name;
LFilePath := StringReplace(LFullPath, BaseDir, '', [rfIgnoreCase]);
//合計ファイルサイズを加算
ASumSize := ASumSize + LSearchRec.Size;
//書庫にファイルを追加する
Archive.AddFile(LFilePath, BaseDir + LFilePath);
end;
end;
end;
until FindNext(LSearchRec) <> 0;
FindClose(LSearchRec);
end;
end;
//-----------------------------------------------------------------------------
// TJclCompressArchiveのOnProgressイベント処理
// 本イベントは，Compressメソッドが実行されてから発生するように思われる
// いろいろ工夫が必要かもしれない
// MaxValueの値は，実際のファイルサイズよりも大きい値となっているようである
// それが何の値かは不明
//-----------------------------------------------------------------------------
procedure TForm1.ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
begin
//PostMessageでメッセージを送信して処理
PostMessage(Handle, WM_SYNC_ARCHIVE_PROGRESS, Value, MaxValue);
end;
//-----------------------------------------------------------------------------
// TJclCompressArchiveのOnProgressイベントからのメッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WmSyncArchiveProgress(var Message: TMessage);
var
LValue : Int64;
MaxValue : Int64;
begin
LValue := Message.WParam;
MaxValue := Message.LParam;
if MaxValue > 0 then begin
ProgressBar1.Position := Round(LValue / MaxValue * 1000);
end;
end;
end.
上のコードでは，書庫にファイルを追加する部分を別の関数にしています．
当初，格納するファイルの合計サイズを計算するためにそうしたのですが，実際にはファイルの合計サイズは使用していません．したがって，Delphi 2010 以降では以下のように書くことができます．非常に簡略化することができます．別の関数にするまでもないでしょう．
LFileName, LSaveFileName
は String 型の変数です．
|
for LFileName in TDirectory.GetFiles(
LSourcePath, '*.*', TSearchOption.soAllDirectories) do begin
LSaveFileName := StringReplace(LFileName, LSourcePath, '', [rfIgnoreCase]);
LCompArchive.AddFile(LSaveFileName, LFileName);
end;
| 02_JEDI プロジェクトを使用したファイルの解凍・書庫展開 |
選択した書庫ファイルを展開するサンプルです．これも，展開先を EXE のあるフォルダ内の [Temp] フォルダに固定しています．ISO, MSI, CAB, WIM 形式のファイルも展開できます．
JEDI プロジェクトの該当クラスでサポートしている書庫形式に .tgz, .tpz, .tbz2, .tbz がありますが，これらは，圧縮を解凍して .tar ファイルを生成するだけです．そこで，本サンプルでは，解凍・展開のメソッドを再帰的に実行することで，これらのファイルの解凍・展開をしています．
前項のサンプルでは逆に，アーカイブの処理を再帰的に実行することで，それらのファイルを作成するようにしています．
|
 |
図4
設計時画面
- 書庫の解凍・展開には 7z.dll が必要
- 書庫によっては bzip2.dll, zlib1.dll も必要な場合がある
|
| 下図はエクセルの xlsx 形式のブックを展開した結果の例です．画像があれば，その展開したファイルから取り出すこともできます．Office 2007 以降の .xlsx, docx ファイル等は zip 形式の書庫です．拡張子を .zip に変更すれば，zip 書庫を展開できるプログラムであれば展開できます． |
 |
図5
エクセルの .xlsx 形式ブックの展開結果 |
下図は test.exe という EXE ファイルを展開した結果です．
Test 直下には EXE の各セッションのデータがありますが，もちろんバイナリデータです．
MANIFEST フォルダにはいわゆるアプリケーションマニフェストファイルが格納されています．これはテキストファイルです． |
 |
図6
EXE ファイルの展開結果 |
リスト2
JEDI プロジェクトを使用したファイルの解凍・展開 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, JclCompression, Contnrs;
const
WM_SYNC_ARCHIVE_PROGRESS = WM_USER + 153;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FTotalFileSize : Int64;
function ExtractArchive(ArchiveName, DestDir, Password: String;
ProgressEvent: TJclCompressionProgressEvent=nil): Integer;
procedure WmSyncArchiveProgress(var Message: TMessage);
message WM_SYNC_ARCHIVE_PROGRESS;
public
procedure ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
end;
var
Form1: TForm1;
implementation
uses IOUtils, StrUtils;
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//
// 使用可能な拡張子をセット
// ただし，このリストは単純にGetArchiveFormatsから取得したもの
// 全てが使用可能かどうかは不明
// 書庫に種類によってはEXEのフォルダ内に該当DLLが必要な場合がある
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
SL : TStringList;
i : Integer;
begin
SL := TStringList.Create;
try
SL.Add('|*.lzh;*.zip;*.7z|');
SL.Add('|*.iso;*.msi;*.cab;*.exe;*.dll|');
SL.Add('|*.docx;*.xlsx;*.pptx;*.doc;*.xls;*.ppt|');
SL.Add('|*.tar|');
SL.Add('|*.gz;*.gzip;*.tgz;*.tpz|');
SL.Add('|*.bz2;*.bzip2;*.tbz2;*.tbz|');
SL.Add('|*.pcv;*.bsz;*.mskin;*.wmz;*.ipa;*.sxw;*.sxi|');
SL.Add('|*.xz;*.txz|');
SL.Add('|*.swf|');
SL.Add('|*.wim;*.swm|');
SL.Add('|*.sxt;*.sxd;*.sxc;*.sxm;*.sxg;*.stw;*.sti;*.std;*.stc;*.odh;*.odd|');
SL.Add('|*.odt;*.odm;*.ods;*.ots;*.odg;*.otg;*.odp;*.otp;*.odf;*.odb|');
SL.Add('|*.jar;*.ear;*.war;*.cbz;*.apk;*.wsz;*.wal;*.xpi;*.crx;*.dfsz|');
for i := 0 to SL.Count -1 do begin
OpenDialog1.Filter := OpenDialog1.Filter + '' + SL[i];
end;
finally
FreeAndNil(SL);
end;
end;
//=============================================================================
// 書庫の解凍(展開)
// 展開先はプロジェクトフォルダ下の[Temp]フォルダ内
// [Temp]フォルダ内にファイル名から拡張子を除いたフォルダを作成して格納
// 出力先のディレクトリがない場合は，自動で作成する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LBaseDir : String;
LArchiveFileName : string;
LDestDirectory : string;
LResult : Integer;
begin
if not OpenDialog1.Execute then exit;
ProgressBar1.Position := 0;
ProgressBar1.Max := 1000;
//展開対象のアーカイブ名
LArchiveFileName := OpenDialog1.FileName;
LBaseDir := ExtractFilePath(Application.ExeName) + 'Temp';
//解凍(展開)先のフォルダ
LDestDirectory := IncludeTrailingPathDelimiter(LBaseDir)
+ ExtractFileName(ChangeFileExt(LArchiveFileName, '')) ;
//筆者がよく使用する出力先の指定の場合
//アーカイブがあるフォルダ内にフォルダを作成して，そこに解凍する場合
//LDestDirectory := ExtractFilePath(Application.ExeName)
// + ExtractFileName(ChangeFileExt(LArchiveFileName, '')) ;
LResult := ExtractArchive(LArchiveFileName, LDestDirectory, ' ', ArchiveProgress);
if LResult < 0 then begin
MessageBox(Handle, '未サポート書庫形式', '結果', MB_ICONWARNING);
end else
if LResult > 0 then begin
MessageBox(Handle, '書庫展開 (解凍) 失敗', '結果', MB_ICONSTOP);
end;
end;
//-----------------------------------------------------------------------------
// JEDIプロジェクトを使用した解凍用のルーチン
//
// ArchiveName : 解凍するアーカイブのフルパス
// DestDir : 解凍先のフォルダ名
// Password : パスワードの文字列
// ProgressEvent : OnProgressイベント用のメソッド名(必要なければnilにする)
//-----------------------------------------------------------------------------
function TForm1.ExtractArchive(ArchiveName, DestDir, Password: String;
ProgressEvent: TJclCompressionProgressEvent=nil): Integer;
var
LPassword : String;
LDestDir : String;
LArchiveName : String;
LFileExt : String;
LFileExtTar : String;
LFormats : TJclDecompressArchiveClassArray;
LArchive : TJclCompressionArchive;
LRetFormat : Boolean;
LTotalFileSize : Int64;
i : Integer;
begin
Result := -1;
// LIsTarXXX := False;
LPassword := Password;
LArchiveName := ArchiveName;
LDestDir := DestDir;
LFileExt := ExtractFileExt(LArchiveName);
LFileExtTar := '';
//展開するファイルを格納するディレクトリを作成
SysUtils.ForceDirectories(LDestDir);
//.tar.gz, tgz等かを調べる
//LFileExtTarが空文字のままなら.tar.gz, tgz等ではない
LFileExtTar := ExtractFileExt(ExtractFileName(ChangeFileExt(LArchiveName, '')));
if UpperCase(LFileExtTar) = '.TAR' then begin
LFileExtTar := LFileExtTar + LFileExt;
end else
//拡張子が.txxの場合は.tarとそれ以後に分解する
//まずxxの部分を解凍してからtarを展開するため
if Pos('.T', UpperCase(LFileExt)) > 0 then begin
if Pos('Z', UpperCase(LFileExt)) > 0 then begin
LFileExtTar := LFileExt;
LArchiveName := ChangeFileExt(LArchiveName, '')
+ '.tar'
+ StringReplace(LFileExt, '.T', '.', [rfIgnoreCase]);
LDestDir := LDestDir + '.tar';
end;
end else begin
//tar関係の書庫ではない場合
LFileExtTar := '';
end;
//サポートしているフォーマットのリストを取得
LFormats := GetArchiveFormats.FindDecompressFormats(LArchiveName);
//使用可能なFormatを順番に検索していく
LRetFormat := False;
for i := Low(LFormats) to High(LFormats) do begin
LArchive := LFormats[i].Create(LArchiveName, 0, False);
LArchive.Password := LPassword;
LArchive.OnProgress := ProgressEvent;
try
//Formatが一致しないとListFiesで失敗する
if LArchive is TJclDecompressArchive then begin
TJclDecompressArchive(LArchive).ListFiles;
end else
if LArchive is TJclUpdateArchive then begin
TJclUpdateArchive(LArchive).ListFiles;
end;
LRetFormat := True;
break;
except
FreeAndNil(LArchive);
end;
end;
if LRetFormat then begin
try
try
Screen.Cursor := crHourGlass;
//書庫内のファイルの解凍後のサイズの合計を取得
LTotalFileSize := 0;
for i := 0 to LArchive.ItemCount - 1 do begin
if LArchive.Items[i].Attributes <> FILE_ATTRIBUTE_DIRECTORY then begin
LTotalFileSize := LTotalFileSize + LArchive.Items[i].FileSize;
end;
end;
//OnProgressイベント用のメソッドに合計ファイルサイズを知らせる
if Assigned(LArchive.OnProgress) then begin
LArchive.OnProgress(nil, -1, LTotalFileSize);
end;
//実際の展開・解凍(ExtractAllで全て展開)
TJclDecompressArchive(LArchive).ExtractAll(LDestDir, True);
//OnProgressの引数の値が不明確である対応策
//OnProgressイベント用メソッドに最大値を送る
if Assigned(LArchive.OnProgress) then begin
LArchive.OnProgress(nil, LTotalFileSize, LTotalFileSize);
end;
//拡張子が.t.xxxの場合は，再度本ルーチンを実行して.tarを展開する
if LFileExtTar <> '' then begin
LArchiveName := IncludeTrailingPathDelimiter(LDestDir)
+ ExtractFileName(LDestDir);
Result := ExtractArchive(LArchiveName,
ChangeFileExt(LDestDir, ''),
LPassword,
ProgressEvent);
//tar.xxxのxxx部分のファイルはディレクトリごと削除
TDirectory.Delete(LDestDir, True);
end else begin
Result := 0;
end;
except
//書庫展開(解凍)失敗
Result := 1;
end;
finally
Screen.Cursor := crDefault;
FreeAndNil(LArchive);
end;
end;
end;
//-----------------------------------------------------------------------------
// TJclDecompressArchiveのOnProgressイベント処理
// 引数のValueは展開・解凍済みのファイルサイズの合計値らしい
//
// Valueの値が-1の時はアーカイブ内のファイルサイズ(展開後)が取得できる
// (展開用のプロシージャーから送るようにしている)
//-----------------------------------------------------------------------------
procedure TForm1.ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
begin
if Value < 0 then begin
FTotalFileSize := MaxValue;
end;
if FTotalFileSize > 0 then begin
//PostMessageでメッセージを送信して処理
PostMessage(Handle, WM_SYNC_ARCHIVE_PROGRESS, Value, 0);
end;
end;
//-----------------------------------------------------------------------------
// OnProgressイベントからのメッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WMSyncArchiveProgress(var Message: TMessage);
begin
if FTotalFileSize > 0 then begin
ProgressBar1.Position := Round(Message.WParam / FTotalFileSize * 1000);
end;
end;
end.
これまでは主にアーカイブの基本クラスを使用してます．
本サンプルでは，ZIP 書庫の圧縮と解凍を行いますが，圧縮には TJclZipCompressArchive とういう クラスを，解凍には TJclZipDecompressArchive という ZIP 書庫専用のクラスを使用しています．専用のクラスを使用すると，ほとんど型キャストが必要ありません．
|
 |
図7
設計時画面
|
リスト3
専用のクラスを使用した ZIP ファイルの圧縮・解凍 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, JclCompression, Contnrs;
const
WM_SYNC_ARCHIVE_PROGRESS = WM_USER + 153;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
FTotalFileSize : Int64;
procedure WmSyncArchiveProgress(var Message: TMessage);
message WM_SYNC_ARCHIVE_PROGRESS;
public
{ Public 宣言 }
procedure ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
end;
var
Form1: TForm1;
implementation
uses
FileCtrl;
{$R *.dfm}
//=============================================================================
// 圧縮(書庫作成)
// フォルダの選択ダイアログで選択したフォルダ内全てのファイルを格納した書庫作成
// 書庫の作成先は，プロジェクトフォルダ内の[Temp]フォルダ
// 書庫ファイル名は対象のフォルダ名に拡張子を付加
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LArchiveFileName : String;
LSourceDir : String;
LBaseDir : String;
LArchive : TJclZipCompressArchive;
LPassword : String;
i : Integer;
begin
LArchive := nil;
LPassword := '';
ProgressBar1.Position := 0;
ProgressBar1.Max := 1000;
LSourceDir := ExtractFileDir(Application.ExeName);
if SelectDirectory('フォルダ選択', '', LSourceDir, [sdNewUI], Self) then begin
//作成する書庫名のフルパス
LBaseDir := ExtractFilePath(Application.ExeName) + 'Temp';
LArchiveFileName := IncludeTrailingPathDelimiter(LBaseDir)
+ ExtractFileName(LSourceDir) + '.zip';
//ディレクトリ作成
SysUtils.ForceDirectories(ExtractFileDir(LArchiveFileName));
Screen.Cursor := crHourGlass;
//アーカイバのインスタンスを生成
LArchive := TJclZipCompressArchive.Create(LArchiveFileName);
if LArchive <> nil then begin
try
LArchive.Password := LPassword;
LArchive.OnProgress := ArchiveProgress;
//指定したフォルダの階層下のファイル全てを書庫に追加
LArchive.AddDirectory(ExtractFileName(LSourceDir), LSourceDir, True, True);
//ファイルサイズの合計を取得
FTotalFileSize := 0;
for i := 0 to LArchive.ItemCount - 1 do begin
if LArchive.Items[i].Attributes <> FILE_ATTRIBUTE_DIRECTORY then begin
FTotalFileSize := FTotalFileSize + LArchive.Items[i].FileSize;
end;
end;
//書庫作成
//ここで実際に書庫が作成される
LArchive.Compress;
except
MessageBox(Handle, '書庫作成失敗', '結果', MB_ICONSTOP);
end;
end else begin
MessageBox(Handle, '未サポート書庫形式', '結果', MB_ICONWARNING);
end;
end;
Screen.Cursor := crDefault;
if Assigned(LArchive) then FreeAndNil(LArchive);
end;
//=============================================================================
// ZIP書庫の解凍(展開)
// 展開先はプロジェクトフォルダ下の[Temp]フォルダ内
// [Temp]フォルダ内にファイル名から拡張子を除いたフォルダを作成して格納
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LArchiveFileName : String;
LBaseDir : String;
LDestDirectory : String;
LExtracter : TJclZipDecompressArchive;
LPassword : String;
i : Integer;
begin
LExtracter := nil;
LPassword := '';
ProgressBar1.Position := 0;
ProgressBar1.Max := 1000;
OpenDialog1.Filter := 'ZIP 書庫|*.zip';
OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
if OpenDialog1.Execute then begin
//解凍(展開)対象の書庫ファイルのフルパス
LArchiveFileName := OpenDialog1.FileName;
//解凍(展開)先のフォルダ
LBaseDir := ExtractFilePath(Application.ExeName) + 'Temp';
LDestDirectory := LBaseDir;
//以下のようにすると2重にフォルダ名ができる(上のコードで書庫を作成した場合)
//元のフォルダ名と別の場所に展開した場合でも，元のフォルダ名が分かる
//LDestDirectory := IncludeTrailingPathDelimiter(LBaseDir)
// + ChangeFileExt(ExtractFileName(LArchiveFileName), '');
Screen.Cursor := crHourGlass;
//アーカイバのインスタンスを生成
LExtracter := TJclZipDecompressArchive.Create(LArchiveFileName);
if LExtracter <> nil then begin
try
LExtracter.Password := LPassword;
LExtracter.OnProgress := ArchiveProgress;
//ListFilesメソッドを実行(展開先にファイルが追加可能になる)
LExtracter.ListFiles;
//書庫内のファイルの解凍後のサイズの合計を取得
FTotalFileSize := 0;
for i := 0 to LExtracter.ItemCount - 1 do begin
if LExtracter.Items[i].Attributes <> FILE_ATTRIBUTE_DIRECTORY then begin
FTotalFileSize := FTotalFileSize + LExtracter.Items[i].FileSize;
end;
end;
//実際の解凍(ExtractAllで全て展開)
LExtracter.ExtractAll(LDestDirectory, True);
except
MessageBox(Handle, '書庫展開 (解凍) 失敗', '結果', MB_ICONSTOP);
end;
end else begin
MessageBox(Handle, '未サポート書庫形式', '結果', MB_ICONWARNING);
end;
end;
Screen.Cursor := crDefault;
if Assigned(LExtracter) then FreeAndNil(LExtracter);
end;
//-----------------------------------------------------------------------------
// TJclZipCompressArchive, TJclZipDecompressArchiveのOnProgressイベント処理
//-----------------------------------------------------------------------------
procedure TForm1.ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
begin
if FTotalFileSize > 0 then begin
//PostMessageでメッセージを送信して処理
PostMessage(Handle, WM_SYNC_ARCHIVE_PROGRESS, Value, 0);
end;
end;
//-----------------------------------------------------------------------------
// OnProgressイベントからのメッセージ処理
//-----------------------------------------------------------------------------
procedure TForm1.WmSyncArchiveProgress(var Message: TMessage);
begin
if FTotalFileSize > 0 then begin
ProgressBar1.Position := Round(Message.WParam / FTotalFileSize * 1000);
end;
end;
end.
JEDI Code Library v 2.7 (2014年10月28日現在) には，以下のような圧縮，解凍用のクラスが実装されています．
|
// JEDI Code Library v 2.7
{*****************************************************************************
Class hierarchy
TJclCompressionStream
|
|-- TJclCompressStream
| |
| |-- TJclZLibCompressStream handled by zlib http://www.zlib.net/
| |-- TJclBZIP2CompressStream handled by bzip2 http://www.bzip.net/
| |-- TJclGZIPCompressStream handled by zlib http://www.zlib.net/ + JCL
|
|-- TJclDecompressStream
|
|-- TJclZLibDecompressStream handled by zlib http://www.zlib.net/
|-- TBZIP2DecompressStream handled by bzip2 http://www.bzip.net/
|-- TGZIPDecompressStream handled by zlib http://www.zlib.net/ + JCL
TJclCompressionArchive
|
|-- TJclCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
| |
| |-- TJclSevenzipCompressArchive
| |
| |-- TJclZipCompressArchive
| |-- TJclBZ2CompressArchive
| |-- TJcl7zCompressArchive
| |-- TJclTarCompressArchive
| |-- TJclGZipCompressArchive
| |-- TJclXzCompressArchive
| |-- TJclSwfcCompressArchive
| |-- TJclWimCompressArchive
|
|-- TJclDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
| |
| |-- TJclSevenZipDecompressArchive
| |
| |-- TJclZipDecompressArchive
| |-- TJclBZ2DecompressArchive
| |-- TJclRarDecompressArchive
| |-- TJclArjDecompressArchive
| |-- TJclZDecompressArchive
| |-- TJclLzhDecompressArchive
| |-- TJcl7zDecompressArchive
| |-- TJclCabDecompressArchive
| |-- TJclNsisDecompressArchive
| |-- TJclLzmaDecompressArchive
| |-- TJclLzma86DecompressArchive
| |-- TJclPeDecompressArchive
| |-- TJclElfDecompressArchive
| |-- TJclMachoDecompressArchive
| |-- TJclUdfDecompressArchive
| |-- TJclXarDecompressArchive
| |-- TJclMubDecompressArchive
| |-- TJclHfsDecompressArchive
| |-- TJclDmgDecompressArchive
| |-- TJclCompoundDecompressArchive
| |-- TJclWimDecompressArchive
| |-- TJclIsoDecompressArchive
| |-- TJclBkfDecompressArchive
| |-- TJclChmDecompressArchive
| |-- TJclSplitDecompressArchive
| |-- TJclRpmDecompressArchive
| |-- TJclDebDecompressArchive
| |-- TJclCpioDecompressArchive
| |-- TJclTarDecompressArchive
| |-- TJclGZipDecompressArchive
| |-- TJclXzDecompressArchive
| |-- TJclNtfsDecompressArchive
| |-- TJclFatDecompressArchive
| |-- TJclMbrDecompressArchive
| |-- TJclVhdDecompressArchive
| |-- TJclMslzDecompressArchive
| |-- TJclFlvDecompressArchive
| |-- TJclSwfDecompressArchive
| |-- TJclSwfcDecompressArchive
| |-- TJclAPMDecompressArchive
| |-- TJclPpmdDecompressArchive
| |-- TJclTEDecompressArchive
| |-- TJclUEFIcDecompressArchive
| |-- TJclUEFIsDecompressArchive
| |-- TJclSquashFSDecompressArchive
| |-- TJclCramFSDecompressArchive
|
|-- TJclUpdateArchive
|
|-- TJclSevenzipUpdateArchive
|
|-- TJclZipUpdateArchive
|-- TJclBZ2UpdateArchive
|-- TJcl7zUpdateArchive
|-- TJclTarUpdateArchive
|-- TJclGZipUpdateArchive
|-- TJclXzUpdateArchive
|-- TJclSwfcUpdateArchive
******************************************************************************}
| 04_ZLIB ユニットを使用したファイルの圧縮・解凍 |
上の JEDI ライブラリに実装されているクラス名に Zlib というのがあります．
Zlib は，GZIP の主要開発者である Jean-Loup Gailly と Mark Adler らが，Deflate と呼ばれる処理のアルゴリズムだけをライブラリ化したものです．Zlib のアルゴリズムは，ZIP, GZIP 等で利用されています．また PNG 画像ファイルにも使用されています．
JEDI プロジェクトの Zlib のクラス，あるいは，この後のページの TurboPower Abbrevia を使用すると，この Zlib の機能を使用することができます．
Delphi には，この Zlib を利用するためのユニットが用意されています．JEDI プロジェクトを使用するまでもありません．本サンプルは，この Delphi に実装されている Zlib の簡単なテストです．と言っても，Delphi のオンラインヘルプのサンプルをそのまま利用しています．
Zlib にはアーカイブの機能はありません．単一ファイルの圧縮と解凍の機能だけです．
本サンプルでは，圧縮後のファイルと，元のファイルを別にしています．圧縮後のファイルの拡張子を，元のファイルと区別するために，.plz
としています．
|
[備考]
本サンプルの実行に ZLIB.DLL は必要ありません．Delphi の Zlib ユニットは，ZLIB.DLL の機能を提供するものではありません．
Delphi のオンラインヘルプのサンプルでは，圧縮後のファイルの拡張子を .zip にしていますが，拡張子を .zip にしても ZIP 形式の書庫にはなりません．
|
 |
図8
設計時画面 |
 |
図9
約 10 MB のテキストファイルを圧縮した結果 |
リスト4
Zlib を使用した単一ファイルの圧縮と解凍 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
FFileExt : String;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
ZLib;
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
// 圧縮後のファイルの拡張子を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
FFileExt := '.plz';
end;
//=============================================================================
// Zlibを使用したファイルの圧縮
// usesにZLibが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LBaseDir : String;
LSourceFileName : String;
LDestFileName : String;
LSourceFileStream : TFileStream;
LDestFileStream : TFileStream;
LZCompress : TZCompressionStream;
begin
OpenDialog1.Filter := '|*.*|';
if OpenDialog1.Execute then begin
//圧縮対象のファイルのフルパス
LSourceFileName := OpenDialog1.FileName;
//圧縮したファイルの保存先のフォルダ名と圧縮後のファイル名のフルパス
LBaseDir := ExtractFilePath(Application.ExeName) + 'TempCompress';
LDestFileName := IncludeTrailingPathDelimiter(LBaseDir)
+ ExtractFileName(LSourceFileName) + FFileExt;
Screen.Cursor := crHourGlass;
//圧縮対象のファイルのストリーム生成
LSourceFileStream := TFileStream.Create(LSourceFileName, fmOpenRead);
//圧縮語のファイルのストリーム生成
LDestFileStream := TFileStream.Create(LDestFileName, fmCreate);
try
//TZCompressionStreamのインスタンスを生成
LZCompress := TZCompressionStream.Create(clMax, LDestFileStream);
try
//圧縮実行
LZCompress.CopyFrom(LSourceFileStream, LSourceFileStream.Size);
finally
//Freeすると実際にファイルに圧縮した内容が格納される
FreeAndNil(LZCompress);
end;
finally
LSourceFileStream.Free;
LDestFileStream.Free;
end;
Screen.Cursor := crDefault;
end;
end;
//=============================================================================
// Zlibを使用して圧縮したファイルの解凍
// usesにZLibが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LBaseDir : String;
LSourceFileName : String;
LDestFileName : String;
LSourceFileStream : TFileStream;
LDestFileStream : TFileStream;
LZDeCompress : TZDecompressionStream;
begin
OpenDialog1.Filter := '|*' + FFileExt + '|';
OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName) + 'TempCompress';
if OpenDialog1.Execute then begin
//解凍するファイルのフルパス
LSourceFileName := OpenDialog1.FileName;
//解凍後のファイルの保存先フォルダと解凍後のファイルのフルパス
LBaseDir := ExtractFilePath(Application.ExeName) + 'TempDeCompress';
LDestFileName := IncludeTrailingPathDelimiter(LBaseDir)
+ ChangeFileExt(ExtractFileName(LSourceFileName), '');
Screen.Cursor := crHourGlass;
//解凍対象のファイルのストリームを生成
LSourceFileStream := TFileStream.Create(LSourceFileName, fmOpenRead);
//解凍後のファイルのストリームを生成
LDestFileStream := TFileStream.Create(LDestFileName, fmCreate);
try
//TZDecompressionStreamのインスタンス生成
LZDeCompress := TZDecompressionStream.Create(LSourceFileStream);
try
//解凍を実行
LDestFileStream.CopyFrom(LZDeCompress, LZDeCompress.Size);
finally
//Freeすると実際にファイルに解凍した内容が格納される
FreeAndNil(LZDeCompress);
end;
finally
FreeAndNil(LDestFileStream);
FreeAndNil(LSourceFileStream);
end;
Screen.Cursor := crDefault;
end;
end;
end.
|