delphi - programa - como saber si el puerto serial funciona

¿Cómo detectar la adición de un nuevo puerto serie?

Question

Para comunicarse con los microcontroladores, uso el puerto serie. Yo uso TCommPortDriver 2.1 que funciona bien. Sin embargo, carece de la capacidad de detectar la adición o eliminación de nuevos puertos. Esto sucede regularmente durante una sesión.

¿Hay algún evento que indique cuándo se ha agregado o eliminado un comportamiento?

Actualización 1

Probé la primera sugerencia de RRUZ y la convertí en un programa independiente. Reacciona en un WM_DEVICECHANGE cuando el cable está enchufado o fuera, pero WParam no muestra la llegada o la eliminación del dispositivo. Los resultados son:

msg = 537, wparam = 7, lparam = 0
msg = 537, wparam = 7, lparam = 0
msg = 537, wparam = 7, lparam = 0

El primer mensaje se envía cuando el cable USB está enchufado y los dos siguientes cuando está enchufado. La parte del mensaje muestra el mensaje WM_DEVICECHANGE (537) pero WParam es 7, que no es WM_DEVICECHANGE o DBT_DEVICEARRIVAL . LParam un poco el código para que el mensaje fuera procesado, pero como LParam es cero, esto no sirve de nada. Los resultados son idénticos a VCL y FMX. Como verificación, ver el código a continuación.

Actualización 2

Ahora tengo el código WMI en ejecución. Solo se dispara cuando se agrega un puerto COM, no hay reacción cuando se elimina uno. Resultados:

TargetInstance.ClassGuid      : {4d36e978-e325-11ce-bfc1-08002be10318} 
TargetInstance.Description    : Arduino Mega ADK R3 
TargetInstance.Name           : Arduino Mega ADK R3 (COM4) 
TargetInstance.PNPDeviceID    : USB/VID_2341&PID_0044/64935343733351E0E1D1 
TargetInstance.Status         : OK 

¿Podría esto explicar el hecho de que en el otro código esto no se ve como la adición de un puerto COM? Parece ver la nueva conexión como un puerto USB (lo que realmente es). El controlador Arduino traduce esto en un puerto COM pero WMI no lo reconoce. La mensajería de Windows ''ve'' un cambio en el puerto COM pero no puede detectar si se agrega o elimina.

De todos modos: el cambio de dispositivo funciona. Solo necesito enumerar los puertos COM para ver cuál está realmente presente y eso es algo que ya hice manualmente. Ahora puedo hacerlo automáticamente con WM_DEVICECHANGE . Acabo de agregar un evento al componente CPDrv.

