将 USB 检测添加到 Formless { dpr } only Delphi 应用程序
Adding USB Detection to a Formless { dpr } only Delphi Application
是否可以将 usb 检测添加到无形式(仅限 dpr)Delphi 程序中?
我写了检测 class 但它似乎只有在我向程序添加表单时才有效。
这是class
unit uMyUSB;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Winapi.ShellApi, Vcl.Dialogs;
// Start of Declarations
const
DBT_DEVICEARRIVAL = [=11=]008000;
DBT_DEVICEREMOVECOMPLETE = [=11=]008004;
DBT_DEVTYP_VOLUME = [=11=]000002;
DBTF_MEDIA = [=11=]000001;
USB_INTERFACE = [=11=]000005;
// Device structs
type
PDevBroadcastDeviceInterface = ^_DEV_BROADCAST_HDR;
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;
type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;
// End of Declarations
type
TUSB = class(TObject)
private
FHandle: HWND;
procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
procedure WinMethod(var Msg: TMessage);
procedure RegisterUsbHandler;
{ Public declarations }
public
{ Public declarations }
constructor Create();
destructor Destroy(); override;
end;
implementation
constructor TUSB.Create();
begin
inherited Create;
FHandle := AllocateHWnd(WinMethod);
RegisterUsbHandler;
end;
destructor TUSB.Destroy();
begin
DeallocateHWnd(FHandle);
inherited Destroy;
end;
procedure TUSB.WinMethod(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
WMDeviceChange(Msg);
end
else
begin
Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;
end;
procedure TUSB.RegisterUsbHandler;
var
rDbi: _DEV_BROADCAST_HDR;
iSize: Integer;
begin
iSize := SizeOf(_DEV_BROADCAST_HDR);
ZeroMemory(@rDbi, iSize);
rDbi.dbch_size := iSize;
rDbi.dbch_devicetype := USB_INTERFACE;
rDbi.dbch_reserved := 0;
RegisterDeviceNotification(FHandle, @rDbi, DEVICE_NOTIFY_WINDOW_HANDLE);
end;
procedure TUSB.WMDeviceChange(var Msg: TMessage);
var
lpdbhHeader: PDevBroadcastHeader;
begin
lpdbhHeader := PDevBroadcastHeader(Msg.LParam);
case Msg.WParam of
DBT_DEVICEARRIVAL:
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
ShowMessage('Inserted');
end;
end;
DBT_DEVICEREMOVECOMPLETE:
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
ShowMessage('Removed');
end;
end;
end;
end;
这是测试单元
// My dpr Program
program TestUSB;
uses
System.SysUtils,
System.Classes,
uMyUSB in 'Sources\uMyUSB.pas';
{$R *.res}
var
FUSB: TUSB;
begin
{$WARNINGS OFF}
ReportMemoryLeaksOnShutdown := DebugHook <> 0;
{$WARNINGS ON}
FUSB := TUSB.Create();
// Loop to keep the Program Running Continually.
while 1 = 1 do
begin
// Do Something
end;
FreeandNil(CustomUsb);
end.
如何让无格式程序接受 USB 更改 (WM_DEVICECHANGE) 命令?
非常感谢。
Delphi XE7.
虽然消息是同步的,即不排队,但您确实需要分派消息才能传送同步消息。当您调用 GetMessage
或类似函数时,消息分发通常由消息循环完成。
您的应用程序没有消息循环并且不发送消息。您只需要安排您的程序发送消息。添加一个消息循环就可以了。但是你只需要做一些发送消息的事情。不需要是一个完整的消息循环。例如,您可以将循环替换为:
while True do
SendMessage(hwnd, WM_NULL, 0, 0);
这就是您所需要的,因为 SendMessage
是发送消息的函数之一。
您需要决定使用哪个 window 句柄。您可以使用您创建的 window 句柄。或者您可以将消息发送到无效的 window 句柄,值为 0
。
或者您可以决定 运行 标准消息循环:
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
是否可以将 usb 检测添加到无形式(仅限 dpr)Delphi 程序中? 我写了检测 class 但它似乎只有在我向程序添加表单时才有效。
这是class
unit uMyUSB;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Winapi.ShellApi, Vcl.Dialogs;
// Start of Declarations
const
DBT_DEVICEARRIVAL = [=11=]008000;
DBT_DEVICEREMOVECOMPLETE = [=11=]008004;
DBT_DEVTYP_VOLUME = [=11=]000002;
DBTF_MEDIA = [=11=]000001;
USB_INTERFACE = [=11=]000005;
// Device structs
type
PDevBroadcastDeviceInterface = ^_DEV_BROADCAST_HDR;
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;
type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;
// End of Declarations
type
TUSB = class(TObject)
private
FHandle: HWND;
procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
procedure WinMethod(var Msg: TMessage);
procedure RegisterUsbHandler;
{ Public declarations }
public
{ Public declarations }
constructor Create();
destructor Destroy(); override;
end;
implementation
constructor TUSB.Create();
begin
inherited Create;
FHandle := AllocateHWnd(WinMethod);
RegisterUsbHandler;
end;
destructor TUSB.Destroy();
begin
DeallocateHWnd(FHandle);
inherited Destroy;
end;
procedure TUSB.WinMethod(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
WMDeviceChange(Msg);
end
else
begin
Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;
end;
procedure TUSB.RegisterUsbHandler;
var
rDbi: _DEV_BROADCAST_HDR;
iSize: Integer;
begin
iSize := SizeOf(_DEV_BROADCAST_HDR);
ZeroMemory(@rDbi, iSize);
rDbi.dbch_size := iSize;
rDbi.dbch_devicetype := USB_INTERFACE;
rDbi.dbch_reserved := 0;
RegisterDeviceNotification(FHandle, @rDbi, DEVICE_NOTIFY_WINDOW_HANDLE);
end;
procedure TUSB.WMDeviceChange(var Msg: TMessage);
var
lpdbhHeader: PDevBroadcastHeader;
begin
lpdbhHeader := PDevBroadcastHeader(Msg.LParam);
case Msg.WParam of
DBT_DEVICEARRIVAL:
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
ShowMessage('Inserted');
end;
end;
DBT_DEVICEREMOVECOMPLETE:
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
ShowMessage('Removed');
end;
end;
end;
end;
这是测试单元
// My dpr Program
program TestUSB;
uses
System.SysUtils,
System.Classes,
uMyUSB in 'Sources\uMyUSB.pas';
{$R *.res}
var
FUSB: TUSB;
begin
{$WARNINGS OFF}
ReportMemoryLeaksOnShutdown := DebugHook <> 0;
{$WARNINGS ON}
FUSB := TUSB.Create();
// Loop to keep the Program Running Continually.
while 1 = 1 do
begin
// Do Something
end;
FreeandNil(CustomUsb);
end.
如何让无格式程序接受 USB 更改 (WM_DEVICECHANGE) 命令?
非常感谢。
Delphi XE7.
虽然消息是同步的,即不排队,但您确实需要分派消息才能传送同步消息。当您调用 GetMessage
或类似函数时,消息分发通常由消息循环完成。
您的应用程序没有消息循环并且不发送消息。您只需要安排您的程序发送消息。添加一个消息循环就可以了。但是你只需要做一些发送消息的事情。不需要是一个完整的消息循环。例如,您可以将循环替换为:
while True do
SendMessage(hwnd, WM_NULL, 0, 0);
这就是您所需要的,因为 SendMessage
是发送消息的函数之一。
您需要决定使用哪个 window 句柄。您可以使用您创建的 window 句柄。或者您可以将消息发送到无效的 window 句柄,值为 0
。
或者您可以决定 运行 标准消息循环:
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;