publishedなメソッドを隠す(ネストした型宣言使用編)

前回の続きです。

さて、最近のDelphiでは、ネストした型宣言が可能で、クラス宣言の中にクラスの宣言ができます。

この機能を使って、クラスの使用者からpublishedなメソッドを隠すことを試してみました。

以下、ソースです。

先ず、 【関数名でメソッドが呼び出されるクラスのサンプル】

view plainprint?

1. unit Unit2;  
2.   
3. interface  
4.   
5.   type TMyCallCalc = class  
6.     public  
7.       function CallCalc(CalcName : string; a, b: double) : double;  
8.     private  
9.       type TMyCalc = class  
10.         published  
11.           function Add(a,b : double) : double;  
12.           function Subtract(a,b : double) : double;  
13.       end;  
14.   
15.   end;  
16.   
17.   
18. implementation  
19. { TMyCalc }  
20.   
21. function TMyCallCalc.TMyCalc.Add(a, b: double): double;  
22. begin  
23.   Result := a + b;  
24. end;  
25.   
26. function TMyCallCalc.TMyCalc.Subtract(a, b: double): double;  
27. begin  
28.   Result := a - b;  
29. end;  
30.   
31.   
32. type TMyCalcFunc = function(a,b : double) : double of object;  
33.   
34. function TMyCallCalc.CallCalc(CalcName : string; a, b: double) : double;  
35. var  
36.   MyCalc     : TMyCalc;  
37.   MyCalcFunc : TMyCalcFunc;  
38.   MethodVar : TMethod;  
39. begin  
40.   
41.   MyCalc := TMyCalc.Create;  
42.   try  
43.     MethodVar.Data := MyCalc;  
44.     MethodVar.Code := MyCalc.MethodAddress(CalcName);  
45.   
46.   
47.     if Assigned(MethodVar.Code) then  
48.     begin  
49.       MyCalcFunc := TMyCalcFunc(MethodVar);  
50.       Result := MyCalcFunc(a,b);  
51.     end;  
52.   finally  
53.     MyCalc.Free;  
54.   end;  
55.   
56. end;  
57.   
58. end.  

unit Unit2;

interface

  type TMyCallCalc = class
    public
      function CallCalc(CalcName : string; a, b: double) : double;
    private
      type TMyCalc = class
        published
          function Add(a,b : double) : double;
          function Subtract(a,b : double) : double;
      end;

  end;


implementation
{ TMyCalc }

function TMyCallCalc.TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCallCalc.TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;


type TMyCalcFunc = function(a,b : double) : double of object;

function TMyCallCalc.CallCalc(CalcName : string; a, b: double) : double;
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  MethodVar : TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    MethodVar.Data := MyCalc;
    MethodVar.Code := MyCalc.MethodAddress(CalcName);


    if Assigned(MethodVar.Code) then
    begin
      MyCalcFunc := TMyCalcFunc(MethodVar);
      Result := MyCalcFunc(a,b);
    end;
  finally
    MyCalc.Free;
  end;

end;

end.

親クラスのprivateセクションにpublishedなメソッドを持つ子クラスを宣言しています。
これで、ユニットの使用者からは、子クラスのメソッドの宣言が見えなくなり、直接呼び出す
ことができなくなります。
ユニットの使用者には、publicセクションにメソッドを宣言することで、間接的に目的の
メソッドが呼び出せるようにします。

次に上記のクラスを使用するコード

view plainprint?

1. unit Unit1;  
2.   
3. interface  
4.   
5. uses  
6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  
7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;  
8.   
9. type  
10.   TForm1 = class(TForm)  
11.     Button1: TButton;  
12.     Button2: TButton;  
13.     LabeledEdit1: TLabeledEdit;  
14.     LabeledEdit2: TLabeledEdit;  
15.     StaticText1: TStaticText;  
16.     StaticText2: TStaticText;  
17.     procedure OnCalcBtnClick(Sender: TObject);  
18.   private  
19.     { Private 宣言 }  
20.   public  
21.     { Public 宣言 }  
22.   end;  
23.   
24. var  
25.   Form1: TForm1;  
26.   
27. implementation  
28.   
29. {$R *.dfm}  
30.   
31. uses Unit2;  
32.   
33. procedure TForm1.OnCalcBtnClick(Sender: TObject);  
34. var  
35.   CallCalc : TMyCallCalc;  
36. begin  
37.   CallCalc := TMyCallCalc.Create;  
38.   try  
39.     StaticText2.Caption := FloatToStr(CallCalc.CallCalc(  
40.                                     TButton(Sender).Caption,  
41.                                     StrToFloat(LabeledEdit1.Text),  
42.                                     StrToFloat(LabeledEdit2.Text)));  
43.   finally  
44.     CallCalc.Free;  
45.   end;  
46.   
47. end;  
48.   
49. end.  

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
var
  CallCalc : TMyCallCalc;
begin
  CallCalc := TMyCallCalc.Create;
  try
    StaticText2.Caption := FloatToStr(CallCalc.CallCalc(
                                    TButton(Sender).Caption,
                                    StrToFloat(LabeledEdit1.Text),
                                    StrToFloat(LabeledEdit2.Text)));
  finally
    CallCalc.Free;
  end;

end;

end.

ユニットを使用する側からは子クラスが見えませんので、親クラスのpublicなメソッドのみが
使用できます。

publishedなメソッドを隠す

前回の続きです。

TObjectのMethodAddressメソッドを使用すれば関数名（文字列）でメソッドをコールできます。

しかし、 MethodAddressメソッドでメソッドのアドレスを取得するには、可視性をpublishedに
する必要があり、 publishedにした瞬間にメソッドの存在が丸わかりになってしまいます。

前回の例のような単純な演算であればまあ良いかと思うのですが、いわゆるFactoryメソッド
とかだと、使用者にその存在を隠したい場合があり、このままではちょっと不完全です。

