TZipFile.ZipDirectoryContentsのCOMラッパー

仕事で、VB6でフォルダーを圧縮する必要が出てきて、どうしようかと迷ってた時
DEKOさんが以前フォルダごと圧縮してZipファイルを作成するデモを紹介してたのを
思い出したのでCOM化してVB6,VBAから呼び出せるようにしてみた。

以下、ソース

unit DirZipImp;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, SimpleDirZip_TLB, StdVcl;

type
  TDirZip = class(TAutoObject, IDirZip)
  protected
    procedure Compress(const SrcDirName, ZipFileName: WideString); safecall;
    procedure Extract(const ZipFileName, DestDirName: WideString); safecall;

  end;

implementation

uses ComServ,System.Zip;

procedure TDirZip.Compress(const SrcDirName, ZipFileName: WideString);
begin
  TZipFile.ZipDirectoryContents(ZipFileName,SrcDirName);
end;

procedure TDirZip.Extract(const ZipFileName, DestDirName: WideString);
begin
  TZipFile.ExtractZipFile(ZipFileName,DestDirName);
end;

initialization
  TAutoObjectFactory.Create(ComServer, TDirZip, Class_DirZip,
    ciMultiInstance, tmApartment);
end.

Delphiが作成したタイプライブラリーは

// ************************************************************************ //
// 警告
// -------
// このファイルはタイプ ライブラリ インポータまたはタイプ ライブラリ エディタで生成されています。
// 構文エラーがない場合には、エディタはファイルへの変更を構文解析します。
// ただし、エディタで変更したときは、このファイルは再生成され、
// コメントやフォーマットの変更は失われます。
// ************************************************************************ //
// 2012/11/10 20:48:27 に生成されたファイル (- $Rev: 12980 $, 52614628)

[
  uuid(A77B985B-35E5-49A6-91CB-5BCD38D54C22),
  version(1.0)

]
library SimpleDirZip
{

  importlib("stdole2.tlb");

  interface IDirZip;
  coclass DirZip;


  [
    uuid(2CCEF7D7-0EF5-467E-BFEC-F4574049C00D),
    helpstring("DirZip Object のディスパッチ インターフェイス"),
    dual,
    oleautomation
  ]
  interface IDirZip: IDispatch
  {
    [id(0x000000C9)]
    HRESULT _stdcall Compress([in] BSTR SrcDirName, [in] BSTR ZipFileName);
    [id(0x000000CA)]
    HRESULT _stdcall Extract([in] BSTR ZipFileName, [in] BSTR DestDirName);
  };

  [
    uuid(2B59D5EC-076B-4577-8C09-F3968AEFF615),
    helpstring("DirZip Object")
  ]
  coclass DirZip
  {
    [default] interface IDirZip;
  };

};

unit SimpleDirZip_TLB;

// ************************************************************************ //
// 警告
// -------
// このファイルで宣言されている型はタイプ ライブラリから読み取られたデータから
// 生成されています。このタイプ ライブラリが明示的あるいは（このタイプ ライブラ
// リを参照しているほかのタイプ ライブラリ経由で）間接的に再インポートされた
// り、タイプ ライブライブラリの編集中にタイプ ライブラリ エディタの［更新］コマ
// ンドを実行した場合、このファイルの内容はすべて再生成され、手動で加えた変更
// はすべて失われます。
// ************************************************************************ //

// $Rev: 52393 $
// 下に説明されたタイプ ライブラリから 2012/11/10 20:48:24 に生成されたファイル。

// ************************************************************************  //
// タイプ ライブラリ: C:\Users\saka_xps\Documents\Saka_Develop\DelProj\SimpleDirZip (1)
// LIBID: {A77B985B-35E5-49A6-91CB-5BCD38D54C22}
// LCID: 0
// ヘルプファイル:
// ヘルプ文字列:
// 依存関係リスト:
//   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// SYS_KIND: SYS_WIN32
// ************************************************************************ //
{$TYPEDADDRESS OFF} // ポインタの型チェックをオフにしてコンパイルすること
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}

interface

uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;

// *********************************************************************//
// タイプ ライブラリで宣言される GUID. 以下のプレフィックスを使う:
//   Type Libraries     : LIBID_xxxx
//   CoClasses          : CLASS_xxxx
//   DISPInterfaces     : DIID_xxxx
//   Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
  // タイプ ライブラリのメジャー バージョンとマイナー バージョン
  SimpleDirZipMajorVersion = 1;
  SimpleDirZipMinorVersion = 0;

  LIBID_SimpleDirZip: TGUID = '{A77B985B-35E5-49A6-91CB-5BCD38D54C22}';

  IID_IDirZip: TGUID = '{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}';
  CLASS_DirZip: TGUID = '{2B59D5EC-076B-4577-8C09-F3968AEFF615}';
