Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2008年05月03日] [更新 2013年10月20日]　Delphi サンプルプログラム集
903_ WMI 非同期イベントシンク
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
903_WMI_EventAsync.zip　[11,107 KB]　2013年10月20日版 (EXE 同梱)



  • 2013年10月14日
  • プロセスの起動と終了のページに掲載していた非同期イベント関係サンプルをこちらに移動。サンプルを細かく分割し、プロセスだけでなく、リムーバブルディスク関係とネットワーク切断のサンプルを追加
  • 2013年10月18日
  • 指定ディレクトリ内のファイルの作成削除の監視のサンプルを追加



WMI の非同期イベント検出


システムで、何かの操作、変更のメッセージが発生した時に、それをイベントとして受信するサンプルプログラムです。
これらのメッセージの受信には、専用の Windows API の関数が用意されいる場合がありますが、専用の API ではサポートされていない機能もあります。このような場合には WMI のイベント通知機能は便利です。

イベントの通知を、同期・半同期で受信する場合と、非同期で受信する方式があります。これらは、目的によって使い分けることになります。
非同期イベントの場合は、
  • (1) WMI (Wbem) オブジェクトのインスタンスを生成する
  • (2) WMI (Wbem) サービスに接続する (ローカルかネットワークかによって引数の値が異なる)
  • (3) イベントシンク (イベント受信側) のオブジェクトのインスタンスを生成する
  • (4) イベントを受信するメソッドを指定する (メソッドは指定した書式で作成する)
  • (5) クエリ文を作成して、ExecNotificationQueryAsync 関数で実行する
の手順でコーディングします。


イベント受信用のメソッド、つまり、ボタンクリックの OnClick 等に相当する部分には以下の 4 つの種類があります。引数の詳細については、MSDN オンラインの記事、または、WbemScripting_TLB.pas 内の ISWbemSinkEvents のコードで確認します。
フォームに配置して利用するコンポーネントではないので、イベントを、オブジェクトインスペクタで作成するわけにはいきません。[160_コンポーネントの実行時生成] のように自分で定義します。

WMI の非同期イベント処理には、WbemScripting_TLB.pas が必ず必要です。同期、半同期イベント処理の場合は WbemScripting_TLB.pas を使用しなくても、WMI 関係のオブジェクトを OleVariant 型で定義して使用できます。


表1
イベント用のメソッドの種類
引数の定義については、WbemScripting_TLB.pas 内のコードを参照

OnCompleted 非同期呼び出しが完了した時に発生
非同期操作の結果を示し、呼び出しが失敗した時のエラー情報の取得が可能
OnObjectPut 非同期操作が完了したときに発生
インスタンスまたはクラスのオブジェクトのパスを返す
OnObjectReady 非同期操作のオブジェクトのクエリーの結果として発生
結果のオブジェクトの列挙が完了するまで発生
OnProgress 非同期の呼び出しの進行中の状態が変化、更新された時に発生
実際に更新を受信するには、ExecNotificationQueryAsync 関数の引数の iFlags に wbemFlagSendStatus が必要




イベントクエリ WQL の構文


WMI オブジェクトのインスタンスの生成と、WMI (Wbem) サービスに接続するまでは、これまでサンプルと同じです。クエリー WQL (WMI Query Language) の構文はこれまでと少し違います。
下の表は、本ページで使用しているクエリーの各「句」の説明です。

説明を読むよりも、まずサンプルのプロジェクトを起動して確認した方が理解が早いと思いますが、実際に動作させた後に確認するのに役に立ちます。


SELECT 検出するプロパティ名を指定
当サイトのサンプルでは、一部を除いて * として全プロパティを検出
FROM この後の表の、組み込みイベントか、外部イベントクラスのどちらかを指定
組み込みイベントを指定した場合は、WHERE 句に、対象となるクラス (ターゲットクラス) や監視条件を指定する
外部イベントを指定した場合は、WITHIN と ISA 句は不要。検出条件があれば、WHERE 句で指定する
WITHIN 組み込みイベントクラスを使用する場合に指定
ポーリング間隔を指定する。数値の単位は秒 (1 秒以下の指定も可能)
ポーリング間隔とは、最初のイベントを検出してから次のイベントをチェックするまでの時間
WHERE 組み込みイベントクラスを使用する場合、通常は TargetInstance にする
__ InstanceModificationEventクラスには、ターゲットインクラスのインスタンスが変更される前に、そのインスタンスを参照できる PreviousInstanceプロパティがある

外部イベントクラスを使用する場合は、検出条件を指定する
ISA 組み込みイベントクラスを使用する場合に指定
ターゲットにするクラスと検出条件を指定する。イベントハンドラでは、ここで指定したターゲットクラスのプロパティが取得できる


下の 2 つの表は、クエリの FROM 句に指定するイベントクラスの種類の一部です。
FROM 句には、組み込みイベントクラスか、外部イベントクラスのどちらかを指定します。組み込みイベントクラスを使用する時は、ISA 句にターゲットとなるクラスを文字列で指定します。イベント内では、このターゲットとしたクラスのオブジェクトのプロパティを取得することができます。


表2
クエリの FROM 句で使用する WMI の組み込みイベントクラスの例
本ページのサンプルで使用している組み込みイベントクラス

__Instancecreationevent インスタンス生成のイベント用
__InstanceDeletionEvent インスタンス削除のイベント用
__InstanceModificationEvent インスタンス変更のイベント用
__InstanceOperationEvent イベントの作成、削除、変更の全てのイベント用
__InstanceXXXX の 3 つの全てを含むイベントの監視


