DelphiAdvent Calendar 2024

【Delphi】利用可能な COM ポートを列挙する【WMI】

Last updated at 2024-12-05Posted at 2024-12-03

はじめに

Delphi Users (Japan) で質問のあった「シリアルポートの監視と列挙」の件をやってみたいと思います。

コードは『Delphi 12 Athens』で書かれています。

シリアルポート (Wikipedia)

シリアル (COM) ポートの監視と列挙

シリアルポートの監視は WM_DEVICECHANGE メッセージで DBT_DEVICEARRIVAL と DBT_DEVICEREMOVECOMPLETE を監視すれば良さそうです。

メディア挿入または削除の検出 (learn.microsoft.com)

列挙にはレジストリを読む方法と WMI (Windows Management Instrumentation) で取得する方法がありますが、レジストリで読む方法はうまくいかなかったという事で、WMI で取得してみます。

See also:

Windows Management Instrumentation (learn.microsoft.com)

WMI の使い方

Delphi から WMI を使うには、まず [コンポーネント | コンポーネントのインポート] から、Delphi インターフェイスファイル (*_TLB.pas) を生成します。

Delphi インターフェイスファイルの生成

まず [コンポーネント | コンポーネントのインポート] で、タイプライブラリの取り込みを行います。

Microsoft WMI Scriptiong V1.2 Library を選びます。

一応コンポーネントラッパーも作っておきましょう。

パッケージに登録せず、ユニットだけ作る事にします。

$(BDSUSERDIR)\Imports に WbemScripting_TLB.pas が生成されています。この場所は通常ライブラリパスが通っているので、あらためてライブラリパスを通さなくても OK です。

コマンドラインツールでインターフェイスファイルを生成する

コマンドラインツール TLIBIMP.EXE を使ってインターフェイスファイルを生成する事もできます。

32bit Windows の場合には次のコマンドで WbemScripting_TLB.pas が生成されます。

TLIBIMP -P C:\Windows\System32\wbem\wbemdisp.TLB

64bit Windows の場合には次のコマンドで WbemScripting_TLB.pas が生成されます。

TLIBIMP -P C:\Windows\SysWOW64\wbem\wbemdisp.TLB

XE2 以降の Delphi には $(BDS)\bin と $(BDS)\bin64 の両方に TLIBIMP.EXE がありますが、今回の場合はどちらを使っても構いません。

See also:

TLIBIMP.EXE (DocWiki)

WMI の基本的な使い方

定型なので難しくはありません。Delphi 10.3 Rio 以降だとインライン変数宣言と型推論が使えるのでスッキリ書けます。uses に先程作った WbemScripting_TLB (と ActiveX) を追加しておいてください。

uses
  ..., WinApi.ActiveX, WbemScripting_TLB;

...

  var SWbemLocator := TSWbemLocator.Create(nil);
  try
    var Service := SWbemLocator.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil);
    var WQL := ''; // WQL を記述
    var ObjectSet := Service.ExecQuery(WQL, 'WQL', wbemFlagReturnImmediately, nil);
    var Enum := IUnknown(ObjectSet._NewEnum) as IEnumVariant;
    var TempObj: OleVariant;
    var Value: LongWord;
    while Enum.Next(1, TempObj, Value) = S_OK do
    begin
      var PropSet := (IUnknown(TempObj) as ISWBemObject).Properties_;
      var FieldName := ''; // ここにフィールド名
      var &Property := PropSet.Item(FieldName, 0);
      if not VarIsNull(&Property.Get_Value) then
      begin
        // &Property.Get_Value が値
        // Null を調べる必要がないなら
        // PropSet.Item(FieldName, 0).Get_Value; で値を取れる
      end;
    end;
  finally
    SWbemLocator.Free;
  end;

上記サンプルでは WQL (WMI 用の SQL) を実行し、グルグル回して値を取得するという事をやっています。

WQL (WMI 用の SQL) (learn.microsoft.com)

CreateOleObject()

全部 OLEVariant なので入力補完とか利きませんけど、それでもよければタイプライブラリを取り込まずに CreateOleObject() でやる方法もあります。

uses
  ..., WinApi.ActiveX, System.Win.ComObj;
  
...  

const
  wbemFlagForwardOnly = $20;
