TZipFile.ZipDirectoryContentsのCOMラッパー

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

以下、ソース

view plainprint?

1. unit DirZipImp;  
2.   
3. {$WARN SYMBOL_PLATFORM OFF}  
4.   
5. interface  
6.   
7. uses  
8.   ComObj, ActiveX, SimpleDirZip_TLB, StdVcl;  
9.   
10. type  
11.   TDirZip = class(TAutoObject, IDirZip)  
12.   protected  
13.     procedure Compress(const SrcDirName, ZipFileName: WideString); safecall;  
14.     procedure Extract(const ZipFileName, DestDirName: WideString); safecall;  
15.   
16.   end;  
17.   
18. implementation  
19.   
20. uses ComServ,System.Zip;  
21.   
22. procedure TDirZip.Compress(const SrcDirName, ZipFileName: WideString);  
23. begin  
24.   TZipFile.ZipDirectoryContents(ZipFileName,SrcDirName);  
25. end;  
26.   
27. procedure TDirZip.Extract(const ZipFileName, DestDirName: WideString);  
28. begin  
29.   TZipFile.ExtractZipFile(ZipFileName,DestDirName);  
30. end;  
31.   
32. initialization  
33.   TAutoObjectFactory.Create(ComServer, TDirZip, Class_DirZip,  
34.     ciMultiInstance, tmApartment);  
35. end.  

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が作成したタイプライブラリーは

view plainprint?

