Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2013年08月13日] [更新 2013年08月13日]　Delphi サンプルプログラム集
960_COM オブジェクトとモニカ
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
Excel 2010, IE 9
960_COM_Moniker.zip　[2,193 KB]　2013年08月13日版 (EXE 同梱)






COM オブジェクトとモニカ


モニカ (Moniker) は，COM オブジェクトのリソースにアクセスするための識別子です．

COM オブジェクト，OLE オートメーション，ActiveX コントロールを操作するには，IUnknown インターフェイス型の場合は，オブジェクトのクラス名あるいは，クラス名を識別する CLSID 文字列から CreateOleObject でそのインスタンスを生成します．
また，IDispatch インターフェイス型の場合は，オブジェクトの GUID 値から CreateComObject 関数でそのインスタンスを生成することができます．全ての COM オブジェクトには IUnkonwn インターフェイスがあり，多くの COM オブジェクトは，どちらのインターフェイスも実装しています
IUnkonwn 型は OleVariant 型への代入互換性があります．
インターフェイスのユニットには，CLSID や GUID の値を意識せずに COM オブジェクトのインスタンスを生成するための専用の関数，メソッド類が実装されていることもあります．

Delphi では，[タイプライブラリの取り込み] や [ActiveX コントロールの取り込み] を行うと，各オブジェクトのインターフェイス操作関係のコードを生成することができます．このユニットには，個別のオブジェクトのインターフェイス型や Delphi のクラス型の定義，必要な定数値の定義も含まれていて便利です．
ワードとかエクセル用のユニットは，最初から Delphi に添付されています．

あるオブジェクトのモニカが取得できると，これらの関数やユニットを使用しなくても，オブジェクトのインスタンスを取得できるようになります．


[備考]
Delphi は，COM オブジェクトを実装した COM (OLE) サーバも ActiveX コントロールも作成できますが，当サイトの関係サンプルは [951_ActiveX オーメーションオブジェクトと VBScript] だけです．後は全て利用する側のクライアントとして，他のアプリ，特にワードやエクセルの操作関係のサンプルとなっています．




01_エクセルのブックのモニカ  -  セルデータの読み出し


ワードやエクセルは，多くの COM オブジェクトを実装，つまり，インターフェイスの実装により，各々のオブジェクトを，他のアプリケーションから操作可能にした，それ自身が COM コンポーネントになっているオートメーションアプリケーションです．

このサンプルは，ディスク上にある，そのエクセルのブックのシートのセルのデータを取得します．
まず，ブックのインスタンスを求めますが，
  • (1) CreateBindCtx 関数で，モニカ取得に必要なバインドオブジェクトを取得
  • (2) そのバインドオブジェクトとブック名から MkParseDisplayName 関数でモニカを取得
  • (3) そのモニカから BindToObject 関数でブックのオブジェクトのインスタンスを取得
という手順で行います．これがモニカ取得の一般的な方法です．次に，
  • (1) ブックのオブジェクトから，Invoke メソッドでシートのオブジェクトを取得
  • (2) シートのオブジェクトから，Invoke メソッドでセル範囲の Range オブジェクトを取得
  • (3) Range オブジェクトの Value プロパティの値を，Invoke メソッドで取得
の手順で取得した Value プロパティは SafeArray 型の配列となっています．この配列に格納されている値を順番に取り出します．
バリアント型を扱う方法は，Delphi にはいくつかありますが，COM (OLE) オブジェクトを扱う場合は OleVariant 型が便利なようです．


図1
テストに使用したブック
  • 4 番目のシートは，テスト用に保護シートとなっているので注意
  • 後は通常のシート


このテストでは，上の図のような添付のブックのアクティブシートのセルのデータを取得します．
下図がその実行結果です．取得した値を TListBox に表示します．
エクセルのブックを起動して表示しなくても，データの取得が可能です．

対象のブックを表示したままで，IDE上から実行した場合，エクセルのインスタンスがもう 1 つ生成されてしまいます．新たに表示したブックを閉じれば値を取得できます．
EXE を直接実行した場合は，正常に取得できますが，EXE を管理者権限で実行すると，IDE から実行した時と同じ現象となります．
このことから，この現象は，ユーザーインターフェイス特権の分離 (UIPI) によるものではないかと思われます．