さて、どうしようか？というのが今回のテーマになります。(2010以降の拡張Rttiを使えば良い
というのはあるのですが、今回は別の方法を考えます。）

ところで、DelphiのUnitのimplementationセクションで定義した型（クラスを含む）は別のユニット
から参照できない仕様となっています。

したがって、クラスの定義を  implementation で行えば、外部から処理の存在を隠したうえで
 MethodAddressメソッド が使用可能なクラスができそうです。

で、実際に、作ってみました。

先ずは、【メソッドポインタ経由で呼び出されるクラスのサンプル】

view plainprint?

1. unit Unit2;  
2.   
3. interface  
4.   
5.   function CallCalc(CalcName : string; a, b: double) : double;  
6.   
7. implementation  
8.   
9.   type TMyCalc = class  
10.   published  
11.     function Add(a,b : double) : double;  
12.     function Subtract(a,b : double) : double;  
13.   end;  
14.   
15.   type TMyCalcFunc = function(a,b : double) : double of object;  
16.   
17. { TMyCalc }  
18.   
19. function TMyCalc.Add(a, b: double): double;  
20. begin  
21.   Result := a + b;  
22. end;  
23.   
24. function TMyCalc.Subtract(a, b: double): double;  
25. begin  
26.   Result := a - b;  
27. end;  
28.   
29.   
30. function CallCalc(CalcName : string; a, b: double) : double;  
31. var  
32.   MyCalc     : TMyCalc;  
33.   MyCalcFunc : TMyCalcFunc;  
34.   MethodVar : TMethod;  
35. begin  
36.   
37.   MyCalc := TMyCalc.Create;  
38.   try  
39.     MethodVar.Data := MyCalc;  
40.     MethodVar.Code := MyCalc.MethodAddress(CalcName);  
41.   
42.   
43.     if Assigned(MethodVar.Code) then  
44.     begin  
45.       MyCalcFunc := TMyCalcFunc(MethodVar);  
46.       Result := MyCalcFunc(a,b);  
47.     end;  
48.   finally  
49.     MyCalc.Free;  
50.   end;  
51.   
52. end;  
53.   
54. end.  

unit Unit2;

interface

  function CallCalc(CalcName : string; a, b: double) : double;

implementation

  type TMyCalc = class
  published
    function Add(a,b : double) : double;
    function Subtract(a,b : double) : double;
  end;

  type TMyCalcFunc = function(a,b : double) : double of object;

{ TMyCalc }

function TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;


function CallCalc(CalcName : string; a, b: double) : double;
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  MethodVar : TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    MethodVar.Data := MyCalc;
    MethodVar.Code := MyCalc.MethodAddress(CalcName);


    if Assigned(MethodVar.Code) then
    begin
      MyCalcFunc := TMyCalcFunc(MethodVar);
      Result := MyCalcFunc(a,b);
    end;
  finally
    MyCalc.Free;
  end;

end;

end.

publishedの可視性を持つクラスをimplementationセクションに定義しています。
但し、そのままでは、外部のユニットからメソッドをコールできませんので、
外部からのアクセスようにラッパー関数を定義しています。

次に、【関数名を文字列で指定して処理を呼び出すサンプル】

view plainprint?

1. interface  
2.   
3. uses  
4.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  
5.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;  
6.   
7. type  
8.   TForm1 = class(TForm)  
9.     Button1: TButton;  
10.     Button2: TButton;  
11.     LabeledEdit1: TLabeledEdit;  
12.     LabeledEdit2: TLabeledEdit;  
13.     StaticText1: TStaticText;  
14.     StaticText2: TStaticText;  
15.     procedure OnCalcBtnClick(Sender: TObject);  
16.   private  
17.     { Private 宣言 }  
18.   public  
19.     { Public 宣言 }  
20.   end;  
21.   
22. var  
23.   Form1: TForm1;  
24.   
25. implementation  
26.   
27. {$R *.dfm}  
28.   
29. uses Unit2;  
30.   
31. procedure TForm1.OnCalcBtnClick(Sender: TObject);  
32. begin  
33.   StaticText2.Caption := FloatToStr(CallCalc(  
34.                                     TButton(Sender).Caption,  
35.                                     StrToFloat(LabeledEdit1.Text),  
36.                                     StrToFloat(LabeledEdit2.Text)));  
37. end;  
38.   
39. end.  

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
begin
  StaticText2.Caption := FloatToStr(CallCalc(
                                    TButton(Sender).Caption,
                                    StrToFloat(LabeledEdit1.Text),
                                    StrToFloat(LabeledEdit2.Text)));
end;

end.

unit2のinterfaceセクションに定義したラッパーを使って処理を呼び出しています。


implementationセクションにクラスを定義することで、外部からその存在を隠しつつ
メソッド名を文字列で指定してメソッドをコールすることが可能です。

但し、この方法ですとクラスそのものも隠れてしまいすのでもう少しなんとかしたい
ところです。

ネストした型宣言が可能なバージョンのDelphiであれば、何とかできそうな気が
しますが、その検証はまた後日・・・

メソッドを名前で呼び出す

前回の続きです。

関数(function)のメソッドポインタが定義できれば、TObjectのMethodAddressを使って
関数名を（文字で）指定してコールすることが可能です。

以下、サンプルソース。

先ずは、【メソッドポインタ経由で呼び出されるクラスのサンプル】

view plainprint?

1. unit Unit2;  
2.   
3. interface  
4.   
5.   type TMyCalc = class  
6.   published  
7.     function Add(a,b : double) : double;  
8.     function Subtract(a,b : double) : double;  
9.   end;  
10.   
11. implementation  
12.   
13. { TMyCalc }  
14.   
15. function TMyCalc.Add(a, b: double): double;  
16. begin  
17.   Result := a + b;  
18. end;  
19.   
20. function TMyCalc.Subtract(a, b: double): double;  
21. begin  
22.   Result := a - b;  
23. end;  
24.   
25. end.  

unit Unit2;

interface

  type TMyCalc = class
  published
    function Add(a,b : double) : double;
    function Subtract(a,b : double) : double;
  end;

implementation

{ TMyCalc }

function TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;

end.

MethodAddressを使用するためにpublishedを指定してることに注意願います。

次に、【関数名を文字列で指定して処理を呼び出すサンプル】

view plainprint?

1. unit Unit1;  
2.   
3. interface  
4.   
5. uses  
6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  
7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;  
8.   
9. type  
10.   TForm1 = class(TForm)  
11.     Button1: TButton;  
12.     Button2: TButton;  
13.     LabeledEdit1: TLabeledEdit;  
14.     LabeledEdit2: TLabeledEdit;  
15.     StaticText1: TStaticText;  
16.     StaticText2: TStaticText;  
17.     procedure OnCalcBtnClick(Sender: TObject);  
18.   private  
19.     { Private 宣言 }  
20.   public  
21.     { Public 宣言 }  
22.   end;  
23.   
24. var  
25.   Form1: TForm1;  
26.   
27. implementation  
28.   
29. {$R *.dfm}  
30.   
31. uses Unit2;  
32.   
33. type TMyCalcFunc = function(a,b : double) : double of object;  
34.   
35. procedure TForm1.OnCalcBtnClick(Sender: TObject);  
36. var  
37.   MyCalc     : TMyCalc;  
38.   MyCalcFunc : TMyCalcFunc;  
39.   MethodVar : TMethod;  
40. begin  
41.   
42.   MyCalc := TMyCalc.Create;  
43.   try  
44.     MethodVar.Data := MyCalc;  
45.     MethodVar.Code := MyCalc.MethodAddress(TButton(Sender).Caption);  
46.   
47.   
48.     if Assigned(MethodVar.Code) then  
49.     begin  
50.       MyCalcFunc := TMyCalcFunc(MethodVar);  
51.       StaticText2.Caption := FloatToStr(MyCalcFunc(StrToFloat(LabeledEdit1.Text),StrToFloat(LabeledEdit2.Text)));  
52.     end;  
53.   finally  
54.     MyCalc.Free;  
55.   end;  
56.   
57. end;  
58.   
59. end.  

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

type TMyCalcFunc = function(a,b : double) : double of object;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  MethodVar : TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    MethodVar.Data := MyCalc;
    MethodVar.Code := MyCalc.MethodAddress(TButton(Sender).Caption);


    if Assigned(MethodVar.Code) then
    begin
      MyCalcFunc := TMyCalcFunc(MethodVar);
      StaticText2.Caption := FloatToStr(MyCalcFunc(StrToFloat(LabeledEdit1.Text),StrToFloat(LabeledEdit2.Text)));
    end;
  finally
    MyCalc.Free;
  end;

end;

end.

ボタンのキャプション名が名前のメソッドが定義されているという前提で、ボタンのキャプションを
使って関数をコールして、結果を求めています。

関数のメソッドポインタ

メソッドポインタでfunctionを使った例のサンプルです。
あまり見当たらなかったので、備忘録がわりに公開しときます。


【メソッドポインタ経由でfunctionを呼び出すサンプル】

view plainprint?

1. unit Unit1;  
2.   
3. interface  
4.   
5. uses  
6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  
7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;  
8.   
9. type  
10.   TForm1 = class(TForm)  
11.     Button1: TButton;  
12.     Button2: TButton;  
13.     LabeledEdit1: TLabeledEdit;  
14.     LabeledEdit2: TLabeledEdit;  
15.     StaticText1: TStaticText;  
16.     StaticText2: TStaticText;  
17.     procedure OnCalcBtnClick(Sender: TObject);  
18.   private  
19.     { Private 宣言 }  
20.   public  
21.     { Public 宣言 }  
22.   end;  
23.   
24. var  
25.   Form1: TForm1;  
26.   
27. implementation  
28.   
29. {$R *.dfm}  
30.   
31. uses Unit2;  
32.   
33. type TMyCalcFunc = function(a,b : double) : double of object;  
34.   
35. procedure TForm1.OnCalcBtnClick(Sender: TObject);  
36. var  
37.   MyCalc     : TMyCalc;  
38.   MyCalcFunc : TMyCalcFunc;  
39.   Method: TMethod;  
40. begin  
41.   
42.   MyCalc := TMyCalc.Create;  
43.   try  
44.     //Method.Data := MyCalc;  
45.     if TButton(Sender).Caption = 'Add' then  
46.     begin  
47.       MyCalcFunc := MyCalc.Add;  
48.     end  
49.     else  
50.     begin  
51.       MyCalcFunc := MyCalc.Subtract;  
52.     end;  
53.     StaticText2.Caption := FloatToStr(MyCalcFunc(StrToFloat(LabeledEdit1.Text),StrToFloat(LabeledEdit2.Text)));  
54.   finally  
55.     MyCalc.Free;  
56.   end;  
57.   
58. end;  
59.   
60. end.  

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    procedure OnCalcBtnClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

type TMyCalcFunc = function(a,b : double) : double of object;

procedure TForm1.OnCalcBtnClick(Sender: TObject);
var
  MyCalc     : TMyCalc;
  MyCalcFunc : TMyCalcFunc;
  Method: TMethod;
begin

  MyCalc := TMyCalc.Create;
  try
    //Method.Data := MyCalc;
    if TButton(Sender).Caption = 'Add' then
    begin
      MyCalcFunc := MyCalc.Add;
    end
    else
    begin
      MyCalcFunc := MyCalc.Subtract;
    end;
    StaticText2.Caption := FloatToStr(MyCalcFunc(StrToFloat(LabeledEdit1.Text),StrToFloat(LabeledEdit2.Text)));
  finally
    MyCalc.Free;
  end;

end;

end.

【メソッドポインタ経由で呼び出されるクラスのサンプル】

view plainprint?

1. unit Unit2;  
2.   
3. interface  
4.   
5.   type TMyCalc = class  
6.     function Add(a,b : double) : double;  
7.     function Subtract(a,b : double) : double;  
8.   end;  
9.   
10. implementation  
11.   
12. { TMyCalc }  
13.   
14. function TMyCalc.Add(a, b: double): double;  
15. begin  
16.   Result := a + b;  
17. end;  
18.   
19. function TMyCalc.Subtract(a, b: double): double;  
20. begin  
21.   Result := a - b;  
22. end;  
23.   
24. end.  

unit Unit2;

interface

  type TMyCalc = class
    function Add(a,b : double) : double;
    function Subtract(a,b : double) : double;
  end;

implementation

{ TMyCalc }

function TMyCalc.Add(a, b: double): double;
begin
  Result := a + b;
end;

function TMyCalc.Subtract(a, b: double): double;
begin
  Result := a - b;
end;

end.

メソッドポインタはヘルプにもあるように、

Type 型名 = "メソッドの定義" of object

のように宣言します。

ここで、"メソッドの定義"は、通常の手続き（関数）の名前を抜いたものになるので、
例えば、TObject型のSenderを引数に持ち、戻り値がない"メソッドの定義"は、

procedure(Sender : TObject)

同様に、Double型のaとbを引数に持ち、Double型の戻り値がある"メソッドの定義"は

function(a,b : Double) : Double

となります。

上記のサンプル1では、ボタンのキャプションに応じてif分で関数を切り替えています。

この例では、関数が2つだけなので、メソッドポインタ経由ではなく、直接目的の関数を
コールしたほうが良いのですが、
同じ型の引数を持つ関数が多数ある場合、メソッドポインタと、TObject.MethodAddressを
組み合わるとコード量を減らせる可能性があります。（上の例だとボタンのCaptionと関数名を
合わせおくことによりif文(あるいは、Case文）を無くすことが可能です。)

そのへんの話はまた後日・・・

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

AnsiExtractQotedStr

QuotedStr関数の存在は、知ってたけど、AnsiExtrctQuotedStrの存在は知らなかった。(^^ゞ
ってことで、使ってみた。
以下ソース

view plainprint?

1. program Project1;  
2.   
3. {$APPTYPE CONSOLE}  
4.   
5. {$R *.res}  
6.   
7. uses  
8.   System.SysUtils;  
9.   
10. var  
11.   s :String;  
12.   src : PWideChar;  
13. begin  
14.   try  
15.     { TODO -oUser -cConsole メイン : ここにコードを記述してください }  
16.     s := 'ミリアリア';  
17.     Writeln(s);  
18.     s := QuotedStr(s);  
19.     Writeln(s);  
20.     src := PwideChar(s);  
21.     s := AnsiExtractQuotedStr(src,'''');  
22.     Writeln(s);  
23.   
24.     readln;  
25.   
26.   except  
27.     on E: Exception do  
28.       Writeln(E.ClassName, ': ', E.Message);  
29.   end;  
30. end.  

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

var
  s :String;
  src : PWideChar;
begin
  try
    { TODO -oUser -cConsole メイン : ここにコードを記述してください }
    s := 'ミリアリア';
    Writeln(s);
    s := QuotedStr(s);
    Writeln(s);
    src := PwideChar(s);
    s := AnsiExtractQuotedStr(src,'''');
    Writeln(s);

    readln;

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

AnsiExtractQuitedStr内のsrcのとこで、直接キャストしようとすると コンパイルエラーが出るので、一度変数受けでキャスト。
で実行結果は、

指定したフォルダの特定のファイルをSJISからUTF8に変更する

今の仕事で使用した、SJIS→UTF8のチャラツール。
ファイル数がすくなければ、手作業でするけど、ファイル数が多いのファイルが
サブディレクトリにわたるので、作ってみた。
諸般の事情により、Delphi2007で作ったので、UTF8への変換にはjclUnicodeの
TWideStringList、ファイルの走査にはJclFileUtilsのTJclFileEnumeratorを利用した。
（変換元ファイルのディレクトリ、変換先のディレクトリの指定にJvclの TJvDirectoryEdit
を使用した。）

以下ソースコード。

view plainprint?

1. unit Unit1;  
2.   
3. interface  
4.   
5. uses  
6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
7.   Dialogs,JclStrings, JclFileUtils, StdCtrls, Mask, JvExMask, JvToolEdit,jclUnicode;  
8.   
9. type  
10.   TForm1 = class(TForm)  
11.     Label1: TLabel;  
12.     Label2: TLabel;  
13.     JvDirectoryEdit1: TJvDirectoryEdit;  
14.     JvDirectoryEdit2: TJvDirectoryEdit;  
15.     Button1: TButton;  
16.     Memo1: TMemo;  
17.     Button2: TButton;  
18.     procedure Button1Click(Sender: TObject);  
19.     procedure FormCreate(Sender: TObject);  
20.     procedure FormClose(Sender: TObject; var Action: TCloseAction);  
21.     procedure Button2Click(Sender: TObject);  
22.   private  
23.     { Private declarations }  
24.     FFileEnumerator: TJclFileEnumerator;  
25.     FDirCount: Integer;  
26.     FTaskID: TFileSearchTaskID;  
27.     FT0: TDateTime;  
28.     procedure DirectoryEntered(const Directory: string);  
29.     procedure AddFile(const Directory: string; const FileInfo: TSearchRec);  
30.     procedure TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);  
31.   public  
32.     { Public declarations }  
33.   end;  
34.   
35. var  
36.   Form1: TForm1;  
37.   
38. implementation  
39. uses Types,StrUtils, VBLikeString;  
40. {$R *.dfm}  
41.   
42. { TForm1 }  
43.   
44. procedure TForm1.AddFile(const Directory: string; const FileInfo: TSearchRec);  
45. var  
46.   SourceFileName,TargetFileName : String;  
47.   TargetDir : String;  
48.   SourceText : TStringList;  
49.   TargetText : TWideStringList;  
50.   LineCount : Integer;  
51.   WorkStrings : TStringDynArray;  
52.   //RevArray : Array of String;  
53.   RevisionString : String;  
54.   IsHeaderArea : Boolean;  
55. begin  
56.   SourceFileName := Directory + FileInfo.Name;  
57.   
58.   //変換後ファイルの書き込み先フォルダは、元ファイルのフルパスの変換元フォルダに指定した  
59.   //文字列を変換後に指定したフォルダに置換すれば良い  
60.   TargetFileName := ReplaceText(SourceFileName,JvDirectoryEdit1.Text,JvDirectoryEdit2.Text);  
61.   TargetDir := ExtractFileDir(TargetFileName);  
62.   
63.   //ディレクトリがなければ作成する  
64.   if not(DirectoryExists(TargetDir)) then ForceDirectories(TargetDir);  
65.   
66.   SourceText := TStringList.Create;  
67.   try  
68.     SourceText.LoadFromFile(SourceFileName);  
69.     TargetText := TWideStringList.Create;  
70.     try  
71.       //TargetText.Text := ReplaceStr(SourceText.Text,'@CRLF',sLineBreak);  
72.       TargetText.Text := SourceText.Text;  
73.       TargetText.SaveUnicode := true;  
74.       TargetText.SaveFormat := sfUTF8;  
75.       TargetText.SaveToFile(TargetFileName);  
76.     finally  
77.       TargetText.Free;  
78.     end;  
79.   finally  
80.     SourceText.Free;  
81.   end;  
82.   Memo1.Lines.Add(SourceFileName);  
83. end;  
84.   
85. procedure TForm1.Button1Click(Sender: TObject);  
86. var  
87.   RootDirectories: TStrings;  
88. begin  
89.   
90.   FFileEnumerator.SearchOption[fsLastChangeAfter] := false;  
91.   FFileEnumerator.SearchOption[fsLastChangeBefore] := false;  
92.   
93.   RootDirectories := TStringList.Create;  
94.   try  
95.     StrToStrings(JvDirectoryEdit1.Text, DirSeparator, RootDirectories, False);  
96.     FFileEnumerator.RootDirectories := RootDirectories;  
97.   finally  
98.     RootDirectories.Free;  
99.   end;  
100.   FFileEnumerator.FileMask := '*.c;*.h';  
101.   FFileEnumerator.SearchOption[fsMinSize] := false;  
102.   FFileEnumerator.SearchOption[fsMaxSize] := false;  
103.   FFileEnumerator.IncludeSubDirectories := true;  
104.   FFileEnumerator.IncludeHiddenSubDirectories := true;  
105.   FFileEnumerator.CaseSensitiveSearch := false;  
106.   FDirCount := 0;  
107.   
108.   FT0 := Now;  
109.   FTaskID := FFileEnumerator.ForEach(AddFile);  
110.   
111. end;  
112.   
113. procedure TForm1.Button2Click(Sender: TObject);  
114. begin  
115.   FFileEnumerator.StopTask(FTaskID);  
116. end;  
117.   
118. procedure TForm1.DirectoryEntered(const Directory: string);  
119. begin  
120.   Inc(FDirCount);  
121. end;  
122.   
123. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
124. begin  
125.   FFileEnumerator.Free;  
126. end;  
127.   
128. procedure TForm1.FormCreate(Sender: TObject);  
129. begin  
130.   FFileEnumerator := TJclFileEnumerator.Create;  
131.   FFileEnumerator.OnEnterDirectory := DirectoryEntered;  
132.   FFileEnumerator.OnTerminateTask := TaskDone;  
133.   
134. end;  
135.   
136. procedure TForm1.TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);  
137. begin  
138.   //  
139. end;  
140.   
141. end.  

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,JclStrings, JclFileUtils, StdCtrls, Mask, JvExMask, JvToolEdit,jclUnicode;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    JvDirectoryEdit1: TJvDirectoryEdit;
    JvDirectoryEdit2: TJvDirectoryEdit;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    FFileEnumerator: TJclFileEnumerator;
    FDirCount: Integer;
    FTaskID: TFileSearchTaskID;
    FT0: TDateTime;
    procedure DirectoryEntered(const Directory: string);
    procedure AddFile(const Directory: string; const FileInfo: TSearchRec);
    procedure TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses Types,StrUtils, VBLikeString;
{$R *.dfm}

{ TForm1 }

procedure TForm1.AddFile(const Directory: string; const FileInfo: TSearchRec);
var
  SourceFileName,TargetFileName : String;
  TargetDir : String;
  SourceText : TStringList;
  TargetText : TWideStringList;
  LineCount : Integer;
  WorkStrings : TStringDynArray;
  //RevArray : Array of String;
  RevisionString : String;
  IsHeaderArea : Boolean;
begin
  SourceFileName := Directory + FileInfo.Name;

  //変換後ファイルの書き込み先フォルダは、元ファイルのフルパスの変換元フォルダに指定した
  //文字列を変換後に指定したフォルダに置換すれば良い
  TargetFileName := ReplaceText(SourceFileName,JvDirectoryEdit1.Text,JvDirectoryEdit2.Text);
  TargetDir := ExtractFileDir(TargetFileName);

  //ディレクトリがなければ作成する
  if not(DirectoryExists(TargetDir)) then ForceDirectories(TargetDir);

  SourceText := TStringList.Create;
  try
    SourceText.LoadFromFile(SourceFileName);
    TargetText := TWideStringList.Create;
    try
      //TargetText.Text := ReplaceStr(SourceText.Text,'@CRLF',sLineBreak);
      TargetText.Text := SourceText.Text;
      TargetText.SaveUnicode := true;
      TargetText.SaveFormat := sfUTF8;
      TargetText.SaveToFile(TargetFileName);
    finally
      TargetText.Free;
    end;
  finally
    SourceText.Free;
  end;
  Memo1.Lines.Add(SourceFileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  RootDirectories: TStrings;
begin

  FFileEnumerator.SearchOption[fsLastChangeAfter] := false;
  FFileEnumerator.SearchOption[fsLastChangeBefore] := false;

  RootDirectories := TStringList.Create;
  try
    StrToStrings(JvDirectoryEdit1.Text, DirSeparator, RootDirectories, False);
    FFileEnumerator.RootDirectories := RootDirectories;
  finally
    RootDirectories.Free;
  end;
  FFileEnumerator.FileMask := '*.c;*.h';
  FFileEnumerator.SearchOption[fsMinSize] := false;
  FFileEnumerator.SearchOption[fsMaxSize] := false;
  FFileEnumerator.IncludeSubDirectories := true;
  FFileEnumerator.IncludeHiddenSubDirectories := true;
  FFileEnumerator.CaseSensitiveSearch := false;
  FDirCount := 0;

  FT0 := Now;
  FTaskID := FFileEnumerator.ForEach(AddFile);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FFileEnumerator.StopTask(FTaskID);
end;

procedure TForm1.DirectoryEntered(const Directory: string);
begin
  Inc(FDirCount);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FFileEnumerator.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FFileEnumerator := TJclFileEnumerator.Create;
  FFileEnumerator.OnEnterDirectory := DirectoryEntered;
  FFileEnumerator.OnTerminateTask := TaskDone;

end;

procedure TForm1.TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean);
begin
  //
end;

end.

TJclFileEnumeratorは、ファイル検索の条件を設定したうえで、検索条件に該当するファイルが
見つかった場合に呼び出すメソッドを指定してForEcahメソッドを実行すれば、都度、指定した
メソッドを呼び出してくれるので、ForEachに指定しメソッドにSJIS→UTF8の変換処理を
書けばよい。（ソース上ではAddFile)