表3
クエリの FROM 句で使用する WMI の外部イベントクラスの一部
WIN32_XXX クラスの例。WIN32_XXX 以外のクラスにもイベント用のクラスがある

Win32_ComputerShutdownEvent コンピューターのシャットダウン関係の監視
シャットダウン、ログオフ、再起動の識別が可能
Win32_ComputerSystemEvent コンピューターのシステム関係のイベント
Win32_DeviceChangeEvent デバイスの構成、状態、ネットワークドライブの変更等
WM_DEVICECHANGE メッセージが発生した場合も含まれる
Win32_IP4RouteTableEvent IP4 ルートの追加、削除、変更等。IPX、IP6 関係の検出は不可
Win32_NTLogEvent Windows のイベントログ関係
Win32_PowerManagementEvent 電源状態の変化に伴うイベント
APM (Advanced Power Management)、ACPI (Advanced Configuration and Power Interface) 関係
Win32_VolumeChangeEvent ドライブ文字の変更等、ドライブの変更関係イベント
ネットワークドライブは未サポート
Win32_ModuleLoadTrace プロセスがモジュールをロードする時の監視
Win32_ModuleTrace プロセスのモジュール関係の監視
Win32_ProcessStartTrace プロセスの起動の監視
Win32_ProcessStopTrace プロセスの終了の監視
Win32_ProcessTrace プロセス関係の監視
Win32_ProcessStartTrace, Win32_ProcessStop を含む
Win32_SystemTrace システムの全てのイベントの基本クラス
Win32_ThreadStartTrace スレッド開始の監視
Win32_ThreadStopTrace スレッド終了の監視
Win32_ThreadTrace スレッドの監視
Win32_ThreadStartTrace, Win32_ThreadStopTrace を含む


Win32_XXX 等の外部イベントクラスを使用した場合、管理者権限が必要なサンプルがあります。
管理者に昇格しないで実行すると、「アクセスは拒否されました.」のメッセージが現れます。


図1
管理者権限が必要な EXE の場合
  • Win32_XXX イベントクラスを使用したサンプルは、管理者権限での実行が必要な場合がある




01_プロセスの起動を監視  -  組み込みイベントクラス使用


プロセスの起動を 1 秒単位で監視します。
組み込みイベントの __InstanceCreationEvent を使用したサンプルです。Win32_Process をターゲットクラスとしています。

イベントの引数の objWbemObject: ISWbemObject が FROM 句で指定したオブジェクトです。今回のサンプルでは、__InstanceCreationEvent ということになります。
また、このオブジェクトの TargetInstance プロパティがターゲットのクラスのオブジェクトです。今回のサンプルでは、Win32_Process ということになります。

下図が実行結果です。イベント内で、Win32_Process クラスの、いくつかのプロパティを取得して表示しています。WMI の日付時刻型を Delphi の TDateTime 型に変換する自作のルーチンは、[898_WMI イントロダクション] [05_日付時刻型プロパティの処理例 - TDateTime 型に変換] で使用しているコードと同じです。


図2
設計時画面
  • 本ページのサンプルは、全て、これと同じ
図3
実行画面
  • [監視開始]をクリック
  • メモ帳の後にワードを起動
  • OSPPSVC.EXE と splwow64.exe はワード起動後に起動したプロセス。おそらくワードが使用するプロセスと思われる

