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.