TStringListを使ってファイルを読み込み、そのテキストをTWideStringListに
渡して、 をTWideStringListでUTF-8を指定して保存することにより、UTF-8変換を
実施した。(このへんは、Delphi 2009以降ならもっとスマートにできる思う。）

Joinのオーバーロード

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

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

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

view plainprint?

1. program Project3;  
2.   
3. {$APPTYPE CONSOLE}  
4.   
5. {$R *.res}  
6.   
7. uses  
8.   System.SysUtils, System.Variants;  
9.   
10.   
11. var  
12.   s : string;  
13.   a,b : single;  
14.   s1,S2: string;  
15.   elm : TArray<string>;  
16.   //sh : TStringHelper;  
17. begin  
18.   try  
19.     { TODO -oUser -cConsole メイン : ここにコードを記述してください }  
20.    //sh : TStringHelper  
21.   
22.    //オーバーロードの1つ目  
23.    //オープン配列を使用した形です。  
24.    writeln('overload1:オープン配列');  
25.    s := s.Join(',',['ミリー','ハイネ']);  
26.    write('OK:');  
27.    writeln(s);  
28.    writeln;  
29.   
30.    s1 := '2.17'; s2 := '9.19';  
31.    s := s.Join(',',[s1,s2]);  
32.    write('OK:');  
33.    writeln(s);  
34.    writeln;  
35.   
36.    //文字列以外の型だとうまく出力できないようです。  
37.    //空文字が出力されます。  
38.    a := 2.17; b := 9.19;  
39.    s := s.Join(',',[a,b]);  
40.    write('NG');  
41.    writeln(s);  
42.    writeln;  
43.   
44.   
45.    //オーバーロードの2つ目  
46.    //文字列配列の結合開始位置(0基数)と数を指定  
47.    //この例では、ニーナ,ベルト・サタンと表示します。  
48.    //文字列配列作成の為にとりあえず分割  
49.    s := 'ドッペ,パックン,ニーナ,ベルト・サタン,キノッピー';  
50.    elm := s.Split([',']);  
51.    writeln('overload2:開始位置と数を指定');  
52.    writeln('元の文字列配列');  
53.    for s1 in elm do  
54.    begin  
55.      writeln(s1);  
56.    end;  
57.    writeln('0基数で2番目の文字列から2個の文字列を結合');  
58.    s := s.Join(',',elm,2,2);  
59.    writeln(s);  
60.    writeln;  
61.   
62.    readln;  
63.   
64.   
65.   
66.   except  
67.     on E: Exception do  
68.       Writeln(E.ClassName, ': ', E.Message);  
69.   end;  
70. end.  
71.   
72. </string>  

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のオーバーロードを試してみた。
各オーバーロードの内容はプログラム中のコメントに
記載しました。

view plainprint?

1. program Project2;  
2.   
3. {$APPTYPE CONSOLE}  
4.   
5. {$R *.res}  
6.   
7. uses  
8.   System.SysUtils;  
9.   
10. var  
11.   s,s1 : string;  
12.   elm : TArray<string>;  
13.   elm2 : TArray<string>;  
14.   //sh : TStringHelper;  
15. begin  
16.   try  
17.     { TODO -oUser -cConsole メイン : ここにコードを記述してください }  
18.    //sh : TStringHelper  
19.    s := 'ドッペ,パックン,ニーナ,,ベルト・サタン,,キノッピー';  
20.    //Writeln(s);  
21.   
22.    //カンマで分割  
23.    //オーバーロードの1つ目、第二引数に正の整数を入れると  
24.    //先頭から指定した個数だけ分割します。  
25.    //分割できる数以上の数を指定すると無視します。  
26.    //この場合は、ドッペとパックンだけを切り出します。  
27.    elm := s.Split([','],2);  
28.    write('overload1:');writeln(s);  
29.    //分割した要素を表示  
30.    for s1 in elm do  
31.    begin  
32.      writeln(s1);  
33.    end;  
34.   
35.    writeln;  
36.   
37.    //結合（念のため文字列を初期化)  
38.    //s := '';  
39.    //Writeln(s);  
40.   
41.    //s := s.Join(',',elm);  
42.    //Writeln(s);  
43.   
44.   
45.    //オーバーロードの2つ目、第二引数に  
46.    //TStringSplitOptions.ExcludeEmptyを指定すると  
47.    //空文字を無視して切り出します。  
48.    //TStringSplitOptionsを指定しない場合、あるいは  
49.    //TStringSplitOptions.Noneを指定した場合は  
50.    //空文字も1つとして切り出します。  
51.    elm2 := s.Split([','],TStringSplitOptions.None);  
52.    write('overload2-1:');writeln(s);  
53.    for s1 in elm2 do  
54.    begin  
55.      writeln(s1);  
56.    end;  
57.    writeln;  
58.   
59.    elm2 := s.Split([','],TStringSplitOptions.ExcludeEmpty);  
60.    write('overload2-2:');writeln(s);  
61.    for s1 in elm2 do  
62.    begin  
63.      writeln(s1);  
64.    end;  
65.    writeln;  
66.   
67.   
68.    //オーバーロードの3つ目、第二引数に正の整数を入れると  
69.    //先頭から指定した個数だけ分割します。  
70.    //このときTStringSplitOptions.ExcludeEmptyを指定すると  
71.    //空文字を無視して切り出します。  
72.    //TStringSplitOptionsを指定しない場合、あるいは  
73.    //TStringSplitOptions.Noneを指定した場合は  
74.    //空文字も1つとして切り出します。  
75.    //この場合はベルト・サタンも切り出します。  
76.    elm2 := s.Split([','],4,TStringSplitOptions.ExcludeEmpty);  
77.    write('overload3:');writeln(s);  
78.    for s1 in elm2 do  
79.    begin  
80.      writeln(s1);  
81.    end;  
82.    writeln;  
83.   
84.    //オーバーロードの4つ目、セパレータに文字列を指定する  
85.    //こともできます。  
86.    //この場合は、ドッペ,パッと,ニーナ,,ベルト・サタン,,キノッピー  
87.    //に分割されます。  
88.    //(セパレータにCRLFを指定することが可能です。)  
89.    elm2 := s.Split(['クン'],TStringSplitOptions.None);  
90.    write('overload4:');writeln(s);  
91.    for s1 in elm2 do  
92.    begin  
93.      writeln(s1);  
94.    end;  
95.    writeln;  
96.   
97.   
98.    //オーバーロードの5つ目、セパレータに文字列を指定したうえで  
99.    //分割した結果を取り出すことも可能です。  
100.    //この場合は、ドッペ,パッだけを取り出します。  
101.    //に分割されます。  
102.    elm2 := s.Split(['クン'],1,TStringSplitOptions.None);  
103.    write('overload5:');writeln(s);  
104.    for s1 in elm2 do  
105.    begin  
106.      writeln(s1);  
107.    end;  
108.    writeln;  
109.   
110.   
111.    readln;  
112.   
113.   
114.   except  
115.     on E: Exception do  
116.       Writeln(E.ClassName, ': ', E.Message);  
117.   end;  
118. end.  
119. </string></string>  

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。
それぞれ一番簡単な呼び出し形式です。
以下、プログラム

view plainprint?

1. unit Unit1;  
2. program Project1;  
3.   
4. {$APPTYPE CONSOLE}  
5.   
6. {$R *.res}  
7.   
8. uses  
9.   System.SysUtils;  
10.   
11. var  
12.   s : string;  
13.   elm : TArray<string>;  
14.   //sh : TStringHelper;  
15. begin  
16.   try  
17.     { TODO -oUser -cConsole メイン : ここにコードを記述してください }  
18.    //sh : TStringHelper  
19.    s := 'キャサリン,さをり,ツネアキ,ハゲミーナ,ヒデオ';  
20.    Writeln(s);  
21.   
22.    //カンマで分割  
23.    elm := s.Split([',']);  
24.   
25.    //分割した要素を表示  
26.    for s in elm do  
27.    begin  
28.      writeln(s);  
29.    end;  
30.   
31.    //結合（念のため文字列を初期化)  
32.    s := '';  
33.    s := s.Join(',',elm);  
34.   
35.    Writeln(s);  
36.    readln;  
37.   
38.   
39.   
40.   except  
41.     on E: Exception do  
42.       Writeln(E.ClassName, ': ', E.Message);  
43.   end;  
44. end.  
45. </string>  

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.

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

です。

DelphiでExcelブック内のシート一覧を取得し表示する(dbGo経由)

前のブログで、ExcelのTypeライブラリーを使ってシート一覧を取得しましたが
ついでといっては、なんですが、dbGo(Ado)を使って、シート一覧を取得してみます。

TAdoQueryを使ってSQL文で、テーブル一覧を取得できないか、ちょっと調べたましたが
無理そうだったので、ここでは、

TADOConnection.OpenSchema (
 　　　　　　　 const Schema: TSchemaInfo;  
　　　　　　　　const Restrictions: OleVariant;
　　　　　　　  const SchemaID: OleVariant;
                 DataSet: TADODataSet);

メソッドを使ってテーブルを取得します。

方法は、簡単で、

OpenSchema関数のパラメータ

　　　　　Schemaに　TSchemaInfo.siTables
　　　　　DataSetに　スキーマ取得結果の書き込み先のレコードセットを指定します。

　　　　　 
　　　　　また、今回は、RestrictionsとSchemaIDは使用しませんのでEmptyParamを指定します。


さて、やってみます。

フォームにTADOConnectionを配置し、ConnectionStringの

　　　ProviderにMicrosoft.ACE.OLEDB.12.0
　　　Data SourceにExcelのワークブックのパス
　　　Extended PropertiesにExcel 12.0(Excel2010の場合)

を指定します。

（ConnectionStringについては、http://connectionstrings.com/ が参考になります。)


次に結果格納先としての TADODataSetコンポーネントを配置し、Connectionプロパティに
上記の TADOConnectionコンポーネントを指定します。

あとは、通常の操作で、DataSource,DbGridを配置し、それぞれ接続します。

あとはボタンなどを配置しそのイベントハンドラに

  ADOConnection1.Connected := true;
  ADOConnection1.OpenSchema(siTables, EmptyParam, EmptyParam,ADODataSet1);
 
のようなコードを書きます。

で実行すれば、

のように結果が得られます（右側)

 
 