リスト1
組み込みイベントクラス __InstanceCreationEvent を使用したプロセスの起動監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してプロセスの起動を監視
//  Win32_Processクラスで、起動したプロセスのプロパティを取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceCreationEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_Process"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  WMIの日付時刻型をDelphiのTDateTime型に変換する関数
  //  OleVariantで返して、呼び出し側でTDateTime型に変換した方がいいかも知れない
  //---------------------------------------------------------------------------
  function WbemToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : OleVariant;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CreateOleObject('WbemScripting.SWbemDateTime');
    WMIDateTime.Value := V;
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal := objWbemObject;

  ADateTime := WbemToTDateTime(PropVal.TargetInstance.CreationDate);
  Memo1.Lines.Add('CreateDate  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('Caption     : ' + VarToStr(PropVal.TargetInstance.Caption));
  Memo1.Lines.Add('ProcessID   : ' + VarToStr(PropVal.TargetInstance.ProcessID));
  Memo1.Lines.Add('----------------------------------')
end;

end.



02_イベント内で全プロパティを列挙する方法


イベントのコードを下のコードのようにすると、プロパティを列挙して取得することができます。
ただし、プロセスが起動するたびに表示がクリアされます。

__InstanceCreationEvent が発生したイベントの種類ということになります。
TargetInstance = Instance of Win32_Process がターゲットのインスタンスです。このインスタンスのプロパティが取得できているのが分かります。


図4
プロパティの列挙		 

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//
//  プロパティの全てを列挙して表示する場合
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
begin
  Memo1.Lines.Text := objWbemObject.GetObjectText_(0);
end;



03_イベント内で全プロパティを列挙する方法  -  改良版


上のコードでは、イベントが発生するたびに表示がクリアされてしまいます。
発生したイベント全てを表示するには、例えば次のようにすると可能です。		 


//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//
//  プロパティの全てを列挙して表示する場合 改良版
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  SL : TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Text := objWbemObject.GetObjectText_(0);
    Memo1.Lines.Add(SL.Text);
    Memo1.Lines.Add('-----------------------------------------------------------');
  finally
    FreeAndNil(SL);
  end;
end;



04_プロセスの起動を監視  -  外部イベントクラス使用


プロセスの起動を 1 秒単位で監視します。
今度は外部イベントの Win32_ProcessStartTrace イベントクラスを使用してみました。

イベントの引数の objWbemObject: ISWbemObject は、今度は Win32_ProcessStartTrace のオブジェクトということになります。下図が実行結果です。Win32_ProcessStartTrace クラスの、いくつかのプロパティを取得して表示しています。

TIME_CREATED プロパティの取得方法に注意してください。このプロパティには整数値で日付時刻の相当する値が格納されています。WMI 本来の日付時刻型とは違います。そごで、別の関数にして、Delphi の日付時刻型の値に変換しています。


図5
実行例
  • IE (インターネットエクスプローラ) を起動した後にエクセルを起動した例

リスト2
外部イベントクラス Win32_ProcessStartTrace を使用したプロセスの起動監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの外部イベントクラスを使用してプロセスの起動を監視
//  Win32_ProcessStartTraceを使用
//  実行には管理者権限が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM Win32_ProcessStartTrace ';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal := objWbemObject;

  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('ProcessName   : ' + VarToStr(PropVal.ProcessName));
  Memo1.Lines.Add('ProcessID     : ' + VarToStr(PropVal.ProcessID));
  Memo1.Lines.Add('----------------------------------')
end;

end.



05_ISWbemPropertySet を使用したプロパティの取得


上のコードでは、プロパティを OleVariant 型に変換して取得しています。
イベントの 引数 objWbemObject: ISWbemObject には ISWbemPropertySet 型の Properties_ というプロパティがあり、それからプロパティのセットを取得できます。これを使用したのが下のコードです。


リスト3
ISWbemPropertySet を使用したプロパティの取得		 
//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//
//  プロパティの取得にISWbemPropertySetを使用する例
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropSet   : ISWbemPropertySet;
  ADateTime : TDateTime;
begin
  PropSet := objWbemObject.Properties_;

  ADateTime := EventTimeToTDateTime(PropSet.Item('TIME_CREATED', 0));
  Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('ProcessName   : ' + VarToStr(PropSet.Item('ProcessName', 0)));
  Memo1.Lines.Add('ProcessID     : ' + VarToStr(PropSet.Item('ProcessID', 0)));
  Memo1.Lines.Add('----------------------------------')
end;



06_プロセスの起動を監視  -  イベント内で全プロパティを取得


この上のコードと同じ方法で、全てのプロパティを取得して表示する例です。
これまで使用した VarToStr だけでは取得できないプロパティがあります。そこで [898_WMI イントロダクション] で作成した専用の関数を使用しています。


図6
実行例
  • ワードを起動した例

リスト4
外部イベントクラス Win32_ProcessStartTrace を使用したプロセスの起動監視で、全プロパティを取得するサンプル 
//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//
//  全てのプロパティを取得する例
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  wmiPropSetEnum : IEnumVariant;
  objTemp        : OleVariant;
  iValue         : LongWord;
  wmiProperty    : ISWbemProperty;
  PropName       : string;
  PropValue      : OleVariant;
  ADateTime      : TDateTime;
  fmtStrStr      : String;
begin
  //オブジェクトのプロパティの列挙を取得
  wmiPropSetEnum := (objWbemObject.Properties_._NewEnum) as IEnumVariant;

  //順番に取り出す
  while wmiPropSetEnum.Next(1, objTemp, iValue) = 0 do begin
    //プロパティを取得
    wmiProperty := IUnknown(objTemp) as ISWBemProperty;

    //プロパティの名前と値を取り出す
    PropName  := VarToStr(wmiProperty.Name);
    PropValue := wmiProperty.Get_Value;

    fmtStrStr := Format('%-22s', [PropName]);

    //プロパティ名がTIME_CREATEDの時は別処理
    //TIME_CREATEDは日付時刻型ではなく、8ビット整数値なのでプロパティ名で判定
    if PropName = 'TIME_CREATED' then begin
      ADateTime := EventTimeToTDateTime(PropValue);
      Memo1.Lines.Add(fmtStrStr + DateTimeToStr(ADateTime));
    end else begin
      Memo1.Lines.Add(fmtStrStr + VarToString(PropValue));
    end;
  end;
  Memo1.Lines.Add('-----------------------------------------');
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;



07_全プロパティの取得を OleVariant 型で処理する場合


プロパティの取得部分を全て OleVariant 型で処理する場合です。IEnumVariant の部分は OleVariant 型にしても省略できる部分がなく、意味がないと思われますので、そのままです。したがって、イベントコード内で実際に変更したのは、ISWbemProperty 型の変数だけです。
また、WMI オブジェクトも OleVariant 型にしてみましたが、さすがにイベント部分を OleVariant 型にするには無理がありそうです。

OleVariant 型で処理して、何とかして WbemScripting_TLB を使用したくないと考えている方にとっては残念ですが、uses に WbemScripting_TLB が必要です。 


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : OleVariant;
    FobjWMIService : OleVariant;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
    function VarToString(const OleVar: OleVariant): String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ActiveX;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの外部イベントクラスを使用してプロセスの起動を監視
//  Win32_ProcessStartTraceを使用
//  実行には管理者権限が必要
//
//  イベント関係以外を全てOleVariant型で処理する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer('localhost', 'root\cimv2');

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM Win32_ProcessStartTrace ';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL');
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator := Unassigned;
    FobjWMIService := Unassigned;
    FobjWMISink    := nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//
//  全てのプロパティを取得する例
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  wmiPropSetEnum : IEnumVariant;
  objItem        : OleVariant;
  iValue         : LongWord;
  PropName       : string;
  PropValue      : OleVariant;
  ADateTime      : TDateTime;
  fmtStrStr      : String;
