Improve code for detecting USB drive insertion & removal

Dear Experts,
Please refer to the included code which detects when a USB device is connected or disconnected.
It worked perfectly for me. As you can see it handles the Windows message WM_DEVICECHANGE.
However as it stands its not that flexible for easily adding to a project..

It would be nice to have this in a self-contained unit that generates suitable events when a USB device is attached or removed. I would prefer that it not be made into a component that I have to install, in order  to produce more portable code.

I don't know if its possible to handle a message without a form, but maybe it could be a small non-visible dummy form.

If it seems possible I would appreciate a working Delphi 5 compatible version.
Many thanks!

unit USBDetectF;
{taken from an Experts Exchange solution:
 http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/
                             Q_21552015.html?sfQueryTermInfo=1+drive+letter+usb
 ginsonic:
 Here is a complete sample project. Use a form and a label.
}
 
interface
 
uses
  Windows, Messages, Classes, Forms, Controls, StdCtrls, Buttons;
 
type
  TUSBDetectForm = class(TForm)
    Label1: TLabel;
    BitBtn1: TBitBtn;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure   WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;
  public
    { Public declarations }
  end;
 
var
  USBDetectForm: TUSBDetectForm;
 
{----------------------------------------------------------------------------}
// Device constants
const
  DBT_DEVICEARRIVAL          =  $00008000;
  DBT_DEVICEREMOVECOMPLETE   =  $00008004;
  DBT_DEVTYP_VOLUME          =  $00000002;
 
// Device structs
type
  _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;
 
implementation
{$R *.dfm}
 
procedure TUSBDetectForm.WMDEVICECHANGE(var Msg: TMessage);
var  lpdbhHeader:   PDevBroadcastHeader;
     lpdbvData:     PDevBroadcastVolume;
     dwIndex:       Integer;
     lpszDrive:      String;
begin
 
  // Perform inherited
  inherited;
 
  // Get the device notification header
  lpdbhHeader:=PDevBroadcastHeader(Msg.lParam);
 
  // Handle the message
  lpszDrive:='Drive ';
  case Msg.WParam of
     DBT_DEVICEARRIVAL       :    {a USB drive was connected}
     begin
        if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
        begin
           lpdbvData:=PDevBroadcastVolume(Msg.lParam);
           for dwIndex :=0 to 25 do
           begin
              if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
              begin
                 lpszDrive:=lpszDrive+Chr(65+dwIndex)+':';
                 break;
              end;
           end;
           Label1.Caption:=lpszDrive + ' connected';
        end;
     end;
     DBT_DEVICEREMOVECOMPLETE:    {a USB drive was removed}
     begin
        if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
        begin
           lpdbvData:=PDevBroadcastVolume(Msg.lParam);
           for dwIndex:=0 to 25 do
           begin
              if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
              begin
                 lpszDrive:=lpszDrive+Chr(65+dwIndex)+':';
                 break;
              end;
           end;
           Label1.Caption:=lpszDrive + ' removed';
        end;
     end;
  end;
end;
 
procedure TUSBDetectForm.FormCreate(Sender: TObject);
begin
  Label1.Caption := '';
end;
 
end.

Open in new window

WinRatAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

 
Geert GOracle dbaCommented:
i'm assuming any other object would do, provided we have a mechanism for capturing the windows messages

use below snippet like :

uses UsbDetector, StrUtils;

procedure TForm1.Usb(Sender: TObject; Drive: string; Attached: boolean);
begin
  ShowMessage(Drive + IfThen(Attached, 'connected', 'disconnected'));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  StartUsbDetector(Usb);
end;
unit UsbDetector;
 
interface
 
uses Classes;
 
type
  TUsbDriveChanged = procedure (Sender: TObject; Drive: string; Attached: boolean) of object;
 
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
procedure StopUsbDetector;
 
implementation
 
uses Windows, Messages, Forms, SysUtils;
 
type
  TUSBDetector = class(TObject)
  private
    fUsbDriveChanged: TUsbDriveChanged;
  protected
    procedure DeviceChanged(Msg: UINT; wParam, lParam: Longint);
    procedure DoUsbDriveChanged(Drive: string; Attached: Boolean); dynamic;
  public
    constructor Create(NotifyProc: TUsbDriveChanged);
    destructor Destroy; override;
    property OnUsbDriveChanged: TUsbDriveChanged read fUsbDriveChanged;
  end;
 