type
// *********************************************************************//
// タイプ ライブラリで宣言される前方参照
// *********************************************************************//
  IDirZip = interface;
  IDirZipDisp = dispinterface;
// *********************************************************************//
// タイプ ライブラリで宣言される CoClass
// (注意: ここで各 CoClass とデフォルトのインターフェイスをマッピングする)
// *********************************************************************//
  DirZip = IDirZip;


// *********************************************************************//
// インターフェイス: IDirZip
// フラグ: (4416) Dual OleAutomation Dispatchable
// GUID: {2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}
// *********************************************************************//
  IDirZip = interface(IDispatch)
    ['{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}']
    procedure Compress(const SrcDirName: WideString; const ZipFileName: WideString); safecall;
    procedure Extract(const ZipFileName: WideString; const DestDirName: WideString); safecall;
  end;

// *********************************************************************//
// DispIntf:  IDirZipDisp
// フラグ:     (4416) Dual OleAutomation Dispatchable
// GUID:      {2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}
// *********************************************************************//
  IDirZipDisp = dispinterface
    ['{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}']
    procedure Compress(const SrcDirName: WideString; const ZipFileName: WideString); dispid 201;
    procedure Extract(const ZipFileName: WideString; const DestDirName: WideString); dispid 202;
  end;

// *********************************************************************//
// クラス DirZip は、Create および CreateRemote メソッドを使用して
// CoClass DirZip が公開するデフォルトのインターフェイス IDirZip の
// インスタンスを作成する。このタイプ ライブラリのサーバーによって
// 公開された CoClass オブジェクトに対し、オートメーションを行いたい
// クライアントが用いるために、これらの関数が存在する。
// *********************************************************************//
  CoDirZip = class
    class function Create: IDirZip;
    class function CreateRemote(const MachineName: string): IDirZip;
  end;

implementation

uses System.Win.ComObj;

class function CoDirZip.Create: IDirZip;
begin
  Result := CreateComObject(CLASS_DirZip) as IDirZip;
end;

class function CoDirZip.CreateRemote(const MachineName: string): IDirZip;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_DirZip) as IDirZip;
end;

end.

VB6,VBAの呼び出しのサンプルは、

Private Sub CommandButton1_Click()
    Dim DirZip As SimpleDirZip.DirZip
    
    Set DirZip = New SimpleDirZip.DirZip
    
    Call DirZip.Compress("C:\Users\ppp", "C:\Users\pp\ppp.zip")    
    Set DirZip = Nothing
    
End Sub

Private Sub CommandButton2_Click()
    
    Dim DirZip As SimpleDirZip.DirZip
    
    Set DirZip = New SimpleDirZip.DirZip
    
    Call DirZip.Extract("C:\Users\pp\ppp.zip", "C:\Users\pp\p")
    
    Set DirZip = Nothing

End Sub

C#とかでComを作るより簡単かも。

ところで、タイプライブラリでインターフェイスのメソッド名を編集時にメソッド名が全部消せないのは
仕様なんかしら・・・。
とりあえず2007では消せたんだけど・・・・。

Joinのオーバーロード

Joinのオーバーロードを試してみた。
但し、

class function Join(const Separator: string; const Values: IEnumerable): string; overload; static;

以外です。
詳細はプログラム中のコメントに記述しました。
以下、プログラム

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.Variants;


var
  s : string;
  a,b : single;
  s1,S2: string;
  elm : TArray;
  //sh : TStringHelper;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
   //sh : TStringHelper

   //オーバーロードの1つ目
   //オープン配列を使用した形です。
   writeln('overload1:オープン配列');
   s := s.Join(',',['ミリー','ハイネ']);
   write('OK:');
   writeln(s);
   writeln;

   s1 := '2.17'; s2 := '9.19';
   s := s.Join(',',[s1,s2]);
   write('OK:');
   writeln(s);
   writeln;

   //文字列以外の型だとうまく出力できないようです。
   //空文字が出力されます。
   a := 2.17; b := 9.19;
   s := s.Join(',',[a,b]);
   write('NG');
   writeln(s);
   writeln;


   //オーバーロードの2つ目
   //文字列配列の結合開始位置(0基数)と数を指定
   //この例では、ニーナ,ベルト・サタンと表示します。
   //文字列配列作成の為にとりあえず分割
   s := 'ドッペ,パックン,ニーナ,ベルト・サタン,キノッピー';
   elm := s.Split([',']);
   writeln('overload2:開始位置と数を指定');
   writeln('元の文字列配列');
   for s1 in elm do
   begin
     writeln(s1);
   end;
   writeln('0基数で2番目の文字列から2個の文字列を結合');
   s := s.Join(',',elm,2,2);
   writeln(s);
   writeln;

   readln;



  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