begin
  //オブジェクトのプロパティの列挙を取得
  wmiPropSetEnum := objWbemObject.Properties_._NewEnum as IEnumVariant;

  //順番に取り出す
  while wmiPropSetEnum.Next(1, objItem, iValue) = 0 do begin
    //プロパティの名前と値を取り出す
    PropName  := VarToStr(objItem.Name);
    PropValue := objItem.Value;

    fmtStrStr := Format('%-22s', [PropName]);

    //プロパティ名がTIME_CREATEDの時は別処理
    //TIME_CREATEDは日付時刻型ではなく、8ビット整数値なのでプロパティ名で判定
    if PropName = 'TIME_CREATED' then begin
      ADateTime := EventTimeToTDateTime(PropValue);
      Memo1.Lines.Add(fmtStrStr + DateTimeToStr(ADateTime));
    end else begin
      Memo1.Lines.Add(fmtStrStr + VarToString(PropValue));
    end;
  end;
  Memo1.Lines.Add('-----------------------------------------');
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.



08_メモ帳だけの起動を監視  -  外部イベントクラス使用


外部イベントクラスの Win32_ProcessStartTrace を使用して、メモ帳だけの起動を検出します。

ここまでのサンプルでは、全てのプロセスの起動を監視していました。特定のプロセスやアプリケーションだけの起動を監視したい場合の参考サンプルです。イベントハンドラ内で、プロパティからも判定できますが、ここでは、クエリーで設定しています。
Win32_ProcessStartTrace クラスの ProcessName プロパティの値が notepad.exe の時だけイベントが発生するようにしています。

もし、起動するアプリケーションをフルパスで指定したい場合は、組み込みイベントクラスを使用し、ターゲットクラスに、例えば Win32_Process を使用します。Win32_Process のプロパティには、プロセスのフルパスのプロパティがあります。


図7
実行例
  • メモ帳だけの起動を検出

リスト5
外部イベントクラス Win32_ProcessStartTrace を使用してメモ帳だけの起動を監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの外部イベントクラスを使用してメモ帳の起動を監視
//  Win32_ProcessStartTraceを使用
//  メモ帳だけの起動監視のため、WHERE句にメモ帳のProcNameプロパティを指定
//  実行には管理者権限が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM Win32_ProcessStartTrace '
          + 'WHERE ProcessName = "notepad.exe"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal := objWbemObject;

  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('ProcessName   : ' + VarToStr(PropVal.ProcessName));
  Memo1.Lines.Add('ProcessID     : ' + VarToStr(PropVal.ProcessID));
  Memo1.Lines.Add('----------------------------------')
end;

end.



09_メモ帳だけの終了を監視  -  外部イベントクラス使用


外部イベントクラスの Win32_ProcessStopTrace を使用して、メモ帳だけの終了を検出します。

特定のプロセスやアプリケーションだけの終了を監視したい場合の参考サンプルです。イベントハンドラ内で、プロパティからも判定できますが、ここでは、クエリーで設定しています。 Win32_ProcessStopTrace クラスの ProcessName プロパティの値が notepad.exe の時だけイベントが発生するようにしています。
プロセスの識別には、プロセスの ID やプロセスハンドルの値も使用できます。


図8
実行例
  • メモ帳だけの終了を検出

リスト6
外部イベントクラス Win32_ProcessStopTrace を使用してメモ帳だけの終了を監視 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの外部イベントクラスを使用してメモ帳の終了を監視
//  Win32_ProcessStopTraceを使用
//  メモ帳だけの起動監視のため、WHERE句にメモ帳のProcNameプロパティを指定
//  実行には管理者権限が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM Win32_ProcessStopTrace '
          + 'WHERE ProcessName = "notepad.exe"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal := objWbemObject;

  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('ProcessName   : ' + VarToStr(PropVal.ProcessName));
  Memo1.Lines.Add('ProcessID     : ' + VarToStr(PropVal.ProcessID));
  Memo1.Lines.Add('----------------------------------')
end;

end.



10_メモ帳だけの起動終了等を監視  -  外部イベントクラス使用


外部イベントクラスの Win32_ProcessTrace を使用して、メモ帳だけの起動と終了を監視するサンプルです。

特定のプロセスやアプリケーションだけの起動や終了を監視したい場合の参考サンプルです。イベントハンドラ内で、プロパティからも判定できますが、ここでは、クエリーで設定しています。 Win32_ProcessTrace クラスの ProcessName プロパティの値が notepad.exe の時だけイベントが発生するようにしています。
起動しているメモ帳全てを監視するようになっていますが、特定のメモ帳、つまり、特定のプロセスの終了だけを監視したい場合は、あらかじめ、起動中のプロセスのプロセス ID の値を取得しておいて、その値で判定します。

起動か終了かの判定は、イベントハンドラ内で、Win32_ProcessStopTrace の Path_.Class プロパティを使用します。Win32_ProcessStartTrace の時が起動、Win32_ProcessStopTrace の時が終了です。



図9
実行例
  • Path_.Class プロパティの値が
  • Win32_ProcessStartTrace は起動
  • Win32_ProcessStopTrace は終了