begin
  var SWbemLocator: OLEVariant := CreateOleObject('WbemScripting.SWbemLocator');
  var Service := SWbemLocator.ConnectServer('.', 'root\CIMV2', '', '');
  var WQL := ''; // WQL を記述
  var ObjectSet := Service.ExecQuery(WQL, 'WQL', wbemFlagForwardOnly);
  var Enum := IUnknown(ObjectSet._NewEnum) as IEnumVariant;
  var TempObj: OleVariant;
  var Value: LongWord;
  while Enum.Next(1, TempObj, Value) = S_OK do
  begin
    var PropSet := TempObj.Properties_;
    var FieldName := ''; // ここにフィールド名
    var &Property := PropSet.Item(FieldName);
    if not VarIsNull(&Property.Value) then
    begin
      // &Property.Value が値
      // Null を調べる必要がないなら
      // TempObj.Properties_.Item(FieldName).Value; で値を取れる
    end;
  end;

Winapi.Wbem

Delphi XE3 以降では Winapi.Wbem ユニットも使えます。

...が、あんまり便利じゃないんだよなぁ。ドキュメントもないし。

See also:

Winapi (DocWiki)

プラグアンドプレイデバイスの列挙

「COM ポートが抜き差しされる」という事は RS-232C の物理コネクタが PC にあるのではなく、USB シリアル変換みたいなものなのだろうと思われます。プラグアンドプレイデバイスは Win32_PnPEntity クラス で列挙できます。

Win32_PnPEntity クラス (learn.microsoft.com)

WQL はこんな感じですね。

SELECT * FROM Win32_PnPEntity

ここで COM ポートのみを探すには、Win32_PnPEntity.PNPClass フィールドが Ports になっていて、名前に (COM が含まれるものを列挙すればよさそうです。WQL はこんな感じになります。

SELECT * FROM Win32_PnPEntity WHERE (PNPClass = 'Ports') and (Name LIKE '%(COM%')

次のようなアプリケーションを作ってテストしてみましょう。ボタンを押すとメモに COM ポートが列挙されます。

procedure TForm1.EnumComPort;
begin
  Memo1.Clear;
  var SWbemLocator := TSWbemLocator.Create(nil);
  try
    var Service := SWbemLocator.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil);
    var WQL := 'SELECT * FROM Win32_PnPEntity WHERE (PNPClass = ''Ports'') and (Name LIKE ''%(COM%'')';
    var ObjectSet := Service.ExecQuery(WQL, 'WQL', wbemFlagReturnImmediately, nil);
    var Enum := IUnknown(ObjectSet._NewEnum) as IEnumVariant;
    var TempObj: OleVariant;
    var Value: LongWord;
    while Enum.Next(1, TempObj, Value) = S_OK do
    begin
      var PropSet := (IUnknown(TempObj) as ISWBemObject).Properties_;
      Memo1.Lines.Add(PropSet.Item('Name', 0).Get_Value);
    end;
  finally
    SWbemLocator.Free;
  end;
end;

procedure TForm1.EnumClick(Sender: TObject);
begin
  EnumComPort;
end;

正しく列挙できたようです。

プラグアンドプレイの検出

今度はプラグアンドプレイに対応させてみます。ボタンを削除して、フォームの OnShow イベントで列挙するようにします。

procedure TForm1.FormShow(Sender: TObject);
begin
  EnumComPort;
end;

次に WM_DEVICECHANGE のメッセージハンドラを記述します。

  private
    { Private 宣言 }
    procedure DeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;

...

procedure TForm1.DeviceChange(var Msg: TMessage);
const
  DBT_DEVICEARRIVAL        = $8000;
  DBT_DEVICEREMOVECOMPLETE = $8004;
begin
  case Msg.WParam of
    DBT_DEVICEARRIVAL,
    DBT_DEVICEREMOVECOMPLETE:
      EnumComPort;
  end;
end;

実行してみましょう。起動時に COM ポートが列挙されています。

デバイスを挿抜すると...

---------------------------
Project1
---------------------------
アプリケーションが入力同期呼び出しをディスパッチしているため、呼び出せません。.
---------------------------
OK   
---------------------------

Windows メッセージの中にはブロックしてはいけないものがあり、さっさと処理を渡さないといけないものがあります。今回もその類だと思います。このような時に私が採る解決方法は 3 つあります。

タイマーを起動して OnTimer イベントハンドラの中で処理する
PostMessage() で別のメッセージ (WM_APP + 1 とか) を自身に投げて、そのメッセージハンドラの中で処理する
処理をスレッドで実行する

今回はスレッドで解決してみましょう。CreateAnonymousThread() でスレッドを作成します。