なお、torry's Delphiのページにもうちょっと詳しいサンプルがあります。http://www.swissdelphicenter.ch/torry/showcode.php?id=1433

また、AdoでのExcelのSchema,については、MSのHELP
http://support.microsoft.com/kb/257819/ja


が参考になります。

DelphiでExcelブック内のシート一覧を取得し表示する

先日、DelphiでExcelのWorkSheetを列挙しながらSheetを編集する処理を作成したとき、
思いもよらずはまったので、自分メモとして保存。

DelphiからExcelを操作する方法としては、

1. Excelのタイプライブラリーをインポート
2. dbGoを使用する
3. サードパーティのコンポーネントを使用する
4. ・・・

などの方法があげらるが、

今回は、1.タイプタイプライブラリーをインポートしてExcelを操作しシート名を一覧表示する
処理をつかった。

以下、ソース

view plainprint?

1. unit Unit1;  
2.   
3. interface  
4.   
5. uses  
6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  
7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;  
8.   
9. type  
10.   TForm1 = class(TForm)  
11.     Button1: TButton;  
12.     ListBox1: TListBox;  
13.     procedure Button1Click(Sender: TObject);  
14.   private  
15.     { Private 宣言 }  
16.   public  
17.     { Public 宣言 }  
18.   end;  
19.   
20. var  
21.   Form1: TForm1;  
22.   
23. implementation  
24.   
25. {$R *.dfm}  
26.   
27. uses Excel_TLB,System.Win.ComObj;  
28. const  
29.   LCID = LOCALE_SYSTEM_DEFAULT;  
30.   
31.   
32. procedure TForm1.Button1Click(Sender: TObject);  
33. Var  
34.   ExcelApp : Excel_TLB.ExcelApplication;  
35.   ExcelBook : Excel_TLB.ExcelWorkbook;  
36.   ExcelSheet : Excel_TLB.ExcelWorksheet;  
37.   BookPath : String;  
38.   i : integer;  
39. begin  
40.   ListBox1.Clear;  
41.   ExcelApp := CreateComObject(CLASS_ExcelApplication) as ExcelApplication;  
42.   ExcelApp.DisplayAlerts[LCID] := false;  
43.   
44.   BookPath := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'Test.xlsx';  
45.   
46.   ExcelBook := ExcelApp.Workbooks.Add(BookPath, LCID);  
47.   
48.   (* このように書きたいが 
49.   　 'GetEnumerator' のメンバが含まれていないかアクセスできないため） 
50.       通常では使用不可　　　 
51.   for  ExcelSheet in  ExcelBook.Worksheets do 
52.   begin 
53.      ListBox1.Items.Add(ExcelSheet.Name); 
54.   end; 
55.   *)  
56.   
57.   
58.   // Excelのコレクションは1基数なので1からカウントを始める。  
59.   for i := 1 to ExcelBook.Worksheets.Count do  
60.   begin  
61.     ExcelSheet := ExcelBook.Worksheets.Item[i] As  Excel_TLB.ExcelWorksheet;  
62.     ListBox1.Items.Add(ExcelSheet.Name);  
63.   end;  
64.   
65.   ExcelSheet := nil;  
66.   ExcelBook.Close(false,BookPath,false,LCID);  
67.   ExcelBook := nil;  
68.   
69.   if Assigned(ExcelApp) then  
70.   begin  
71.     ExcelApp.Quit;  
72.     ExcelApp := nil;  
73.   end;  
74.   
75.   
76. end;  
77.   
78. end.   

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Excel_TLB,System.Win.ComObj;
const
  LCID = LOCALE_SYSTEM_DEFAULT;