リスト7
外部イベントクラス Win32_ProcessTrace を使用してメモ帳だけの起動終了を監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの外部イベントクラスを使用してメモ帳の起動や終了を監視
//  Win32_ProcessTraceを使用
//  メモ帳だけの起動監視のため、WHERE句にメモ帳のProcNameプロパティを指定
//  実行には管理者権限が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM Win32_ProcessTrace '
          + 'WHERE ProcessName = "notepad.exe"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal := objWbemObject;

  //イベントが発生した日時
  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('Path_.Class   : ' + VarToStr(PropVal.Path_.Class));

  Memo1.Lines.Add('ProcessName   : ' + VarToStr(PropVal.ProcessName));
  Memo1.Lines.Add('ProcessID     : ' + VarToStr(PropVal.ProcessID));
  Memo1.Lines.Add('----------------------------------')
end;

end.



11_メモ帳だけの起動終了等を監視  -  組み込みイベントクラス使用


組み込みイベントクラスの __InstanceOperationEvent を使用して、メモ帳だけの起動と終了を監視するサンプルです。ターゲットクラスは Win32_Process としています。

特定のプロセスやアプリケーションだけの起動や終了を監視したい場合の参考サンプルです。イベントハンドラ内で、プロパティからも判定できますが、ここでは、クエリーで設定しています。
ターゲットの Win32_Process クラスの caption プロパティの値が notepad.exe の時だけイベントが発生するようにしています。

起動か終了かの判定は、イベントハンドラ内で、__InstanceOperationEvent の Path_.Class プロパティを使用します。



図10
実行例
  • Path_.Class プロパティの値が
  • __InstanceCreationevent は起動
  • __InstanceModificationEvent は変更
  • __InstanceDeletionEvent は終了

リスト8
組み込みイベントクラス__InstanceOperationEvent を使用してメモ帳だけの起動終了等を監視 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してメモ帳の起動や終了を監視
//  __InstanceOperationEventを使用
//  メモ帳だけの起動監視のため、ISA句にメモ帳を指定
//  Win32_Processクラスのcaptionプロパティで指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceOperationEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_Process" and '
          + 'TargetInstance.caption = "notepad.exe"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  PropValue : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));

  Memo1.Lines.Add('Path_.Class   : ' + VarToStr(PropVal.Path_.Class));
  Memo1.Lines.Add('Caption       : ' + VarToStr(PropValue.Caption));
  Memo1.Lines.Add('ProcessID     : ' + VarToStr(PropValue.ProcessID));
  Memo1.Lines.Add('----------------------------------')
end;

end.



12_リムーバブルディスクの挿入を監視  - Win32_LogicalDisk


組み込みイベントクラスの __InstanceCreationEvent を使用して、USB ポートへ、USB ディスクメモリを挿入した時を検出します。ターゲットクラスを Win32_LogicalDisk としています。
USB だけを検出するために、Win32_LogicalDisk の DriveType プロパティの値が 2 の時だけイベントが発生するように、クエリを設定しています。実際には、2 はリムーバブルディスクの意味です。

ここで監視するのは、ディスクメモリの USB です。他の USB 機器の監視は、Win32_LogicalDisk クラスではできません。



[備考]
Win32_DiskDrive クラスをターゲットとすると、InterfaceType プロパティの値で、USB ディスクを判定できますが、C:, D: 等のドライブレターは検出できません。




図11
実行例

リスト9
組み込みイベントクラスの __InstanceCreationEvent を使用して、USB ディスクの挿入を監視
ターゲットクラスを Win32_LogicalDisk とした場合 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してリムーバブルディスクの挿入を監視
//  __InstanceCreationEventを使用
//  ここでは、USBに限定するために、ISA句でDriveType = 2を指定
//  Win32_LogicalDiskクラスのDriveTypeプロパティで指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceCreationEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_LogicalDisk" and TargetInstance.DriveType = 2';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal   : OleVariant;
  PropValue : OleVariant;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  Memo1.Lines.Add('Caption        : ' + VarToStr(PropValue.Caption));
  Memo1.Lines.Add('FreeSpace      : ' + VarToStr(PropValue.FreeSpace));
  Memo1.Lines.Add('----------------------------------')
end;

end.



13_リムーバブルディスクの挿入を監視  -  Win32_Volume


上と同じく、組み込みイベントクラスの __InstanceCreationEvent を使用して、USB ポートへ、USB ディスクメモリを挿入した時を検出しますが、このサンプルでは、Win32_Volume をターゲットクラスとしています。
Win32_Volume と Win32_LogicalDisk クラスとでは取得可能なプロパティが違いますが、同じディスク関係のクラスなので、プロパティの取得が可能です。
USB だけを検出するために、Win32_Volume の DriveType プロパティの値が 2 の時だけイベントが発生するように、クエリを設定しています。実際には、2 はリムーバブルディスクの意味です。

ここで監視するのは、ディスクメモリの USB です。他の USB 機器の監視は、Win32_Volume クラスではできません。



図12
実行例

リスト10
組み込みイベントクラスの __InstanceCreationEvent を使用して、USB ディスクの挿入を監視
ターゲットクラスを Win32_Volume とした場合 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してリムーバブルディスクの挿入を監視
//  __InstanceCreationEventを使用
//  ここでは、USBに限定するために、ISA句でDriveType = 2を指定
//  Win32_VolumeクラスのDriveTypeプロパティで指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceCreationEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_Volume" and TargetInstance.DriveType = 2';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal   : OleVariant;
  PropValue : OleVariant;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  Memo1.Lines.Add('Caption        : ' + VarToStr(PropValue.Caption));
  Memo1.Lines.Add('FreeSpace      : ' + VarToStr(PropValue.FreeSpace));
  Memo1.Lines.Add('----------------------------------')
end;

end.



14_リムーバブルディスクの取り外しを監視  - Win32_LogicalDisk