図2
設計時画面
図3
実行結果

リスト1
ディスク上のエクセルのブックのシートのデータを読み出す		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function AInvoke(pDispatch: IDispatch; objName: String; wFlags: WORD;
      pVarArray: OleVariant; nArgs: Integer; var pVarResult: OleVariant): HRESULT;
    function GetExcelRangeValues(pRange: IDispatch): HRESULT;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

{ TForm1 }

//-----------------------------------------------------------------------------
//  COMオブジェクト名からそのCOMオブジェクトのインスタンスを取得
//  IMonikerを使用した方法
//-----------------------------------------------------------------------------
function GetComObject(const objName: String): IDispatch;
var
  hr      : HRESULT;
  chEaten : Integer;
  BindCtx : IBindCtx;
  Moniker : IMoniker;
begin
  Result := nil;

  //バインドオブジェクトを取得
  CreateBindCtx(0, bindCtx);

  //COMオブジェクト名からCOMオブジェクトのモニカを取得
  hr := MkParseDisplayName(BindCtx, POleStr(objName), chEaten, Moniker);
  if Failed(hr) then exit;

  //バインドしてオブジェクトのインスタンスを取得
  Moniker.BindToObject(BindCtx, nil, IDispatch, Result);
end;

//=============================================================================
//  ブックのアクティブシートのセルのデータを読み出す
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FilePath   : String;
  hr         : HRESULT;
  pWorkbook  : IDispatch;
  pWorkSheet : IDispatch;
  pRange     : IDispatch;
  varResult  : OleVariant;
  varValues  : OleVariant;
  RangeValue : WideString;
begin
  //絶対パスに変換
  FilePath := ExpandFileName('..\TestBook.xls');

  //エクセルのブック(ファイル名)からブックのインスタンス(IDispatch)を取得
  pWorkbook := GetComObject(FilePath);
  if pWorkbook = nil then exit;

  //ブックのインスタンスからシートのオブジェクトを取得
  //プロパティ名はActiveSheet(起動時にアクティブになるシート)
  varResult := Unassigned;
  hr := AInvoke(pWorkbook, 'ActiveSheet', DISPATCH_PROPERTYGET, null, 0, varResult);
  if Failed(hr) then exit;


  //シートオブジェクトの型をOleVariant型からIDispatch型に変換
  pWorkSheet := IDispatch(TVariantArg(varResult).pdispVal);

  //セル範囲(Rangeオブジェクト)を取得するためにセルの範囲を設定
  RangeValue := 'B6:C12';
  TVariantArg(varValues).vt      := VT_BSTR;
  TVariantArg(varValues).bstrVal := PChar(RangeValue);

  //Rangeの文字列からpWorkSheetオブジェクトのRangeオブジェクトを取得
  varResult := Unassigned;
  hr := AInvoke(pWorkSheet, 'Range', DISPATCH_PROPERTYGET, varValues, 1, varResult);
  if Failed(hr) then exit;

  //Rangeオブジェクトの型をOleVariant型からIDispatch型に変換
  pRange := IDispatch(TVariantArg(varResult).pdispVal);

  //Rangeオブジェクトのセルデータを取得
  GetExcelRangeValues(pRange);
end;

//=============================================================================
//  実際にセルの値を読み出すルーチン
//=============================================================================
function TForm1.GetExcelRangeValues(pRange: IDispatch): HRESULT;
var
  hr           : HRESULT;
  RowBoundLow  : Integer;
  ColBoundLow  : Integer;
  RowBoundHigh : Integer;
  ColBoundHigh : Integer;
  i            : Integer;
  j            : Integer;
  pArray       : PSafeArray;
  varValue     : OleVariant;
  varResult    : OleVariant;
  rgIndeces    : array [0..1] of Integer;
  valueType    : WORD;
  valueString  : String;
  valueInteger : Integer;
  valueDouble  : Double;