¡Gracias RRUZ por tu código y ayuda!

  unit dev_change;

  interface

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

  type
    TProc = procedure (text: string) of object;

    BroadcastHdr  = ^DEV_BROADCAST_HDR;
    DEV_BROADCAST_HDR = packed record
      dbch_size: DWORD;
      dbch_devicetype: DWORD;
      dbch_reserved: DWORD;
    end;
    TDevBroadcastHdr = DEV_BROADCAST_HDR;

  type
    PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
    DEV_BROADCAST_DEVICEINTERFACE = record
      dbcc_size: DWORD;
      dbcc_devicetype: DWORD;
      dbcc_reserved: DWORD;
      dbcc_classguid: TGUID;
      dbcc_name: Char;
    end;
    TDevBroadcastDeviceInterface = DEV_BROADCAST_DEVICEINTERFACE;

  const
    DBT_DEVICESOMETHING        = $0007;
    DBT_DEVICEARRIVAL          = $8000;
    DBT_DEVICEREMOVECOMPLETE   = $8004;
    DBT_DEVTYP_DEVICEINTERFACE = $00000005;

  type
    TDeviceNotifyProc = procedure(Sender: TObject; const DeviceName: String) of Object;
    TDeviceNotifier = class
    private
      hRecipient: HWND;
      FNotificationHandle: Pointer;
      FDeviceArrival: TDeviceNotifyProc;
      FDeviceRemoval: TDeviceNotifyProc;
      FOnWin: TProc;

      procedure WndProc(var Msg: TMessage);

    public
      constructor Create(GUID_DEVINTERFACE : TGUID);
      property OnDeviceArrival: TDeviceNotifyProc read FDeviceArrival write FDeviceArrival;
      property OnDeviceRemoval: TDeviceNotifyProc read FDeviceRemoval write FDeviceRemoval;
      destructor Destroy; override;

      property OnWin: TProc read FOnWin write FOnWin;
    end;

    TForm1 = class(TForm)
      Memo: TMemo;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
    private
      { Private declarations }
      DeviceNotifier : TDeviceNotifier;
    public
      { Public declarations }
      procedure arrival(Sender: TObject; const DeviceName: String);
      procedure report (text: string);
    end;

  var
    Form1: TForm1;

  implementation

  {$R *.dfm}

  constructor TDeviceNotifier.Create(GUID_DEVINTERFACE : TGUID);
  var
    NotificationFilter: TDevBroadcastDeviceInterface;
  begin
    inherited Create;
    hRecipient := AllocateHWnd(WndProc);
    ZeroMemory (@NotificationFilter, SizeOf(NotificationFilter));
    NotificationFilter.dbcc_size := SizeOf(NotificationFilter);
    NotificationFilter.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
    NotificationFilter.dbcc_classguid  := GUID_DEVINTERFACE;
    //register the device class to monitor
    FNotificationHandle := RegisterDeviceNotification(hRecipient, @NotificationFilter, DEVICE_NOTIFY_WINDOW_HANDLE);
  end;

  procedure TDeviceNotifier.WndProc(var Msg: TMessage);
  var
    Dbi: PDevBroadcastDeviceInterface;
  begin
    OnWin (Format (''msg = %d, wparam = %d, lparam = %d'', [msg.Msg, msg.WParam, msg.LParam]));
    with Msg do
    if (Msg = WM_DEVICECHANGE) and ((WParam = DBT_DEVICEARRIVAL) or (WParam = DBT_DEVICEREMOVECOMPLETE) or
                                    (WParam = DBT_DEVICESOMETHING)) then
    try
      Dbi := PDevBroadcastDeviceInterface (LParam);
      if Dbi.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE then
      begin
        if WParam = DBT_DEVICEARRIVAL then
        begin
          if Assigned(FDeviceArrival) then
            FDeviceArrival(Self, PChar(@Dbi.dbcc_name));
        end
        else
        if WParam = DBT_DEVICEREMOVECOMPLETE then
        begin
          if Assigned(FDeviceRemoval) then
            FDeviceRemoval(Self, PChar(@Dbi.dbcc_name));
        end;
      end;
    except
      Result := DefWindowProc(hRecipient, Msg, WParam, LParam);
    end
    else
      Result := DefWindowProc(hRecipient, Msg, WParam, LParam);
  end;

  destructor TDeviceNotifier.Destroy;
  begin
    UnregisterDeviceNotification(FNotificationHandle);
    DeallocateHWnd(hRecipient);
    inherited;
  end;

  procedure TForm1.arrival(Sender: TObject; const DeviceName: String);
  begin
     report (DeviceName);

     ShowMessage(DeviceName);
  end;

  procedure TForm1.FormCreate(Sender: TObject);
  const
    GUID_DEVINTERFACE_COMPORT  : TGUID = ''{86E0D1E0-8089-11D0-9CE4-08003E301F73}'';
  begin
    DeviceNotifier:=TDeviceNotifier.Create(GUID_DEVINTERFACE_COMPORT);
    DeviceNotifier.FDeviceArrival:=arrival;
    DeviceNotifier.OnWin := report;
  end;

  procedure TForm1.FormDestroy(Sender: TObject);
  begin
    DeviceNotifier.Free;
  end;

  procedure TForm1.report (text: string);
  begin
     Memo.Lines.Add (text);
  end;

  end.

Answer 1

Otra opción es usar los eventos WMI, en este caso usando el evento __InstanceCreationEvent y la clase WMI Win32_PnPEntity puede filtrar los puertos serie agregados usando el GUID de la clase {4d36e978-e325-11ce-bfc1-08002be10318} , escribiendo una oración WQL como tal

Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA "Win32_PnPEntity" AND TargetInstance.ClassGuid="{4d36e978-e325-11ce-bfc1-08002be10318}"

Prueba esta muestra

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows,
  {$IF CompilerVersion > 18.5}
  Forms,
  {$IFEND}
  SysUtils,
  ActiveX,
  ComObj,
  WbemScripting_TLB;