組み込みイベントクラスの __InstanceDeletionEvent を使用して、USB ディスクメモリの取り外しを検出します。ターゲットクラスを Win32_LogicalDisk としています。
USB だけを検出するために、Win32_LogicalDisk の DriveType プロパティの値が 2 の時だけイベントが発生するように、クエリを設定しています。実際には、2 はリムーバブルディスクの意味です。

ここで監視するのは、ディスクメモリの USB です。他の USB 機器の監視は、Win32_LogicalDisk クラスではできません。



図13
実行例

リスト11
組み込みイベントクラスの _InstanceDeletionEvent を使用して、USB ディスクの取り外しを監視
ターゲットクラスを Win32_LogicalDisk とした場合 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してリムーバブルディスクの取り外しを監視
//  __InstanceDeletionEventを使用
//  ここでは、USBに限定するために、ISA句でDriveType = 2を指定
//  Win32_LogicalDiskクラスのDriveTypeプロパティで指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceDeletionEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_LogicalDisk" and TargetInstance.DriveType = 2';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal   : OleVariant;
  PropValue : OleVariant;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  Memo1.Lines.Add('Caption        : ' + VarToStr(PropValue.Caption));
  Memo1.Lines.Add('FreeSpace      : ' + VarToStr(PropValue.FreeSpace));
  Memo1.Lines.Add('----------------------------------')
end;

end.



15_リムーバブルディスクの取り外しを監視  - Win32_Volume


上と同じく、組み込みイベントクラスの __InstanceDeletionEvent を使用して、USB ディスクメモリの取り外しを検出します。ターゲットクラスを Win32_Volume としています。

Win32_Volume と Win32_LogicalDisk クラスとでは取得可能なプロパティが違いますが、同じディスク関係のクラスなので、プロパティの取得が可能です。
USB だけを検出するために、Win32_Volume の DriveType プロパティの値が 2 の時だけイベントが発生するように、クエリを設定しています。実際には、2 はリムーバブルディスクの意味です。

ここで監視するのは、ディスクメモリの USB です。他の USB 機器の監視は、Win32_Volume クラスではできません。



図14
実行例

リスト12
組み込みイベントクラスの _InstanceDeletionEvent を使用して、USB ディスクの取り外しを監視
ターゲットクラスを Win32_Volume とした場合 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してリムーバブルディスクの取り外しを監視
//  __InstanceDeletionEventを使用
//  ここでは、USBに限定するために、ISA句でDriveType = 2を指定
//  Win32_VolumeクラスのDriveTypeプロパティで指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceDeletionEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_Volume" and TargetInstance.DriveType = 2';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal   : OleVariant;
  PropValue : OleVariant;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  Memo1.Lines.Add('Caption        : ' + VarToStr(PropValue.Caption));
  Memo1.Lines.Add('FreeSpace      : ' + VarToStr(PropValue.FreeSpace));
  Memo1.Lines.Add('----------------------------------')
end;

end.



16_リムーバブルディスクの着脱を監視  - Win32_LogicalDisk


組み込みイベントクラスの __InstanceOperationEvent を使用して、USB ディスクメモリの挿入と取り外しの両方を監視します。ターゲットクラスを Win32_LogicalDisk としています。
USB だけを検出するために、Win32_LogicalDisk の DriveType プロパティの値が 2 の時だけイベントが発生するように、クエリを設定しています。実際には、2 はリムーバブルディスクの意味です。

挿入か取り外しかの判定は、イベントハンドラ内で、__InstanceOperationEvent の Path_.Class プロパティを使用します。

ここで監視するのは、ディスクメモリの USB です。他の USB 機器の監視は、Win32_LogicalDisk クラスではできません。



図15
実行例
  • Path_.Class プロパティの値が
  • __InstanceCreationevent は起動
  • __InstanceModificationEvent は変更
  • __InstanceDeletionEvent は終了

リスト13
組み込みイベントクラスの __InstanceOperationEvent を使用して、USB ディスクの着脱を監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してリムーバブルディスクの着脱を監視
//  __InstanceOperationEventを使用
//  ここでは、USBに限定するために、ISA句でDriveType = 2を指定
//  Win32_LogicalDiskクラスのDriveTypeプロパティで指定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceOperationEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_LogicalDisk" and TargetInstance.DriveType = 2';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  PropValue : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  //イベントの発生日時
  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  if ADateTime > 0 then begin
    Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));
  end;

  Memo1.Lines.Add('Path_.Class   : ' + VarToStr(PropVal.Path_.Class));
  Memo1.Lines.Add('Caption       : ' + VarToStr(PropValue.Caption));
  Memo1.Lines.Add('----------------------------------')
end;

end.



17_USB デバイスの着脱を監視  - Win32_USBControllerDevice


ここままでの USB のサンプルは、USB ディスクが対象でした。
他の USB 機器の場合は、例えば Win32_USBControllerDevice を使用すると可能です。組み込みイベントクラスの __InstanceOperationEvent を使用して監視するサンプルを作成してみました。
上の USB ディスクのサンプルのように、他に使用可能なクラスがあるかも知れません。

Win 32_USBControllerDevice は、MSDN オンラインの記事によると、次のようになっています。 



class Win32_USBControllerDevice : CIM_ControlledBy
{
  uint16            AccessState;
  CIM_USBController REF Antecedent;
  CIM_LogicalDevice REF Dependent;
  uint32            NegotiatedDataWidth;
  uint64            NegotiatedSpeed;
  uint32            NumberOfHardResets;
  uint32            NumberOfSoftResets;
};