begin
  Result := E_FAIL;

  ListBox1.Items.Clear;

  //バリアントの設定と値をクリア
  varResult := Unassigned;
  //RangeオブジェクトのValueプロパティの値(セルの値の配列)をSafeArrayとして取得
  TVariantArg(varResult).vt := VT_SAFEARRAY;
  hr := AInvoke(pRange, 'Value', DISPATCH_PROPERTYGET, null, 0, varResult);
  if Failed(hr) then exit;

  //いちいちキャストするのは面倒なので，別のSafeArrayに代入
  pArray := TVariantArg(varResult).parray;
  SafeArrayLock(pArray);

  SafeArrayGetLBound(pArray, 1, RowBoundLow);
  SafeArrayGetUBound(pArray, 1, RowBoundHigh);
  SafeArrayGetLBound(pArray, 2, ColBoundLow);
  SafeArrayGetUBound(pArray, 2, ColBoundHigh);

  //セルの値を順番に取り出す
  for i := ColBoundLow to ColBoundHigh do begin
    for j := RowBoundLow to RowBoundHigh do begin

      rgIndeces[0] := j;
      rgIndeces[1] := i;

      TVariantArg(varValue).vt := VT_VARIANT;
      SafeArrayGetElement(pArray, rgIndeces, varValue);

      valueType := TVariantArg(varValue).vt;

      case valueType of
      VT_BSTR:
        begin
          valueString := String(TVariantArg(varValue).bstrVal);
          ListBox1.Items.Add(valueString);
        end;
      VT_I4:
        begin
          valueInteger := TVariantArg(varValue).intVal;
          ListBox1.Items.Add(IntToStr(valueInteger));
        end;
      VT_R8:
        begin
          valueDouble := TVariantArg(varValue).dblVal;
          valueString := FloatToStr(valueDouble);
          ListBox1.Items.Add(valueString);
        end;
      VT_DATE:
        begin
          valueDouble := TVariantArg(varValue).dblVal;
          valueString := FormatDateTime('yyyy年mm月dd日', valueDouble);
          ListBox1.Items.Add(valueString);
        end;
      else
        ListBox1.Items.Add('');
      end;
    end;
  end;

  SafeArrayUnlock(pArray);
  Result := S_OK;
end;

//-----------------------------------------------------------------------------
//  オブジェクトのプロパティ取得・設定兼用メソッド
//
//  pDispatch  取得または設定する対象のIDispatch型のオブジェクト
//  lpszName   取得または設定するオブジェクトのプロパティ名またはメソッド名
//  wFlags     次のいずれかの値
//             DISPATCH_METHOD         メソッドの実行
//             DISPATCH_PROPERTYGET    プロパティの取得
//             DISPATCH_PROPERTYPUT    プロパティの設定
//  pVarArray  設定するプロパティの値
//  nArgs      取得または設定するプロパティの数(通常は0か1)
//  pVarResult プロパティの取得の時はここに値が返される
//-----------------------------------------------------------------------------
function TForm1.AInvoke(pDispatch: IDispatch; objName: String; wFlags: WORD;
  pVarArray: OleVariant; nArgs: Integer; var pVarResult: OleVariant): HRESULT;
var
  hr        : HRESULT;
  dispParam : TDispParams;
  pdispID   : Integer;
  dispName  : TDispID;
begin
  Result := E_FAIL;

  hr := pDispatch.GetIDsOfNames(GUID_NULL, @objName, 1, LOCALE_USER_DEFAULT, @pDispid);
  if (FAILED(hr)) then exit;

  dispParam.cArgs  := nArgs;
  dispParam.rgvarg := @pVarArray;

  dispName := DISPID_PROPERTYPUT;
  if (wFlags and DISPATCH_PROPERTYPUT) <> 0 then begin
    dispParam.cNamedArgs := 1;
    dispParam.rgdispidNamedArgs := @dispName;
  end else begin
    dispParam.cNamedArgs := 0;
    dispParam.rgdispidNamedArgs := nil;
  end;
  hr := pDispatch.Invoke(pdispID,
                         GUID_NULL,
                         LOCALE_SYSTEM_DEFAULT,
                         wFlags,
                         dispParam,
                         @pVarResult,
                         nil,
                         nil);
  Result := hr;
end;

end.


