« MiGrep2 ver1.03 | トップページ | Webカメラの映像を表示して、画像をJpegファイルに保存する(Lazarus/Delphiファイルサイズその2) »

2017.04.16

MiGrep2その後(3)書庫ファイル内の検索

MiGrepでは書庫ファイル内を検索するために統合アーカイバプロジェクトで公開されている各種DLLを使用していました。その恩恵で様々な種類の書庫ファイル内を検索することが出来ました。
今現在の状況を改めて考えてみると、Windows上の書庫ファイルはZIPが標準となっており、しかもWindowsの標準機能としてZIP書庫の解凍や作成が出来るようになっています。
そこでMiGrep2では、ZIP書庫内が検索できれば良いと割り切ることにしました。ZIP書庫の作成・解凍をエクスプローラから実行出来るということは、Windows(シェル)の標準機能を使えれば余計な外部ライブラリ等も不要になるのではとWeb上を検索して見たところ、Mr-XRAYさんの記事にそのものずばりの譲歩がありました。

Mr-XRAYさん;733_Windows XP 以降の圧縮・展開機能を使う

ここを参考にして、Windowsシェル標準機能を使用した書庫ファイル操作用クラスを作ってみました。MiGrep2内で書庫ファイル内を検索することを前提にしているため、ファイルマスク にマッチしたファイルだけを抽出することや、ファイルをひとつ見つける度にOnFoundEventを発生させて、呼び出し元側でファイル検索毎に何らかの処理を行うことが出来るようになっています(と言いますか、その使い方しかできない)。 また、書庫内のファイル解凍も指定したファイルを指定したフォルダ内に解凍する機能しかありません また、一応書庫ファイルへの圧縮機能もありますが、こちらもテスト用に実装したもので最低限の機能しかありません。Windowsシェルで対応している*.zip, *.cab, *.lzh形式の書庫ファイル内検索およびファイル解凍が可能です。一方、圧縮可能なのはZIP書庫ファイルのみです。
よくよく考えてみると、今までDelphiではコンポーネントしか作成したことがなく、何も継承しないクラスを作るのは初めてですので、これで良いのかどうか自信がありません・・・いっそコンポーネントにした方が使い勝手も含めて良かったかも知れません。

尚、Mr-XRAYさんの記事を参考に、最初にShell32_TLBとScripting_TLBユニットを作成しておく必要がありますが、Delphi10.1Starter版では作成されたScripting_TLB.pasをコンパイルすると
「E2010 'POleVariant1' と 'OleVariant' には互換性がありません」エラーが出ますので、エラー箇所を以下の様に修正します。

//property Key[const Key: OleVariant]: POleVariant1 write Set_Key;
property Key[const Key: OleVariant]: OleVariant write Set_Key;


テストプログラム
Ziptest

unit SHZipUtils;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, System.Masks, Shell32_TLB, Scripting_TLB;
 
type
  // 内部で使用するための構造体
  PZipItem = ^TZipItem;
  TZipItem = record
    SHitem: Shell32_TLB.FolderItem;
    FullPathName: string;
  end;
  // ファイルを見つけた際に発生させるイベント
	TOnFoundEvent = procedure(Found: TZipItem) of object;
  // TSHZipFileクラス
  TSHZipFile = class
  private
    FZipFile,
    FDstFolder,
    FDstZipFile: string;
    FMask: TStrings;
    FBaseLen: integer;
    FOnFound: TOnFoundEvent;
    SHShell: Shell32_TLB.TShell;
    SHSrcFolder: Shell32_TLB.Folder;
    SHDestFolder: Shell32_TLB.Folder;
    procedure SetZipFile(const value: string);
    procedure SetDstFolder(const value: string);
    procedure SetDstZipFile(const value: string);
    procedure CreateNewZIPFile(ZipFile: String);
    procedure SetMask(const Value: TStrings);
    function IsWildMatch(const FName: string): Boolean;
  protected
  public
    constructor Create;
    destructor  Destroy;
    function DoFind(ZipName: string; FindPath: string): Boolean;
    procedure Extract(FileItem: Shell32_TLB.FolderItem; ExtractPath: string);
    procedure Compress(FileName: string; ZipName: string); overload;
    procedure Compress(FileNames: TStrings; ZipName: string); overload;
  published
    property FileMask:	TStrings read FMask write SetMask;            //検索するファイルマスク
    property ZipFile: string read FZipFile write SetZipFile;          //参照するZIPファイル
    property DstFolder: string read FDstFolder write SetDstFolder;    //コピー先のフォルダ
    property DstZipFile: string read FDstZipFile write SetDstZipFile; //ファイルを追加するZIPファイル
    property OnFound: TOnFoundEvent read FOnFound write FOnFound;     //ファイル検索時イベント
  end;
 
