将 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;