実行結果は

です。

Splitのオーバーロード

Delphi XE3のオーバーロードを試してみた。
各オーバーロードの内容はプログラム中のコメントに
記載しました。

program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s,s1 : string;
  elm : TArray;
  elm2 : TArray;
  //sh : TStringHelper;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
   //sh : TStringHelper
   s := 'ドッペ,パックン,ニーナ,,ベルト・サタン,,キノッピー';
   //Writeln(s);

   //カンマで分割
   //オーバーロードの1つ目、第二引数に正の整数を入れると
   //先頭から指定した個数だけ分割します。
   //分割できる数以上の数を指定すると無視します。
   //この場合は、ドッペとパックンだけを切り出します。
   elm := s.Split([','],2);
   write('overload1:');writeln(s);
   //分割した要素を表示
   for s1 in elm do
   begin
     writeln(s1);
   end;

   writeln;

   //結合（念のため文字列を初期化)
   //s := '';
   //Writeln(s);

   //s := s.Join(',',elm);
   //Writeln(s);


   //オーバーロードの2つ目、第二引数に
   //TStringSplitOptions.ExcludeEmptyを指定すると
   //空文字を無視して切り出します。
   //TStringSplitOptionsを指定しない場合、あるいは
   //TStringSplitOptions.Noneを指定した場合は
   //空文字も1つとして切り出します。
   elm2 := s.Split([','],TStringSplitOptions.None);
   write('overload2-1:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;

   elm2 := s.Split([','],TStringSplitOptions.ExcludeEmpty);
   write('overload2-2:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;


   //オーバーロードの3つ目、第二引数に正の整数を入れると
   //先頭から指定した個数だけ分割します。
   //このときTStringSplitOptions.ExcludeEmptyを指定すると
   //空文字を無視して切り出します。
   //TStringSplitOptionsを指定しない場合、あるいは
   //TStringSplitOptions.Noneを指定した場合は
   //空文字も1つとして切り出します。
   //この場合はベルト・サタンも切り出します。
   elm2 := s.Split([','],4,TStringSplitOptions.ExcludeEmpty);
   write('overload3:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;

   //オーバーロードの4つ目、セパレータに文字列を指定する
   //こともできます。
   //この場合は、ドッペ,パッと,ニーナ,,ベルト・サタン,,キノッピー
   //に分割されます。
   //(セパレータにCRLFを指定することが可能です。)
   elm2 := s.Split(['クン'],TStringSplitOptions.None);
   write('overload4:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;


   //オーバーロードの5つ目、セパレータに文字列を指定したうえで
   //分割した結果を取り出すことも可能です。
   //この場合は、ドッペ,パッだけを取り出します。
   //に分割されます。
   elm2 := s.Split(['クン'],1,TStringSplitOptions.None);
   write('overload5:');writeln(s);
   for s1 in elm2 do
   begin
     writeln(s1);
   end;
   writeln;


   readln;


  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

で実際に実行した結果のビットマップが

です。

追伸：サンプルに使用した文字列がマイナーすぎたようなので、ちょっとだけわかりやすい
ものにしました。

SplitとJoin

Delphi XE3で新たに導入されたStringHelperを使ってみた。 使ったのはJoinとSplit。
それぞれ一番簡単な呼び出し形式です。
以下、プログラム

unit Unit1;
program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s : string;
  elm : TArray;
  //sh : TStringHelper;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
   //sh : TStringHelper
   s := 'キャサリン,さをり,ツネアキ,ハゲミーナ,ヒデオ';
   Writeln(s);

   //カンマで分割
   elm := s.Split([',']);

   //分割した要素を表示
   for s in elm do
   begin
     writeln(s);
   end;

   //結合（念のため文字列を初期化)
   s := '';
   s := s.Join(',',elm);

   Writeln(s);
   readln;



  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

で実際に実行した結果が、

です。