このサンプルでは，モニカの取得に一般的な方法を使用しましたが，ファイル名に対応したモニカ取得には専用の関数 CreateFileMoniker があります．
ファイル名に対応したモニカをファイルモニカと言っています．


リスト2
ファイルモニカの場合は，CreateFileMoniker 関数でモニカを取得できる		 
//-----------------------------------------------------------------------------
//  ファイル名からCOMオブジェクトのインスタンスを取得
//  CreateFileMonikerを使用
//-----------------------------------------------------------------------------
function GetComObjectFromFileMoniker(const FilePath: String): IDispatch;
var
  hr      : HRESULT;
  BindCtx : IBindCtx;
  Moniker : IMoniker;
begin
  Result := nil;

  //ファイルモニカを取得
  hr := CreateFileMoniker(PChar(FilePath), Moniker);
  if Failed(hr) then exit;

  //バインドしてオブジェクトのインスタンスを取得
  CreateBindCtx(0, BindCtx);
  Moniker.BindToObject(BindCtx, nil, IDispatch, Result);
end;


このサンプルでは，元のデータの型を判定して取得していますが，取得する際に書式を無視してもいいのであれば，次のように，全て文字列として取得することもできます．


リスト3
データを取り出す時に，書式を意識しなければ文字列に変換するだけでもよい		 
  //セルの値を順番に取り出す
  for i := ColBoundLow to ColBoundHigh do begin
    for j := RowBoundLow to RowBoundHigh do begin

      rgIndeces[0] := j;
      rgIndeces[1] := i;

      TVariantArg(varValue).vt := VT_VARIANT;
      SafeArrayGetElement(pArray, rgIndeces, varValue);

      valueString := VarToStr(varValue);
      ListBox1.Items.Add(valueString);
    end;
  end;


上のサンプルでは IDispatch の Invoke メソッドでセルのデータを取得していますが，ブックのオブジェクトを取得していますから，後は [400_CreateOleObject によるエクセル操作の基本例] のサンプルのように処理できます．わざわざ IDispatch の Invoke メソッドを使う理由はありません．

その例が下のコードです．エクセルを起動することなく，ブックのオブジェクトを取得し，セルの値を取得できます．実用的な意味では，こちらの方が便利と言えます．


図4
実行結果
  • 動作確認だけなので，セル 1 つだけの値を取得

リスト4
エクセルのブックのオブジェクトを取得して，OleVariant でセルのデータを取得する例
この方法の方が実用的かも知れない		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX;

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

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

{ TForm1 }

//-----------------------------------------------------------------------------
//  ファイル名からCOMオブジェクトのインスタンスを取得
//  CreateFileMonikerを使用
//-----------------------------------------------------------------------------
function GetComObjectFromFileMoniker(const FilePath: String): IDispatch;
var
  hr      : HRESULT;
  BindCtx : IBindCtx;
  Moniker : IMoniker;
begin
  Result := nil;

  //ファイルモニカを取得
  hr := CreateFileMoniker(PChar(FilePath), Moniker);
  if Failed(hr) then exit;

  //バインドしてオブジェクトのインスタンスを取得
  CreateBindCtx(0, BindCtx);
  Moniker.BindToObject(BindCtx, nil, IDispatch, Result);
end;

//=============================================================================
//  ファイルモニカからエクセルのブックのオブジェクトを取得し
//  後はOleVariant型で操作する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FilePath  : String;
  pWorkbook : IDispatch;
  WorkBook  : OleVariant;
  WorkSheet : OleVariant;
  CellValue : String;
begin
  ListBox1.Items.Clear;

  //絶対パスに変換してオブジェクトのインスタンス(IDispatch)を取得
  FilePath  := ExpandFileName('..\TestBook.xls');
  pWorkbook := GetComObjectFromFileMoniker(FilePath);

  //IDispatchからOleVariantに変換
  TVariantArg(WorkBook).vt := VT_DISPATCH;
  IDispatch(TVariantArg(WorkBook).dispVal) := pWorkbook;

  //シートのオブジェクトを取得
  WorkSheet := WorkBook.WorkSheets[1];

  //セルの値を取得
  CellValue := VarToStr(WorkSheet.Cells[8,2].Value);
  ListBox1.Items.Add(CellValue);
