要与微控制器通信，我使用串口。我使用TCommPortDriver 2.1工作正常。但是，它缺乏检测新组合的添加或删除的能力。这会在会话期间定期发生。
是否有事件告知何时添加或删除了一个comport？
更新1
我尝试了RRUZ的第一个建议，并把它变成了一个独立的程序。当电缆插入或拔出时，它会在WM_DEVICECHANGE上作出反应，但WParam不会显示设备的到达或移除。结果是：
msg = 537, wparam = 7, lparam = 0
msg = 537, wparam = 7, lparam = 0
msg = 537, wparam = 7, lparam = 0
插入USB电缆时会发送第一条消息，插入USB电缆时会发送下一条消息。
消息部分显示WM_DEVICECHANGE消息（537），但WParam为7，不是WM_DEVICECHANGE或DBT_DEVICEARRIVAL。我稍微修改了代码以便处理消息，但是当LParam为零时，这是没用的。结果与VCL和FMX相同。请查看下面的代码。
更新2
我现在运行了WMI代码。它仅在添加COM端口时触发，在移除COM端口时无反应。结果：
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
这可能解释了在其他代码中这不被视为添加COM端口的事实吗？它似乎将新连接视为USB端口（它实际上是什么）。 Arduino驱动程序将其转换为COM端口，但WMI无法识别。 Windows消息“看到”COM端口更改但无法检测是否已添加或删除。
无论如何：设备更改有效。我只需要枚举COM端口，看看哪个实际存在，这是我已经手动完成的。现在我可以使用WM_DEVICECHANGE自动执行此操作。我只是向CPDrv组件添加一个事件。
感谢RRUZ提供您的代码和帮助！
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.
答案 0 :(得分：10)
您可以使用RegisterDeviceNotification WinAPI函数将DEV_BROADCAST_DEVICEINTERFACE结构与GUID_DEVINTERFACE_COMPORT设备接口类一起传递。
试试这个样本。
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.
答案 1 :(得分：6)
另一种选择是使用WMI事件，在这种情况下使用__InstanceCreationEvent事件和Win32_PnPEntity WMI类，您可以使用{4d36e978-e325-11ce-bfc1-08002be10318}类GUID过滤添加的串行端口，写入像这样的WQL句子
Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA "Win32_PnPEntity" AND TargetInstance.ClassGuid="{4d36e978-e325-11ce-bfc1-08002be10318}"
试试这个样本
{$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.