var mUSBDetector: TUSBDetector;
 
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
begin
  if not Assigned(mUsbDetector) then
    mUsbDetector := TUsbDetector.Create(NotifyProc);
end;
 
procedure StopUsbDetector;
begin
  FreeAndNil(mUsbDetector);
  mUsbDetector := nil;
end;
 
{----------------------------------------------------------------------------}
// Device constants
const
  DBT_DEVICEARRIVAL          =  $00008000;
  DBT_DEVICEREMOVECOMPLETE   =  $00008004;
  DBT_DEVTYP_VOLUME          =  $00000002;
 
// Device structs
type
  _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;
 
var
  fPrevWndProc: TFNWndProc = nil;
 
function UsbWndProc(hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := CallWindowProc(fPrevWndProc, hWnd, Msg, wParam, lParam);
  if (Msg = WM_DEVICECHANGE) and (mUsbDetector <> nil) then
    mUsbDetector.DeviceChanged(Msg, wParam, lParam);
end;
 
constructor TUSBDetector.Create(NotifyProc: TUsbDriveChanged);
begin
  inherited Create;
  fUsbDriveChanged := NotifyProc;
  fPrevWndProc := TFNWndProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@UsbWndProc));
end;
 
destructor TUSBDetector.Destroy;
begin
  //SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@fPrevWndProc));
  inherited Destroy;
end;
 
procedure TUSBDetector.DeviceChanged(Msg: UINT; wParam, lParam: LongInt);
var
  lpdbhHeader: PDevBroadcastHeader;
  lpdbvData: PDevBroadcastVolume;
  dwIndex: Integer;
  lpszDrive: string;
begin
  // Get the device notification header
  lpdbhHeader := PDevBroadcastHeader(lParam);
  // Handle the message
  lpszDrive := 'Drive ';
  case WParam of
    DBT_DEVICEARRIVAL:    {a USB drive was connected}
    begin
      if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      begin
        lpdbvData := PDevBroadcastVolume(lParam);
        for dwIndex := 0 to 25 do
        begin
          if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
          begin
            lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
            break;
          end;
        end;
        DoUsbDriveChanged(lpszDrive, True);
      end;
    end;
    DBT_DEVICEREMOVECOMPLETE:    {a USB drive was removed}
    begin
      if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      begin
        lpdbvData := PDevBroadcastVolume(lParam);
        for dwIndex := 0 to 25 do
        begin
          if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
          begin
            lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
            break;
          end;
        end;
        DoUsbDriveChanged(lpszDrive, False);
      end;
    end;
  end;
end;
 
procedure TUSBDetector.DoUsbDriveChanged(Drive: string; Attached: Boolean);
begin
  if Assigned(fUsbDriveChanged) then
    fUsbDriveChanged(Self, Drive, Attached);
end;
 
end.

Open in new window

0
 
Geert GOracle dbaCommented:
stopping the UsbDetector gave an error, dunno why it doesn't want to put the old WndProc back
Closing the application gave AV priviliged instruction

with below code changes it should be solved
constructor TUSBDetector.Create(NotifyProc: TUsbDriveChanged);
begin
  inherited Create;
  fUsbDriveChanged := NotifyProc;
  if not Assigned(fPrevWndProc) then 
  begin
    fPrevWndProc := TFNWndProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@UsbWndProc));
  end;
end;
 
 
procedure StopUsbDetector;
begin
  FreeAndNil(mUsbDetector);
end;

Open in new window

0

Experts Exchange Solution brought to you by ConnectWise

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
 
WinRatAuthor Commented:
Hi!
Thanks for a great solution that does *exactly* what I wanted! So nice to get a solution where you can just copy and paste it into Delphi without having to add missing identifiers or debug it first! I just made a minor change to suit my preferences (to the returned Drive string)

Some of your code is outside my Delphi level so it will be great to go through it and learn some new techniques.
Mike
0
 
Geert GOracle dbaCommented:
a bit of basic component creation with a window message loop

glad to be of service
if you need more help, just let me know
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.