end;

end.



02_エクセルのブックのモニカ  -  セルへのデータ書き込み


エクセルのブックのシートのセルにデータをセットするサンプルです．
Range オブジェクトを取得するまでは上のサンプルと同じです．VarArrayCreate 関数でバリアント配列を作成して，その配列の各要素にデータを代入します．この配列を Range オブジェクトの Value プロパティの引数として Invoke メソッドを実行します．

このサンプルも上のサンプルと同じく，Invoke メソッドを使用する必然性はありません．

セルへのデータ書き込みは，実際にブックを表示してからでないと失敗します．また，IDE上から実行した場合，エクセルのインスタンスがもう 1 つ生成されてしまい，本来のブックに値がセットされませんでした．
EXE を直接実行した場合は，正常に動作しますが，EXE を管理者権限で実行すると，IDE から実行した時と同じ現象となります．このことから，この現象は，ユーザーインターフェイス特権の分離 (UIPI) によるものではないかと思われます．


図5
実行結果
  • 対象のセルに 200 という値が書き込まれる
  • これは，対象のブックを起動し，作成した EXE を起動してテストした結果
  • IDE から実行すると，ブックの別のインスタンスが生成されて，セルへ値がセットされない

リスト5
Range オブジェクトを取得して，セルに値をセット，書き込むテスト		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function AInvoke(pDispatch: IDispatch; objName: String; wFlags: WORD;
      pVarArray: OleVariant; nArgs: Integer; var pVarResult: OleVariant): HRESULT;
    function SetCellValues(pRange: IDispatch; RowLow, RowHigh: Integer): HRESULT;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

{ TForm1 }

//-----------------------------------------------------------------------------
//  ファイル名からCOMオブジェクトのインスタンスを取得
//  CreateFileMonikerを使用
//-----------------------------------------------------------------------------
function GetComObjectFromFileMoniker(const FilePath: String): IDispatch;
var
  hr      : HRESULT;
  BindCtx : IBindCtx;
  Moniker : IMoniker;
begin
  Result := nil;

  //ファイルモニカを取得
  hr := CreateFileMoniker(PChar(FilePath), Moniker);
  if Failed(hr) then exit;

  //バインドしてオブジェクトのインスタンスを取得
  CreateBindCtx(0, BindCtx);
  Moniker.BindToObject(BindCtx, nil, IDispatch, Result);
end;

//=============================================================================
//  起動中のエクセルのブックのシートのセルにデータをセットする
//
//  対象のブックが起動中に，IDEから実行すると，エクセルのインスタンスが新規作
//  成されてしまうようである．作成したEXEで実行すれはOK
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FilePath   : String;
  hr         : HRESULT;
  pWorkbook  : IDispatch;
  pWorkSheet : IDispatch;
  pRange     : IDispatch;
  varResult  : OleVariant;
  varValues  : OleVariant;
  RangeStr   : WideString;
  RowLow     : Integer;
  RowHigh    : Integer;
begin
  //絶対パスに変換
  FilePath  := ExpandFileName('..\TestBook.xls');
  //エクセルのブック(ファイル名)からブックのインスタンス(IDispatch)を取得
  pWorkbook := GetComObjectFromFileMoniker(FilePath);
  if pWorkbook = nil then exit;


  //ブックのインスタンスからシートのオブジェクトを取得
  //プロパティ名はActiveSheet(起動時にアクティブになるシート)
  varResult := Unassigned;
  hr := AInvoke(pWorkbook, 'ActiveSheet', DISPATCH_PROPERTYGET, null, 0, varResult);
  if Failed(hr) then exit;

  //シートオブジェクトの型をOleVariant型からIDispatch型に変換
  pWorkSheet := IDispatch(TVariantArg(varResult).pdispVal);

  //セル範囲(Rangeオブジェクト)を取得するためにセルの範囲を設定
  RangeStr := 'C7:C12';
  TVariantArg(varValues).vt      := VT_BSTR;
  TVariantArg(varValues).bstrVal := PChar(RangeStr);

  //Rangeの文字列からpWorkSheetオブジェクトのRangeオブジェクトを取得
  varResult := Unassigned;
  hr := AInvoke(pWorkSheet, 'Range', DISPATCH_PROPERTYGET, varValues, 1, varResult);
  if Failed(hr) then exit;

  //Rangeオブジェクトの型をOleVariant型からIDispatch型に変換
  pRange := IDispatch(TVariantArg(varResult).pdispVal);

  //そのRangeオブジェクトのセルに値をセット
  //Rangeが[C7:C12]なので0から5
  RowLow  := 0;
  RowHigh := 5;
  SetCellValues(pRange, RowLow, RowHigh);