type
  TWmiAsyncEvent = class
  private
    FWQL      : string;
    FSink     : TSWbemSink;
    FLocator  : ISWbemLocator;
    FServices : ISWbemServices;
    procedure EventReceived(ASender: TObject; const objWbemObject: ISWbemObject; const objWbemAsyncContext: ISWbemNamedValueSet);
  public
    procedure  Start;
    constructor Create;
    Destructor Destroy;override;
  end;

//Detect when a key was pressed in the console window
function KeyPressed:Boolean;
var
  lpNumberOfEvents     : DWORD;
  lpBuffer             : TInputRecord;
  lpNumberOfEventsRead : DWORD;
  nStdHandle           : THandle;
begin
  Result:=false;
  nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  lpNumberOfEvents:=0;
  GetNumberOfConsoleInputEvents(nStdHandle,lpNumberOfEvents);
  if lpNumberOfEvents<> 0 then
  begin
    PeekConsoleInput(nStdHandle,lpBuffer,1,lpNumberOfEventsRead);
    if lpNumberOfEventsRead <> 0 then
    begin
      if lpBuffer.EventType = KEY_EVENT then
      begin
        if lpBuffer.Event.KeyEvent.bKeyDown then
          Result:=true
        else
          FlushConsoleInputBuffer(nStdHandle);
      end
      else
      FlushConsoleInputBuffer(nStdHandle);
    end;
  end;
end;

{ TWmiAsyncEvent }

constructor TWmiAsyncEvent.Create;
const
  strServer    =''.'';
  strNamespace =''root/CIMV2'';
  strUser      ='''';
  strPassword  ='''';
