CODEWITHSUNDEEP
delphiusb
Xor-el
Xor-el

Reputation: 242

Adding USB Detection to a Formless { dpr } only Delphi Application

is it possible to add usb detection to a formless (dpr only) Delphi Program? I have written the detection class but it seems to work only when I add a form to the program.

Here is the class

unit uMyUSB;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Winapi.ShellApi, Vcl.Dialogs;

// Start of Declarations

const
  DBT_DEVICEARRIVAL = $00008000;
  DBT_DEVICEREMOVECOMPLETE = $00008004;
  DBT_DEVTYP_VOLUME = $00000002;
  DBTF_MEDIA = $00000001;
  USB_INTERFACE = $00000005;

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

and Here is the TestUnit

// 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.

How can I make a formless program accept USB change (WM_DEVICECHANGE) commands?

Thanks a Lot.

Delphi XE7.

Upvotes: 1

Views: 576

Answers (1)

David Heffernan
David Heffernan

Reputation: 613461

Although the messages are synchronous, that is non-queued, you do need to dispatch messages in order for synchronous messages to be delivered. Typically message dispatch is done by the message loop, when you call GetMessage or similar function.

Your application does not have a message loop and does not dispatch messages. You just need to arrange that your program dispatches messages. Adding a message loop would do it. But you just need to do something that dispatches messages. Doesn't need to be a full blown message loop. For instance you could replace your loop with:

while True do
  SendMessage(hwnd, WM_NULL, 0, 0);

This does what you need because SendMessage is one of the functions that dispatch messages.

You need to decide which window handle to use. You could use the window handle that you created. Or you could probably send the messages to the invalid window handle with value 0.

Or you could just decide to run a standard message loop:

while GetMessage(Msg, 0, 0, 0) do
begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
end;

Upvotes: 3

Related Questions