end;

//=============================================================================
//  実際にセルに値をセットするルーチン
//  ブックが表示されていないとセット不可
//=============================================================================
function TForm1.SetCellValues(pRange: IDispatch; RowLow, RowHigh: Integer): HRESULT;
var
  hr        : HRESULT;
  i         : Integer;
  varResult : OleVariant;
  pData     : OleVariant;
begin
  Result := E_FAIL;

  //Range内の全てのセルに整数値の同じ値をセット
  pData := VarArrayCreate([RowLow, RowHigh], VT_I4);
  for i := RowLow to RowHigh do begin
    pData[i] := 200;
  end;

  varResult := Unassigned;
  hr := AInvoke(pRange, 'Value', DISPATCH_PROPERTYPUT, pData, 1, varResult);
  if Failed(hr) then exit;

  Result := hr;
end;

//-----------------------------------------------------------------------------
//  オブジェクトのプロパティ取得・設定兼用メソッド
//
//  pDispatch  取得または設定する対象のIDispatch型のオブジェクト
//  lpszName   取得または設定するオブジェクトのプロパティ名またはメソッド名
//  wFlags     次のいずれかの値
//             DISPATCH_METHOD         メソッドの実行
//             DISPATCH_PROPERTYGET    プロパティの取得
//             DISPATCH_PROPERTYPUT    プロパティの設定
//  pVarArray  設定するプロパティの値
//  nArgs      取得または設定するプロパティの数(通常は0か1)
//  pVarResult プロパティの取得の時はここに値が返される
//-----------------------------------------------------------------------------
function TForm1.AInvoke(pDispatch: IDispatch; objName: String; wFlags: WORD;
  pVarArray: OleVariant; nArgs: Integer; var pVarResult: OleVariant): HRESULT;
var
  hr        : HRESULT;
  dispParam : TDispParams;
  pdispID   : Integer;
  dispName  : TDispID;
begin
  Result := E_FAIL;

  hr := pDispatch.GetIDsOfNames(GUID_NULL, @objName, 1, LOCALE_USER_DEFAULT, @pDispid);
  if (FAILED(hr)) then exit;

  dispParam.cArgs  := nArgs;
  dispParam.rgvarg := @pVarArray;

  dispName := DISPID_PROPERTYPUT;
  if (wFlags and DISPATCH_PROPERTYPUT) <> 0 then begin
    dispParam.cNamedArgs := 1;
    dispParam.rgdispidNamedArgs := @dispName;
  end else begin
    dispParam.cNamedArgs := 0;
    dispParam.rgdispidNamedArgs := nil;
  end;
  hr := pDispatch.Invoke(pdispID,
                         GUID_NULL,
                         LOCALE_SYSTEM_DEFAULT,
                         wFlags,
                         dispParam,
                         @pVarResult,
                         nil,
                         nil);
  Result := hr;
end;

end.



03_IDispatch の Invoke メソッドの機能と動作


Delphi のクラスは，そのクラス (オブジェクト) のインスタンスからプロパティやメソッドで，関係するオブジェクトの操作が可能になっています．

一方，COM では，Delphi のプロパティに相当する各々のオブジェクトは，別々のインターフェイスで定義されている場合があります．あるオブジェクトのプロパティの取得や設定は，そのインターフェイスのインスタンスを取得します．IUnkonwn 型の場合は QueryInterface メソッド，IDispatch 型の場合は Invoke メソッドを使用します．
対象のインターフェイスに，プロパティの取得，設定用のメソッドが実装されていれば，それらを使用することができます．Invoke メソッドを使用する必然性はありません．