procedure TForm1.EnumComPort;
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Synchronize(nil,
        procedure
        begin
          Memo1.Clear;
        end);
      var SWbemLocator := TSWbemLocator.Create(nil);
      try
        var Service := SWbemLocator.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil);
        var WQL := 'SELECT * FROM Win32_PnPEntity WHERE (PNPClass = ''Ports'') and (Name LIKE ''%(COM%'')';
        var ObjectSet := Service.ExecQuery(WQL, 'WQL', wbemFlagReturnImmediately, nil);
        var Enum := IUnknown(ObjectSet._NewEnum) as IEnumVariant;
        var TempObj: OleVariant;
        var Value: LongWord;
        while Enum.Next(1, TempObj, Value) = S_OK do
        begin
          var PropSet := (IUnknown(TempObj) as ISWBemObject).Properties_;
          TThread.Synchronize(nil,
            procedure
            begin
              Memo1.Lines.Add(PropSet.Item('Name', 0).Get_Value);
            end);
        end;
      finally
        SWbemLocator.Free;
      end;
    end
  ).Start;
end;

実行してみると、

あ、スレッド内で COM (Component Object Model) を使っているのでした。CoInitialize() と CoUninitialize() で括らなきゃですね。

procedure TForm1.EnumComPort;
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      CoInitialize(nil); // 追加
      TThread.Synchronize(nil,
        procedure
        begin
          Memo1.Clear;
        end);
      var SWbemLocator := TSWbemLocator.Create(nil);
      try
        var Service := SWbemLocator.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil);
        var WQL := 'SELECT * FROM Win32_PnPEntity WHERE (PNPClass = ''Ports'') and (Name LIKE ''%(COM%'')';
        var ObjectSet := Service.ExecQuery(WQL, 'WQL', wbemFlagReturnImmediately, nil);
        var Enum := IUnknown(ObjectSet._NewEnum) as IEnumVariant;
        var TempObj: OleVariant;
        var Value: LongWord;
        while Enum.Next(1, TempObj, Value) = S_OK do
        begin
          var PropSet := (IUnknown(TempObj) as ISWBemObject).Properties_;
          TThread.Synchronize(nil,
            procedure
            begin
              Memo1.Lines.Add(PropSet.Item('Name', 0).Get_Value);
            end);
        end;
      finally
        SWbemLocator.Free;
        CoUninitialize; // 追加
      end;
    end
  ).Start;
end;

今度はどうでしょう？起動時は OK です。

一つデバイスを抜くと...

大丈夫のようです。全体のソースは次のようになりました。

Unit1.pas

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    procedure DeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
    procedure EnumComPort;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DeviceChange(var Msg: TMessage);
const
  DBT_DEVICEARRIVAL        = $8000;
  DBT_DEVICEREMOVECOMPLETE = $8004;
begin
  case Msg.WParam of
    DBT_DEVICEARRIVAL,
    DBT_DEVICEREMOVECOMPLETE:
      EnumComPort;
  end;
end;

procedure TForm1.EnumComPort;
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      CoInitialize(nil);
      TThread.Synchronize(nil,
        procedure
        begin
          Memo1.Clear;
        end);
      var SWbemLocator := TSWbemLocator.Create(nil);
      try
        var Service := SWbemLocator.ConnectServer('.', 'root\CIMV2', '', '', '', '', 0, nil);
        var WQL := 'SELECT * FROM Win32_PnPEntity WHERE (PNPClass = ''Ports'') and (Name LIKE ''%(COM%'')';
        var ObjectSet := Service.ExecQuery(WQL, 'WQL', wbemFlagReturnImmediately, nil);
        var Enum := IUnknown(ObjectSet._NewEnum) as IEnumVariant;
        var TempObj: OleVariant;
        var Value: LongWord;
        while Enum.Next(1, TempObj, Value) = S_OK do
        begin
          var PropSet := (IUnknown(TempObj) as ISWBemObject).Properties_;
          TThread.Synchronize(nil,
            procedure
            begin
              Memo1.Lines.Add(PropSet.Item('Name', 0).Get_Value);
            end);
        end;
      finally
        SWbemLocator.Free;
        CoUninitialize;
      end;
    end
  ).Start;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  EnumComPort;
end;

end.

おわりに

今回のコードを実用的なものにするには、

文字列から COMn の部分だけを抜き出すコードを書く
コンボボックスに列挙するようにする
挿抜されてもコンボボックスのリストが破綻しないようにする (選択されていないデバイスが抜かれても、アイテムは選択されたままにする)
前回選択されていた COM ポートがあればそれを選択状態にする

等々、やるべき事は多いのですが、今回はここまでにしておきます。

See also:

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up

【Delphi】利用可能な COM ポートを列挙する【WMI】

はじめに

シリアル (COM) ポートの監視と列挙

WMI の使い方

Delphi インターフェイス ファイルの生成

コマンドラインツールでインターフェイスファイルを生成する

WMI の基本的な使い方

CreateOleObject()

Winapi.Wbem

プラグアンドプレイデバイスの列挙

プラグアンドプレイの検出

おわりに

Delphi インターフェイスファイルの生成