procedure TForm1.Button1Click(Sender: TObject);
Var
  ExcelApp : Excel_TLB.ExcelApplication;
  ExcelBook : Excel_TLB.ExcelWorkbook;
  ExcelSheet : Excel_TLB.ExcelWorksheet;
  BookPath : String;
  i : integer;
begin
  ListBox1.Clear;
  ExcelApp := CreateComObject(CLASS_ExcelApplication) as ExcelApplication;
  ExcelApp.DisplayAlerts[LCID] := false;

  BookPath := IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'Test.xlsx';

  ExcelBook := ExcelApp.Workbooks.Add(BookPath, LCID);

  (* このように書きたいが
  　 'GetEnumerator' のメンバが含まれていないかアクセスできないため）
      通常では使用不可　　　
  for  ExcelSheet in  ExcelBook.Worksheets do
  begin
     ListBox1.Items.Add(ExcelSheet.Name);
  end;
  *)


  // Excelのコレクションは1基数なので1からカウントを始める。
  for i := 1 to ExcelBook.Worksheets.Count do
  begin
    ExcelSheet := ExcelBook.Worksheets.Item[i] As  Excel_TLB.ExcelWorksheet;
    ListBox1.Items.Add(ExcelSheet.Name);
  end;

  ExcelSheet := nil;
  ExcelBook.Close(false,BookPath,false,LCID);
  ExcelBook := nil;

  if Assigned(ExcelApp) then
  begin
    ExcelApp.Quit;
    ExcelApp := nil;
  end;