インターフェイスにどのようなプロパティやメソッドが実装されているかは，[タイプライブラリの取り込み] や [ActiveX コントロールの取り込み] で生成されたコードで確認することができます．

下のコードは，上のサンプルで使用している自作の Invoke メソッドです．IDispatch の Invoke メソッドは，プロパティの設定，取得，メソッドの実行かによって，引数の値を変更する必要があります．そこで，プロパティの所得，設定兼用にしたものです．
ただし，メソッドの実行には完全対応していません．引数が必要なメソッドもあります．


リスト6
プロパティの取得と設定兼用のための，自作 Invoke メソッド		 
//-----------------------------------------------------------------------------
//  オブジェクトのプロパティ取得・設定兼用メソッド
//
//  pDispatch  取得または設定する対象のIDispatch型のオブジェクト
//  lpszName   取得または設定するオブジェクトのプロパティ名またはメソッド名
//  wFlags     次のいずれかの値
//             DISPATCH_METHOD         メソッドの実行
//             DISPATCH_PROPERTYGET    プロパティの取得
//             DISPATCH_PROPERTYPUT    プロパティの設定
//  pVarArray  設定するプロパティの値
//  nArgs      取得または設定するプロパティの数(通常は0か1)
//  pVarResult プロパティの取得の時はここに値が返される
//-----------------------------------------------------------------------------
function TForm1.AInvoke(pDispatch: IDispatch; objName: String; wFlags: WORD;
  pVarArray: OleVariant; nArgs: Integer; var pVarResult: OleVariant): HRESULT;
var
  hr        : HRESULT;
  dispParam : TDispParams;
  pdispID   : Integer;
  dispName  : TDispID;
begin
  Result := E_FAIL;

  hr := pDispatch.GetIDsOfNames(GUID_NULL, @objName, 1, LOCALE_USER_DEFAULT, @pDispid);
  if (FAILED(hr)) then exit;

  dispParam.cArgs  := nArgs;
  dispParam.rgvarg := @pVarArray;

  dispName := DISPID_PROPERTYPUT;
  if (wFlags and DISPATCH_PROPERTYPUT) <> 0 then begin
    dispParam.cNamedArgs := 1;
    dispParam.rgdispidNamedArgs := @dispName;
  end else begin
    dispParam.cNamedArgs := 0;
    dispParam.rgdispidNamedArgs := nil;
  end;
  hr := pDispatch.Invoke(pdispID,
                         GUID_NULL,
                         LOCALE_SYSTEM_DEFAULT,
                         wFlags,
                         dispParam,
                         @pVarResult,
                         nil,
                         nil);
  Result := hr;
end;



04_IE オブジェクトの URL のモニカ


Windows API 関数の中には，モニカを引数に使うものがあります．
例えば IE オブジェクトで，ウェブページをモーダルダイアログ形式で表示する ShowHTMLDialog 関数がそうです．この関数を使用したサンプルです．
この関数の引数には，URL に対応したモニカがあります．このようなモニカを URL モニカ (Unique Resource Locator Moniker) と言い，専用の関数，CreateURLMoniker があります．この関数の使用には uses に UrlMon が必要です．


図6
実行結果

リスト7
モニカを使用する Windows API 関数の使用例．モーダルダイアログ形式でウェブページを表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ActiveX, UrlMon, ComObj;

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

  function ShowHTMLDialog(
                     hwndParent: HWND;
                     pMk: IMoniker;
                     pArgIn: POleVariant;
                     pchOptions: PChar;
                     pArgOut: POleVariant): HRESULT; stdcall; external 'MSHTML.DLL';

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  モニカを引数に使用するWindows API関数の例
//
//  ShowHTMLDialog関数
//  ウェブページをダイアログ形式で表示
//  サイズや表示位置を指定して表示できる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  szURL       : String;
  pURLMoniker : IMoniker;
  pOptions    : String;
begin
  //URLのモニカをpURLMonikerに取得
  szURL := 'http://mrxray.on.coocan.jp/index.htm';
  CreateURLMoniker(nil, PChar(szURL), pURLMoniker);

  //そのモニカを指定してダイアログを表示
  if pURLMoniker <> nil then begin
    pOptions  := 'resizable=yes;dialogHeight:35;dialogWidth:35;';
    ShowHTMLDialog(Handle, pURLMoniker, nil, PChar(pOptions), nil);
  end;
