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では消せたんだけど・・・・。
0 件のコメント:
コメントを投稿