end;

end. 

for　～　in doの構文が使えると、基数のこと意識しなくても良いが、コンパイルすると

 E2431 for-in ステートメントはコレクション型 'Sheets' で動作できません（'Sheets' に 'GetEnumerator' のメンバが含まれていないかアクセスできないため）

のメッセージが、出てEXEが作れないため、従来のfor文で列挙している。

  Excelのコレクションが1基数なので、for 文は、1からシート数まででにしていのが
 ポイントです。（ポイントというもののものではありませんが・・・）

 まあ、Excelに限らず、Win32版のVisual Basic(VB6,VB5)とか、VBAのコレクションInterface
 は基本1基数なのですが・・・

 下図のようなブックに対して

 上のような処理を実行すると

 のような結果がえられます。


以下は、余談ですが、

自分 、Excelのコレクションが1基数だということをすっかり忘れていて、結果、午前中つぶしちゃいました。

Unified Interbaseコンポーネントをつかってみた（番外編:Delphi Xe2で使う）

Unified Interbaseのリポジトリには、Delphi Xe2用のパッケージ(プロジェクト）がありますので

Unified InterbaseのコンポーネントはDelphi Xe2にインストール可能です。

Xe２のバージョン管理リポジトリから開く機能を使って
としてソースをダウンロードし、
ダウンロード先、packagesフォルダから、UIBD16Win32.groupprojを開いて
ビルドすればインストールできます。

インストールしたコンポーネントは、

な感じになります。（64ビットもサポートされたてます。）

あとは、Unified Interbaseコンポーネントをつかってみた（その1)と同様にして
Firebirdと接続が可能です。