Antecedent は CIM_USBController クラスへの参照、Dependent は CIM_LogicalDevice クラスの参照となっています。そこで、 Antecedent プロパティからは CIM_USBController のインスタンスを取得し、Dependent プロパティから CIM_LogicalDevice のインスタンスを取得して、いくつかのプロパティを取得した結果が下の図とコードです。

テストは、デジカメに USB ケーブルを接続し、それをコンピュータの USB ポートに挿入しています。
CIM_LogicalDevice クラスのプロパティ Caption の値が、Canon PowerShot S100 というデジカメの名前となっています。



図16
具体的なプロパティの値を取得
  • Path_.Class プロパティの値が
  • __InstanceCreationevent は挿入
  • __InstanceDeletionEvent は取り外し

下図は、テストに使用したデジカメを、コンピュータに接続した時のエクスプローラでの表示です。
CIM_LogicalDevice クラスの、Caption プロパティの値と同じになっています。


図17
デジカメを接続

リスト14
組み込みイベントクラスの __InstanceOperationEvent を使用して、USB デバイスの着脱を監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してUSBデバイスの着脱を監視
//  __InstanceOperationEventを使用
//  Win32_USBControllerDeviceクラスのプロパティを取得するようにする設定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM __InstanceOperationEvent '
          + 'WITHIN 1 '
          + 'WHERE TargetInstance '
          + 'ISA "Win32_USBControllerDevice"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal       : OleVariant;
  PropValue     : OleVariant;
  objWMIservice : OleVariant;
  PathClass     : String;
  AInstance     : OleVariant;
begin
  PropVal   := objWbemObject;
  PropValue := PropVal.TargetInstance;

  //OleVariant型で扱うことにする
  //FobjWMIServiceは、現在接続中のWMIサービスのインスタンス
  objWMIservice := FobjWMIService;
  //Win32_USBControllerDeviceクラスのプロパティAntecedent(CIM_USBController)の
  //インスタンスを取得
  AInstance     := objWMIservice.Get(PropValue.Antecedent);

  PathClass := String(PropVal.Path_.Class);
  Memo1.Lines.Add('Path_.Class    : ' + PathClass);
  Memo1.Lines.Add('caption        : ' + VarToStr(AInstance.caption));
  Memo1.Lines.Add('Manufacturer   : ' + VarToStr(AInstance.Manufacturer));

  if UpperCase(PathClass) = UpperCase('__InstancecreationEvent') then begin
    //Win32_USBControllerDeviceクラスのプロパティDependent(CIM_LogicalDevice)の
    //インスタンスを取得
    AInstance := objWMIservice.Get(PropValue.Dependent);
    Memo1.Lines.Add('DeviceCaption  : ' + VarToStr(AInstance.Caption));
  end;
  Memo1.Lines.Add('----------------------------------');
end;

end.



18_Win32_VolumeChangeEvent を使用したドライブ変更の監視


リムーバブルディスク限定ではありませんが、外部イベントクラスの Win32_VolumeChangeEvent を使用すると、ディスクドライブの変更を検出することができます。
このクラスの EventType プロパティで操作内容が特定できます。また、DriveName プロパティがドライブレターとなっています。目的の USB ドライブレターが分かっているのであれば、FROM 句の検索条件に追加しておけば、そのドライブだけを監視対象とすることができます。

ここまでのサンプルで、いくつかのクラスを使用してテストしていますが、監視の結果をどのように利用するのか、その目的により使い分けることになるでしょう。



図18
ドライブの変更イベントを監視
  • EventType が 2 の時は挿入
  • EventType が 3 の時は取り外し

リスト15
外部イベントクラス Win32_VolumeChangeEvent を使用して、ドライブ変更を監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  外部イベントクラスを使用してディスクドライブの変更を監視
//  Win32_VolumeChangeEventを使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM Win32_VolumeChangeEvent ';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);

  //---------------------------------------------------------------------------
  //  TSWbemSinkのイベントハンドラの引数から取得した整数型の日付時刻の値を、
  //  DelphiのTDateTime型に変換して返す関数
  //---------------------------------------------------------------------------
  function EventTimeToTDateTime(V: OleVariant): TDateTime;
  var
    WMIDateTime : ISWbemDateTime;
  begin
    Result := 0;
    if VarIsNull(V) then exit;

    WMIDateTime := CoSWbemDateTime.Create;
    //TIME_CREATEDプロパティをFILETIME形式からVT_DATE形式に変換
    WMIDateTime.SetFileTime(V, False);
    Result := WMIDateTime.GetVarDate(True);
  end;
  //---------------------------------------------------------------------------

var
  PropVal   : OleVariant;
  ADateTime : TDateTime;
begin
  PropVal := objWbemObject;

  //イベントの発生日時
  ADateTime := EventTimeToTDateTime(PropVal.TIME_CREATED);
  if ADateTime > 0 then begin
    Memo1.Lines.Add('TIME_CREATED  : ' + DateTimeToStr(ADateTime));
  end;

  Memo1.Lines.Add('DriveName     : ' + VarToStr(PropVal.DriveName));
  Memo1.Lines.Add('EventType     : ' + VarToStr(PropVal.EventType));
  Memo1.Lines.Add('----------------------------------');
end;

end.



19_ネットワークの切断を監視


このページの記事のテストをしている時に、ネットワーク切断の監視用サンプルを見つけました。
それは MSNdis_StatusMediaDisconnect というクラスを使用するものです。
これは、NDIS (Network Driver Interface Specification) 用の WMI のクラスの様ですが、残念ながら MSDN オンラインで解説記事を見つけることができませんでした。
NDIS 関係の WMI クラスにどんなものがあるかは確認できます。Power Shell を起動して、次のコマンドを実行してみてください。かなりの数があることがわかります。図は、その実行結果です。


