列挙されたComポートを使い通信ソフトを作る。

こんにちは、やましょうです。
4日目に@ht_dekoさんがcomポート列挙するとやっていたので、
アプリ化してみました。

必要なアプリは１つ、
① com0com (仮想シリアルポートのツールです）　通信チェックには超便利です。
ここが詳しい
②Wuni232cを入れる。
ここにある

あとは適当につくる。

ソース以下

unit Unit12;

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,
  WUni232c, Vcl.ExtCtrls,System.RegularExpressions;

type
  TForm12 = class(TForm)
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    WUni232c1: TWUni232c;
    WUni232c2: TWUni232c;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
    procedure EnumComPort;
  public
    { Public 宣言 }
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}


function GetCOMNumber(const InputStr: string): string;
var
  Match: TMatch;
begin
  Result := '';
  Match := TRegEx.Match(InputStr, '\(COM(\d+)\)');
  if Match.Success then
    Result := Match.Groups[1].Value;
end;

procedure TForm12.Button1Click(Sender: TObject);
var
  Str: AnsiString;
  ByteArray: TBytes;
  i: Integer;
begin
    if( wuni232c1.Connect ) then
    begin
       SetLength(ByteArray, Length(Edit1.Text));
       for i := 1 to Length(Edit1.Text) do
        ByteArray[i - 1] := Byte(Edit1.Text[i]);
        if(Length(Edit1.Text) <> 0) then  wuni232c1.Write(Length(Edit1.Text),@ByteArray[0]);
        Edit1.Text := '';
    end;
end;

procedure TForm12.Button2Click(Sender: TObject);
var
  Str: AnsiString;
  ByteArray: TBytes;
  i: Integer;
begin
    if( wuni232c2.Connect ) then
    begin

       SetLength(ByteArray, Length(Edit2.Text));
       for i := 1 to Length(Edit2.Text) do
        ByteArray[i - 1] := Byte(Edit2.Text[i]);
        if(Length(Edit2.Text) <> 0) then  wuni232c2.Write(Length(Edit2.Text),@ByteArray[0]);
        Edit2.Text := '';
    end;
end;


procedure TForm12.Button4Click(Sender: TObject);
begin
    if( wuni232c1.Connect ) then
    begin
      wuni232c1.Close();
      Button4.Caption := 'OPEN';
    end
    else
    begin
      wuni232c1.Port := StrToInt(GetCOMNumber(ComBoBox1.Items[ComBoBox1.ItemIndex]));
      wuni232c1.Open();
      Button4.Caption := 'CLOSE';
    end;
end;

procedure TForm12.Button3Click(Sender: TObject);
begin
    if( wuni232c2.Connect ) then
    begin
      wuni232c2.Close();
      Button3.Caption := 'OPEN';
    end
    else
    begin
      wuni232c2.Port := StrToInt(GetCOMNumber(ComBoBox2.Items[ComBoBox2.ItemIndex]));
      wuni232c2.Open();
      Button3.Caption := 'CLOSE';
    end;
end;

procedure TForm12.Timer1Timer(Sender: TObject);
var
 ReadCount : integer;
 ByteArray: array[0..255] of Byte; // 256バイトのバイト配列
 Str : AnsiString;
begin
    if( wuni232c1.Connect ) then
    begin
      ReadCount := wuni232c1.Read($100,@ByteArray[0]);
      if(ReadCount <> 0 ) then begin
      SetString(Str, PAnsiChar(@ByteArray[0]), ReadCount);
      memo1.lines.add(Str);
      end;
    end;
    if( wuni232c2.Connect ) then
    begin
      ReadCount := wuni232c2.Read($100,@ByteArray[0]);
      if(ReadCount <> 0 ) then begin
        SetString(Str, PAnsiChar(@ByteArray[0]), ReadCount);
        memo2.lines.add(Str);
      end;
    end;
end;


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

procedure TForm12.EnumComPort;
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      CoInitialize(nil);
      TThread.Synchronize(nil,
        procedure
        begin
          ComboBox1.Clear();
          ComboBox2.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
               ComboBox1.Items.add( PropSet.Item('Name', 0).Get_Value);
               ComboBox2.Items.add( PropSet.Item('Name', 0).Get_Value);
               if(ComboBox1.ItemIndex < 0) then ComboBox1.ItemIndex := 1;
               if(ComboBox2.ItemIndex < 0) then ComboBox2.ItemIndex := 1;
             end);
        end;
      finally
        SWbemLocator.Free;
        CoUninitialize;
      end;
    end
  ).Start;
end;

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


end.

こんな感じでできる筈。

以上

遂に更新費用が大台にのったので、今年で最後かもしれませぬ。。。

いままでありがとう
以上
やましょうでした。