1. // ************************************************************************ //  
2. // 警告  
3. // -------  
4. // このファイルはタイプ ライブラリ インポータまたはタイプ ライブラリ エディタで生成されています。  
5. // 構文エラーがない場合には、エディタはファイルへの変更を構文解析します。  
6. // ただし、エディタで変更したときは、このファイルは再生成され、  
7. // コメントやフォーマットの変更は失われます。  
8. // ************************************************************************ //  
9. // 2012/11/10 20:48:27 に生成されたファイル (- $Rev: 12980 $, 52614628)  
10.   
11. [  
12.   uuid(A77B985B-35E5-49A6-91CB-5BCD38D54C22),  
13.   version(1.0)  
14.   
15. ]  
16. library SimpleDirZip  
17. { 
18.  
19.   importlib("stdole2.tlb"); 
20.  
21.   interface IDirZip; 
22.   coclass DirZip; 
23.  
24.  
25.   [ 
26.     uuid(2CCEF7D7-0EF5-467E-BFEC-F4574049C00D), 
27.     helpstring("DirZip Object のディスパッチ インターフェイス"), 
28.     dual, 
29.     oleautomation 
30.   ] 
31.   interface IDirZip: IDispatch 
32.   { 
33.     [id(0x000000C9)] 
34.     HRESULT _stdcall Compress([in] BSTR SrcDirName, [in] BSTR ZipFileName); 
35.     [id(0x000000CA)] 
36.     HRESULT _stdcall Extract([in] BSTR ZipFileName, [in] BSTR DestDirName); 
37.   };  
38.   
39.   [  
40.     uuid(2B59D5EC-076B-4577-8C09-F3968AEFF615),  
41.     helpstring("DirZip Object")  
42.   ]  
43.   coclass DirZip  
44.   { 
45.     [default] interface IDirZip; 
46.   };  
47.   
48. };  
49.   
50. unit SimpleDirZip_TLB;  
51.   
52. // ************************************************************************ //  
53. // 警告  
54. // -------  
55. // このファイルで宣言されている型はタイプ ライブラリから読み取られたデータから  
56. // 生成されています。このタイプ ライブラリが明示的あるいは（このタイプ ライブラ  
57. // リを参照しているほかのタイプ ライブラリ経由で）間接的に再インポートされた  
58. // り、タイプ ライブライブラリの編集中にタイプ ライブラリ エディタの［更新］コマ  
59. // ンドを実行した場合、このファイルの内容はすべて再生成され、手動で加えた変更  
60. // はすべて失われます。  
61. // ************************************************************************ //  
62.   
63. // $Rev: 52393 $  
64. // 下に説明されたタイプ ライブラリから 2012/11/10 20:48:24 に生成されたファイル。  
65.   
66. // ************************************************************************  //  
67. // タイプ ライブラリ: C:\Users\saka_xps\Documents\Saka_Develop\DelProj\SimpleDirZip (1)  
68. // LIBID: {A77B985B-35E5-49A6-91CB-5BCD38D54C22}  
69. // LCID: 0  
70. // ヘルプファイル:  
71. // ヘルプ文字列:  
72. // 依存関係リスト:  
73. //   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)  
74. // SYS_KIND: SYS_WIN32  
75. // ************************************************************************ //  
76. {$TYPEDADDRESS OFF} // ポインタの型チェックをオフにしてコンパイルすること  
77. {$WARN SYMBOL_PLATFORM OFF}  
78. {$WRITEABLECONST ON}  
79. {$VARPROPSETTER ON}  
80. {$ALIGN 4}  
81.   
82. interface  
83.   
84. uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;  
85.   
86. // *********************************************************************//  
87. // タイプ ライブラリで宣言される GUID. 以下のプレフィックスを使う:  
88. //   Type Libraries     : LIBID_xxxx  
89. //   CoClasses          : CLASS_xxxx  
90. //   DISPInterfaces     : DIID_xxxx  
91. //   Non-DISP interfaces: IID_xxxx  
92. // *********************************************************************//  
93. const  
94.   // タイプ ライブラリのメジャー バージョンとマイナー バージョン  
95.   SimpleDirZipMajorVersion = 1;  
96.   SimpleDirZipMinorVersion = 0;  
97.   
98.   LIBID_SimpleDirZip: TGUID = '{A77B985B-35E5-49A6-91CB-5BCD38D54C22}';  
99.   
100.   IID_IDirZip: TGUID = '{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}';  
101.   CLASS_DirZip: TGUID = '{2B59D5EC-076B-4577-8C09-F3968AEFF615}';  
102. type  
103. // *********************************************************************//  
104. // タイプ ライブラリで宣言される前方参照  
105. // *********************************************************************//  
106.   IDirZip = interface;  
107.   IDirZipDisp = dispinterface;  
108. // *********************************************************************//  
109. // タイプ ライブラリで宣言される CoClass  
110. // (注意: ここで各 CoClass とデフォルトのインターフェイスをマッピングする)  
111. // *********************************************************************//  
112.   DirZip = IDirZip;  
113.   
114.   
115. // *********************************************************************//  
116. // インターフェイス: IDirZip  
117. // フラグ: (4416) Dual OleAutomation Dispatchable  
118. // GUID: {2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}  
119. // *********************************************************************//  
120.   IDirZip = interface(IDispatch)  
121.     ['{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}']  
122.     procedure Compress(const SrcDirName: WideString; const ZipFileName: WideString); safecall;  
123.     procedure Extract(const ZipFileName: WideString; const DestDirName: WideString); safecall;  
124.   end;  
125.   
126. // *********************************************************************//  
127. // DispIntf:  IDirZipDisp  
128. // フラグ:     (4416) Dual OleAutomation Dispatchable  
129. // GUID:      {2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}  
130. // *********************************************************************//  
131.   IDirZipDisp = dispinterface  
132.     ['{2CCEF7D7-0EF5-467E-BFEC-F4574049C00D}']  
133.     procedure Compress(const SrcDirName: WideString; const ZipFileName: WideString); dispid 201;  
134.     procedure Extract(const ZipFileName: WideString; const DestDirName: WideString); dispid 202;  
135.   end;  
136.   
137. // *********************************************************************//  
138. // クラス DirZip は、Create および CreateRemote メソッドを使用して  
139. // CoClass DirZip が公開するデフォルトのインターフェイス IDirZip の  
140. // インスタンスを作成する。このタイプ ライブラリのサーバーによって  
141. // 公開された CoClass オブジェクトに対し、オートメーションを行いたい  
142. // クライアントが用いるために、これらの関数が存在する。  
143. // *********************************************************************//  
144.   CoDirZip = class  
145.     class function Create: IDirZip;  
146.     class function CreateRemote(const MachineName: string): IDirZip;  
147.   end;  
148.   
149. implementation  
150.   
151. uses System.Win.ComObj;  
152.   
153. class function CoDirZip.Create: IDirZip;  
154. begin  
155.   Result := CreateComObject(CLASS_DirZip) as IDirZip;  
156. end;  
157.   
158. class function CoDirZip.CreateRemote(const MachineName: string): IDirZip;  
159. begin  
160.   Result := CreateRemoteComObject(MachineName, CLASS_DirZip) as IDirZip;  
161. end;  
162.   
163. end.  

// ************************************************************************ //
// 警告
// -------
// このファイルはタイプ ライブラリ インポータまたはタイプ ライブラリ エディタで生成されています。
// 構文エラーがない場合には、エディタはファイルへの変更を構文解析します。
// ただし、エディタで変更したときは、このファイルは再生成され、
// コメントやフォーマットの変更は失われます。
// ************************************************************************ //
// 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の呼び出しのサンプルは、

view plainprint?

1. Private Sub CommandButton1_Click()  
2.     Dim DirZip As SimpleDirZip.DirZip  
3.       
4.     Set DirZip = New SimpleDirZip.DirZip  
5.       
6.     Call DirZip.Compress("C:\Users\ppp", "C:\Users\pp\ppp.zip")      
7.     Set DirZip = Nothing  
8.       
9. End Sub  
10.   
11. Private Sub CommandButton2_Click()  
12.       
13.     Dim DirZip As SimpleDirZip.DirZip  
14.       
15.     Set DirZip = New SimpleDirZip.DirZip  
16.       
17.     Call DirZip.Extract("C:\Users\pp\ppp.zip", "C:\Users\pp\p")  
18.       
19.     Set DirZip = Nothing  
20.   
21. End Sub  

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では消せたんだけど・・・・。