Get-WmiObject -Namespace root\wmi -List | Where-Object {$_.name -Match "MSNdis" } | Sort-Object


図19
WMI 関係のクラス一覧

ネット上のサンプルを Delphi に移植したのが下のコードです。図は実行結果です。
移植したと言っても、単に FROM 句に MSNdis_StatusMediaDisconnect 書いただけです。このサンプルでは、プロパティの一覧を取得するだけとしています。
参考までに、ネットワークの接続を検出するのは、MSNdis_StatusMediaConnect だそうです


図20
実行例
  • 有線 LAN のケーブルを、コンピュータから外した結果
  • TIME_CREATED はイベントの発生日時

リスト16
MSNdis_StatusMediaDisconnect クラスを使用したネットワーク切断の監視 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの外部イベントクラスを使用してネットワークの切断を監視
//  MSNdis_StatusMediaDisconnectを使用
//  実行には管理者権限が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\wmi',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;

  strSQL := 'SELECT * '
          + 'FROM MSNdis_StatusMediaDisconnect ';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);
end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
begin
  Memo1.Lines.Text := objWbemObject.GetObjectText_(0);
end;

end.



20_指定ディレクトリ内のファイルの作成削除を監視


組み込みイベントクラスの __InstanceOperationEvent を使用して、指定ディレクトリ (フォルダ) 内のファイルの作成と削除を監視します。フォルダの作成や削除は検出できません。
CIM_DirectoryContainsFile をターゲットクラスにしています。

Win32_Directory クラスの Name プロパティで、検出対象のディレクトリを設定しています。
Win32_Directory クラスは、CIM_Directory オブジェクトの継承クラスです。
イベント内では、作成または削除したファイル名を表示するようにしています。図は、設定したフォルダ内に、エクスプローラで新規にテキストファイルを作成し、名前を AAA.txt に変更後、削除した結果です。



図21
実行例
  • __InstanceCreationevent の時が作成
  • __InstanceDeletionEvent の時が削除
  • ファイル名は作成または削除したファイル

リスト17
指定ディレクトリ内のファイルの作成削除を監視		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FobjWMILocator : ISWbemLocator;
    FobjWMIService : ISWbemServices;
    FobjWMISink    : TSWbemSink;
    procedure EventOnObjectReady(ASender: TObject; const objWbemObject: ISWbemObject;
      const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, ActiveX;

{$R *.dfm}

//=============================================================================
//  [監視開始]ボタン
//
//  WMIの組み込みイベントクラスを使用してファイルの作成と削除を監視
//  ターゲットクラスはCIM_DirectoryContainsFile
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  strSQL : String;
  TargetDir : String;
begin
  Button1.Enabled := False;
  Button2.Enabled := True;
  Memo1.Lines.Clear;

  FobjWMILocator := CoSWbemLocator.Create;
  FobjWMIService := FobjWMILocator.ConnectServer(
                            'localhost',
                            'root\cimv2',
                            '',
                            '',
                            '',
                            '',
                            wbemConnectFlagUseMaxWait,
                            nil);

  FobjWMISink     := TSWbemSink.Create(self);
  FobjWMISink.OnObjectReady := EventOnObjectReady;


  //監視対象のディレクトリ(ここでは、このEXEがあるフォルダ)
  TargetDir  := ExtractFileDir(Application.ExeName);
  //クエリに渡すパス名のパス区切り文字は \ ではなく \\ とする
  TargetDir  := StringReplace(TargetDir, '\', '\\', [rfReplaceAll]);
  //文字列の中の文字列の、更に文字列用にシングルクォーテーションを追加
  TargetDir := QuotedStr(TargetDir);

  strSQL := 'SELECT * '
     + 'FROM __InstanceOperationEvent '
     + 'WITHIN 1 '
     + 'WHERE TargetInstance '
     + 'ISA "CIM_DirectoryContainsFile" and '
     + 'TargetInstance.GroupComponent = "Win32_Directory.Name=' + TargetDir + '"';

  FobjWMIService.ExecNotificationQueryAsync(
                            FobjWMISink.DefaultInterface,
                            strSQL,
                            'WQL',
                            0,
                            nil,
                            nil);

end;

//=============================================================================
//  [監視終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if FobjWMISink <> nil then begin
    FobjWMISink.Cancel;
    FobjWMILocator :=nil;
    FobjWMIService :=nil;
    FobjWMISink    :=nil;

    Button1.Enabled := True;
    Button2.Enabled := False;
 end;
end;

//=============================================================================
//  TSWbemSinkのOnObjectReadyイベントのコード
//  イベントの宣言部と、この実装部はWbemScripting_TLBのコードをコピペ
//=============================================================================
procedure TForm1.EventOnObjectReady(ASender: TObject;
  const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal   : OleVariant;
  PathClass : String;
  strTarget : String;
  iPos      : Integer;
  strProp   : String;
begin
  PropVal := objWbemObject;

  PathClass := String(PropVal.Path_.Class);
  Memo1.Lines.Add(PathClass);

  strTarget := VarToStr(PropVal.TargetInstance.PartComponent);
  iPos      := Pos('Name=', strTarget);
  strProp   := Copy(strTarget, iPos + 5, Length(strTarget));
  strProp   := StringReplace(strProp, '\\', '\', [rfReplaceAll]);
  strProp   := AnsiDequotedStr(strProp, '"');
  Memo1.Lines.Add(strProp);
  Memo1.Lines.Add('-----------------------------------------------------------');
end;

end.