implementation
 
 
constructor TSHZipFile.Create;
begin
  FZipFile    := '';
  FDstFolder  := '';
  FMask       := TStringList.Create;
  SHShell     := TShell.Create(nil);
end;
 
destructor TSHZipFile.Destroy;
begin
  FMask.Free;
  FreeAndNil(SHShell);
end;
 
procedure TSHZipFile.SetMask(const Value: TStrings);
begin
	FMask.Assign(Value);
end;
 
procedure TSHZipFile.SetZipFile(const value: string);
begin
  FZipFile := value;
  FBaseLen := Length(value);
  //対象書庫ファイル名をセットする時点でシェルオブジェクトを取得(フォルダ扱い)
  SHSrcFolder := SHShell.NameSpace(value);
end;
 
// ワイルドマッチ確認
function Match(const Name, Mask:string):boolean;
var
	Msk: TMask;
begin
	Msk := TMask.Create(Mask);
	try
		Result := Msk.Matches(Name);
	finally
		Msk.Free;
	end;
end;
 
function TSHZipFile.IsWildMatch(const FName: string): boolean;
var
	i: integer;
begin
	for i := 0 to FMask.Count - 1 do
		if Match(FName, FMask.Strings[i]) then
		begin
			Result := True;
			Exit;
		end;
	Result := False;
end;
 
procedure TSHZipFile.SetDstFolder(const value: string);
begin
  FDstFolder := value;
  //書庫ファイルの解凍先のシェルオブジェクトを取得
  SHDestFolder :=  SHShell.NameSpace(value);
end;
 
procedure TSHZipFile.SetDstZipFile(const value: string);
var
  dstdir: string;
begin
  //書庫ファイルが存在しなければ新たなZIP書庫ファイルを作成する
  if not FileExists(value) then
    CreateNewZIPFile(value);
  SHDestFolder := SHShell.NameSpace(value);
  FDstZipFile := value;
end;
 
// Mr-XRAYさん公開
// 733_Windows XP 以降の圧縮・展開機能を使う
// http://mrxray.on.coocan.jp/Delphi/plSamples/733_ArchiverWindowsZIP.htm
// からそのまま引用
procedure TSHZipFile.CreateNewZIPFile(ZipFile: String);
var
  IDData  : array[0..21] of Byte;
  FStream : TFileStream;
  i       : Integer;
begin
  //ZIPファイルの先頭に書き込むバイトデータ
  ZeroMemory(@IDData, Length(IDData) - 1);
  IDData[0] := Byte('P');
  IDData[1] := Byte('K');
  IDData[2] := $05;
  IDData[3] := $06;
 
  FStream := TFileStream.Create(ZipFile,
                                fmCreate or fmOpenReadWrite,
                                fmShareDenyNone);
  try
    for i := 0 to Length(IDData) - 1 do
    begin
      FStream.Write(IDData[i], 1);
    end;
  finally
    FreeAndNil(FStream);
  end;
end;
 
//書庫内ファイル検索を実行
//  ZipName:書庫ファイル名(*.zip, *.cab, *.lzh)
//  FIndSub:再帰コール検索時のフォルダ名(書庫ファイル名+'\'+サブフォルダ名
function TSHZipFile.DoFind(ZipName: string; FindPath: string): Boolean;
var
  SHFitems: Shell32_TLB.FolderItems;
  SHFitem: Shell32_TLB.FolderItem;
  zitem : TZipItem;
  zpath, lname, fpath: string;
  c, i: integer;