end;

end.



05_WMI オブジェクトのモニカ文字列


WMI オブジェクトのインスタンスを，モニカを使用して取得するサンプルです．
コード中の winmgmts: は WMI オブジェクトライブラリを意味する文字列です．この後にオブジェクトの種類を表す文字列を指定します．この時，この文字列をモニカ文字列と言っています．モニカ文字列を使用したこの方法は，ユーザ認証が必要ない場合に使用可能です．

このサンプルは，システムの論理ディスクの一覧を取得して，その各々論理ディスクの 1 部のプロパティだけを取得して TListBox に表示ます．


図7
設計時画面
図8
実行結果
  • 論理ディスクの一覧を取得して，各ディスクのプロパティの 1 部を表示

リスト8
モニカ文字列から WMI オブジェクトのインスタンスを取得する例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  protected
    { Private 宣言 }
    function VarToString(const OleVar: OleVariant): String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

{ TForm1 }

//-----------------------------------------------------------------------------
//  COMオブジェクト名からそのCOMオブジェクトのインスタンスを取得
//  IMonikerを使用した方法
//-----------------------------------------------------------------------------
function GetComObject(const objName: String): IDispatch;
var
  hr      : HRESULT;
  chEaten : Integer;
  BindCtx : IBindCtx;
  Moniker : IMoniker;
begin
  Result := nil;

  //バインドオブジェクトを取得
  CreateBindCtx(0, bindCtx);

  //COMオブジェクト名からCOMオブジェクトのモニカを取得
  hr := MkParseDisplayName(BindCtx, POleStr(objName), chEaten, Moniker);
  if Failed(hr) then exit;

  //バインドしてオブジェクトのインスタンスを取得
  Moniker.BindToObject(BindCtx, nil, IDispatch, Result);
end;

//=============================================================================
//  論理ディスクの一覧を取得して，いくつかのプロパティを取得して表示
//  VarToStringは自作関数
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  objWMIService : OleVariant;
  colItems      : OleVariant;
  colItem       : OleVariant;
  colEnum       : IEnumvariant;
  iValue        : LongWord;
begin
  ListBox1.Items.Clear;

  //WMIのオブジェクトを取得
  objWMIService := GetComObject('winmgmts:\\localhost\root\CIMV2');

  //クエリーの実行
  colItems := objWMIService.ExecQuery('SELECT * FROM Win32_LogicalDisk', 'WQL', 0);

  //論理ディスクのプロパティのセットをcolEnumに取得
  colEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
  //それを順番に各々のプロパティを取得
  while colEnum.Next(1, colItem, iValue) = 0 do begin
    ListBox1.Items.Add(Format('Description  %s', [VarToString(colItem.Description)]));
    ListBox1.Items.Add(Format('DeviceID     %s', [VarToString(colItem.DeviceID)]));
    ListBox1.Items.Add(Format('Size         %s', [VarToString(colItem.Size)]));
    ListBox1.Items.Add('');
  end;
end;

//=============================================================================
//  OleVariantの値をString型に変換
//  複数の値を持つプロパティがある．そこでこれを[]で括った結果を返すことにする
//  そのためVarArrayも扱えるようにしたVarToStr関数
//=============================================================================
function TForm1.VarToString(const OleVar: OleVariant): String;
var
  LowBound  : Integer;
  HighBound : Integer;
  i         : Integer;
begin
  Result := '';

  //配列の場合
  if VarIsArray(OleVar) then begin
    LowBound  := VarArrayLowBound(OleVar, 1);
    HighBound := VarArrayHighBound(OleVar, 1);

    for i := LowBound to HighBound do begin
      if i = HighBound then begin
        Result := Result + VarToString(OleVar[i]);
      end else begin
        Result := Result + VarToString(OleVar[i]) + ',';
      end;
    end;

    Result:='[' + Result + ']';

  //単一の値を持つプロパティの場合
  end else begin
    Result := VarToStr(OleVar);
  end;
  if Result = '' then  Result := 'NULL';
end;

end.