begin
  inherited Create;
  CoInitializeEx(nil, COINIT_MULTITHREADED);
  FLocator  := CoSWbemLocator.Create;
  FServices := FLocator.ConnectServer(strServer, strNamespace, strUser, strPassword, '''', '''', wbemConnectFlagUseMaxWait, nil);
  FSink     := TSWbemSink.Create(nil);
  FSink.OnObjectReady := EventReceived;
  FWQL:=''Select * From __InstanceCreationEvent Within 1 ''+
        ''Where TargetInstance ISA "Win32_PnPEntity" AND TargetInstance.ClassGuid="{4d36e978-e325-11ce-bfc1-08002be10318}" '';

end;

destructor TWmiAsyncEvent.Destroy;
begin
  if FSink<>nil then
    FSink.Cancel;
  FLocator  :=nil;
  FServices :=nil;
  FSink     :=nil;
  CoUninitialize;
  inherited;
end;

procedure TWmiAsyncEvent.EventReceived(ASender: TObject;
  const objWbemObject: ISWbemObject;
  const objWbemAsyncContext: ISWbemNamedValueSet);
var
  PropVal: OLEVariant;
begin
  PropVal := objWbemObject;
  Writeln(Format(''TargetInstance.ClassGuid      : %s '',[String(PropVal.TargetInstance.ClassGuid)]));
  Writeln(Format(''TargetInstance.Description    : %s '',[String(PropVal.TargetInstance.Description)]));
  Writeln(Format(''TargetInstance.Name           : %s '',[String(PropVal.TargetInstance.Name)]));
  Writeln(Format(''TargetInstance.PNPDeviceID    : %s '',[String(PropVal.TargetInstance.PNPDeviceID)]));
  Writeln(Format(''TargetInstance.Status         : %s '',[String(PropVal.TargetInstance.Status)]));
end;

procedure TWmiAsyncEvent.Start;
begin
  Writeln(''Listening events...Press Any key to exit'');
  FServices.ExecNotificationQueryAsync(FSink.DefaultInterface,FWQL,''WQL'', 0, nil, nil);
end;

var
   AsyncEvent : TWmiAsyncEvent;
begin
 try
    AsyncEvent:=TWmiAsyncEvent.Create;
    try
      AsyncEvent.Start;
      //The next loop is only necessary in this sample console sample app
      //In VCL forms Apps you don''t need use a loop
      while not KeyPressed do
      begin
          {$IF CompilerVersion > 18.5}
          Sleep(100);
          Application.ProcessMessages;
          {$IFEND}
      end;
    finally
      AsyncEvent.Free;
    end;
 except
    on E:EOleException do
        Writeln(Format(''EOleException %s %x'', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, '':'', E.Message);
 end;
end.

Answer 2

Puede utilizar la función WinAPI de RegisterDeviceNotification pasando la estructura DEV_BROADCAST_DEVICEINTERFACE con la clase de interfaz de dispositivo GUID_DEVINTERFACE_COMPORT .

Prueba esta muestra

type
  PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;
  DEV_BROADCAST_HDR = packed record
    dbch_size: DWORD;
    dbch_devicetype: DWORD;
    dbch_reserved: DWORD;
  end;
  TDevBroadcastHdr = DEV_BROADCAST_HDR;

type
  PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
  DEV_BROADCAST_DEVICEINTERFACE = record
    dbcc_size: DWORD;
    dbcc_devicetype: DWORD;
    dbcc_reserved: DWORD;
    dbcc_classguid: TGUID;
    dbcc_name: Char;
  end;
  TDevBroadcastDeviceInterface = DEV_BROADCAST_DEVICEINTERFACE;

const
  DBT_DEVICEARRIVAL          = $8000;
  DBT_DEVICEREMOVECOMPLETE   = $8004;
  DBT_DEVTYP_DEVICEINTERFACE = $00000005;

type
  TDeviceNotifyProc = procedure(Sender: TObject; const DeviceName: String) of Object;
  TDeviceNotifier = class
  private
    hRecipient: HWND;
    FNotificationHandle: Pointer;
    FDeviceArrival: TDeviceNotifyProc;
    FDeviceRemoval: TDeviceNotifyProc;
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(GUID_DEVINTERFACE : TGUID);
    property OnDeviceArrival: TDeviceNotifyProc read FDeviceArrival write FDeviceArrival;
    property OnDeviceRemoval: TDeviceNotifyProc read FDeviceRemoval write FDeviceRemoval;
    destructor Destroy; override;
  end;

type
  TForm17 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    DeviceNotifier : TDeviceNotifier;
  public
    { Public declarations }
    procedure arrival(Sender: TObject; const DeviceName: String);
  end;

var
  Form17: TForm17;

implementation

{$R *.dfm}

constructor TDeviceNotifier.Create(GUID_DEVINTERFACE : TGUID);
var
  NotificationFilter: TDevBroadcastDeviceInterface;
begin
  inherited Create;
  hRecipient := AllocateHWnd(WndProc);
  ZeroMemory(@NotificationFilter, SizeOf(NotificationFilter));
  NotificationFilter.dbcc_size := SizeOf(NotificationFilter);
  NotificationFilter.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  NotificationFilter.dbcc_classguid  := GUID_DEVINTERFACE;
  //register the device class to monitor
  FNotificationHandle := RegisterDeviceNotification(hRecipient, @NotificationFilter, DEVICE_NOTIFY_WINDOW_HANDLE);
end;

procedure TDeviceNotifier.WndProc(var Msg: TMessage);
var
  Dbi: PDevBroadcastDeviceInterface;
begin
  with Msg do
  if (Msg = WM_DEVICECHANGE) and ((WParam = DBT_DEVICEARRIVAL) or (WParam = DBT_DEVICEREMOVECOMPLETE)) then
  try
    Dbi := PDevBroadcastDeviceInterface(LParam);
    if Dbi.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE then
    begin
      if WParam = DBT_DEVICEARRIVAL then
      begin
        if Assigned(FDeviceArrival) then
          FDeviceArrival(Self, PChar(@Dbi.dbcc_name));
      end
      else
      if WParam = DBT_DEVICEREMOVECOMPLETE then
      begin
        if Assigned(FDeviceRemoval) then
          FDeviceRemoval(Self, PChar(@Dbi.dbcc_name));
      end;
    end;
  except
    Result := DefWindowProc(hRecipient, Msg, WParam, LParam);
  end
  else
    Result := DefWindowProc(hRecipient, Msg, WParam, LParam);
end;

destructor TDeviceNotifier.Destroy;
begin
  UnregisterDeviceNotification(FNotificationHandle);
  DeallocateHWnd(hRecipient);
  inherited;
end;



procedure TForm17.arrival(Sender: TObject; const DeviceName: String);
begin
  ShowMessage(DeviceName);
end;

procedure TForm17.FormCreate(Sender: TObject);
const
  GUID_DEVINTERFACE_COMPORT  : TGUID = ''{86E0D1E0-8089-11D0-9CE4-08003E301F73}'';
begin      
  DeviceNotifier:=TDeviceNotifier.Create(GUID_DEVINTERFACE_COMPORT);
  DeviceNotifier.FDeviceArrival:=arrival;
end;

procedure TForm17.FormDestroy(Sender: TObject);
begin
  DeviceNotifier.Free;
end;

end.