begin
  Result := False;
  //ZipFIleがなければFalseでリターン
  if not FileExists(ZipName) then
    Exit;
 
  try
    if FindPath = '' then
      SHSrcFolder := SHShell.NameSpace(ZipName)
    else
      SHSrcFolder := SHShell.NameSpace(FindPath);
    //書庫ファイル内のアイテム数を取得する
    c := SHSrcFolder.Items.Count;
    //アイテムリストを取得
    SHFitems := SHSrcFolder.Items;
    for i := 0 to c - 1 do
    begin
      //アイテムを一つづつ確認する
      SHFitem := SHFitems.Item(i);
      //フォルダであれば元のファイル名にフォルダ名を追加してDoFondを再帰コール
      if SHFitem.IsFolder then
      begin
        if FindPath = '' then
          //ルートでフォルダを見つけた場合
          fpath := ZipName + '\' + SHFitem.Name
        else
          //再帰コール内でフォルダを見つけた場合
          fpath := FindPath + '\' + SHFitem.Name;
        DoFind(ZipName, fpath);
      //フォルダでなければファイルアイテムとしてその情報を取得する
      end else begin
			  // ファイルマスクが指定されていないかマッチした場合に検索イベント発生
				if (FMask.Count = 0) or IsWildMatch(SHFitem.Name) then
        begin
          zpath := SHFitem.Path;
          //フォルダ名+ファイル名に加工する
          lname := Copy(zpath, FBaseLen + 2, Length(zpath) - FBaseLen);
          zitem.FullPathName := lname;
          //全ての情報を格納
          zitem.SHitem := SHFitem;
          // Shell32_TLB.FolderItemを渡してOnFoundをコール
          if Assigned(FOnFound) then
            FOnFound(zitem);
        end;
      end;
    end;
  except
    raise exception.Create('このシステムではこの機能は使用できません.');
  end;
  Result := True;
end;
 
//書庫内のファイルを指定して解凍
//尚、書庫ファイル内のフォルダ構造は考慮していないのでサブフォルダ作成はしない
//  FileItem: 解凍するファイルのFOlderItem構造体
//  ExtractPath: 解凍先のフォルダ名
procedure TSHZipFile.Extract(Fileitem: Shell32_TLB.FolderItem; ExtractPath: string);
begin
  //解凍先のフォルダパスが指定されている場合はあらためて設定
  //プロパティDstFolderが設定されている場合ExtractPathは''指定で可
  if ExtractPath <> '' then
    SHDestFolder := SHShell.NameSpace(ExtractPath);
  //指定されたファイルをDstFolderに解凍(コピー)する
  SHDestFolder.CopyHere(FileItem, 0);
end;
 
//ファイルを書庫に追加する
//  FileName: 追加するファイルのフルパス名
//  ZipName: 追加先の書庫ファイル名(*.zip)
//  ZipNameが''の場合にはSHDestFolderに設定されている書庫ファイルに追加する
procedure TSHZipFile.Compress(FileName: string; ZipName: string);
begin
  //DstZipFileを指定していない場合はおそらくエラーとなるので、ZipNameを
  //指定して実行するか、事前にDstZipFile := 書庫ファイルのフルパス名で
  //明示的に指定したほうが良い
  if ZipName <> '' then
    SetDstZipFile(ZipName);
 
  SHSrcFolder := SHShell.NameSpace(FileName);
 
  SHDestFolder.CopyHere(SHSrcFolder.Items, 0);
end;
 
//複数のファイルを書庫に追加する
//  FileNames: 追加するファイルのフルパス名を格納したリスト
//  ZipName: 追加先の書庫ファイル名(*.zip)
procedure TSHZipFile.Compress(FileNames: TStrings; ZipName: string);
var
  i: integer;
begin
  for i := 0 to FileNames.Count - 1 do
    Compress(FileNames.Strings[i], ZipName);
end;
 
end.

ソースファイルとサンプルプロジェクトも置いておきます。

「ZipTestUnit.zip」をダウンロード

|

« MiGrep2 ver1.03 | トップページ | Webカメラの映像を表示して、画像をJpegファイルに保存する(Lazarus/Delphiファイルサイズその2) »

コメント

コメントを書く



(ウェブ上には掲載しません)




トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/22406/65157706

この記事へのトラックバック一覧です: MiGrep2その後(3)書庫ファイル内の検索:

« MiGrep2 ver1.03 | トップページ | Webカメラの映像を表示して、画像をJpegファイルに保存する(Lazarus/Delphiファイルサイズその2) »