Detekcja podpięcia napędu USB (WM_DEVICECHANGE)

Hej,
Proszę o poradę co tutaj jest nie tak w tym kodzie.
Przykładowy programik ma za zadanie wykryć podpięcie jak i wysunięcie napędu (dysku, pendriva, etc) USB.
Wykorzystywany jest tutaj komunikat WM_DEVICECHANGE. Programik-demo napisałem przed chwilą, ale sam kod obsługi komunikatu NIE jest mój (kiedyś znalazłem go na necie)...
Używam kompilatora Delphi CE 11.3 (chociaż wątpię, by kompilator był problemem). ---> Edycja: A może jednak?

O co chodzi. Program działa prawidłowo w wersji 32-bitowej. Program NIE działa w wersji 64-bit.
Niestety, nie mam zielonego pojęcia co jest nie tak. Bardzo proszę o sprawdzenie - gdzie leży problem (ja nie mam pojęcia co debuger chce mi powiedzieć - to jest po chińsku! :P).
Dlaczego wersja 64-bitowa przykładowej aplikacji się wysypuje?

USB_DETECTOR.zip

W załączniku źródła.

Dziękuję za ewentualną pomoc.
-Pawel

EDYCJA
Z ciekawości skompilowałem ten kod w starszej wersji Delphi (10.4.2) i OBIE wersje (32bit i 64bit) działają prawidłowo! Jak to możliwe?
Czym może różnić się Delphi 11.3 od starszej wersji? Co muszę ewentualnie zmienić?

na 10.4 64bit działa
na 11.2 64bit nie działa

tak dawno nie używałem Delphi że debbuger sie na mnie obraził i nie działa w 11.2 wiec Ci nie podpowiem gdzie jest problem

ten kawałek kodu działa

unit Unit21;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm21 = class(TForm)
  private
     procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public
    { Public declarations }
  end;

var
  Form21: TForm21;

implementation

{$R *.dfm}

{ TForm21 }

procedure TForm21.WMDeviceChange(var Msg: TMessage);
const
  DBT_DeviceArrival = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBTF_Media = $0001;
  DBT_DevTyp_Volume = $0002;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

type
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  //if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  if (pDBVol^.dbcv_devicetype and DBT_DevTyp_Volume) = DBT_DevTyp_Volume then
  begin
    Maske := pDBVol^.dbcv_unitmask;
    for i := 0 to 25 do
    begin
      if (Maske and 1) = 1 then
        Result := Char(i + Ord('A')) + ':';
      Maske := Maske shr 1;
    end;
  end;
end;

var
  Drive: string;
  w: DWORD;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        if length(Drive)>0 then
        begin
          AllocConsole;
          Writeln(Drive);
        end;
      end;
    {DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
      end;}
  end;
end;


end.

Naprawdę do dziś w Delphi nie ma deklaracji stałych i typów struktur, aby ten komunikat obsłużyć?

@furious programming: nadal nie ma w 11.2 :D a pierwszy raz dodawałem w Delphi 5

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
Author:       François PIETTE @ www.overbyte.be
Creation:     March 17, 2013
Description:  Worker thread having a message pump, working mostly like
              the main thread. Intended to be the base class for your own
              worker threads: all methods are virtual.
Version:      1.00
History:
 
 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit MsgHandlingWorkerThread;
 
interface
 
uses
    Windows, Messages, Classes, SysUtils;
 
type
    TMsgHandlingWorkerThread = class(TThread)
    protected
        FHandle        : HWND;
        procedure AllocateHWnd; virtual;
        procedure DeallocateHWnd; virtual;
        procedure MessageLoop; virtual;
        function  GetHandle: HWND; virtual;
    public
        constructor Create(Suspended : Boolean); virtual;
        procedure Execute; override;
        procedure WndProc(var MsgRec: TMessage); virtual;
        property Handle : HWND read GetHandle;
    end;
 
 
implementation
 
var
    GWndHandleCount     : Integer;
    GWndHandlerCritSect : TRTLCriticalSection;
 
const
    WinThreadWindowClassName = 'WinThreadWindowClass';
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Forward declaration for our Windows callback function
function WndControlWindowsProc(
    ahWnd   : HWND;
    auMsg   : UINT;
    awParam : WPARAM;
    alParam : LPARAM): LRESULT; stdcall; forward;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMsgHandlingWorkerThread.AllocateHWnd;
var
    TempClass                : TWndClass;
    WinThreadWindowClass : TWndClass;
    ClassRegistered          : Boolean;
begin
    // Nothing to do if hidden window is already created
    if FHandle <> INVALID_HANDLE_VALUE then
        Exit;
 
    // We use a critical section to be sure only one thread can check if a
    // class is registered and register it if needed.
    // We must also be sure that the class is not unregistered by another
    // thread which just destroyed a previous window.
    EnterCriticalSection(GWndHandlerCritSect);
    try
        // Check if the window class is already registered
        WinThreadWindowClass.hInstance     := HInstance;
        WinThreadWindowClass.lpszClassName := WinThreadWindowClassName;
        ClassRegistered := GetClassInfo(HInstance,
                                        WinThreadWindowClass.lpszClassName,
                                        TempClass);
        if not ClassRegistered then begin
            // Not registered yet, do it right now !
            WinThreadWindowClass.style         := 0;
            WinThreadWindowClass.lpfnWndProc   := @WndControlWindowsProc;
            WinThreadWindowClass.cbClsExtra    := 0;
            WinThreadWindowClass.cbWndExtra    := SizeOf(Pointer);
            WinThreadWindowClass.hIcon         := 0;
            WinThreadWindowClass.hCursor       := 0;
            WinThreadWindowClass.hbrBackground := 0;
            WinThreadWindowClass.lpszMenuName  := nil;
 
           if Windows.RegisterClass(WinThreadWindowClass) = 0 then
                raise Exception.Create(
                     'Unable to register hidden window class.' +
                     ' Error #' + IntToStr(GetLastError) + '.');
        end;
 
        // Now we are sure the class is registered, we can create a window using it
        FHandle := CreateWindowEx(WS_EX_TOOLWINDOW,
                                  WinThreadWindowClass.lpszClassName,
                                  '',        // Window name
                                  WS_POPUP,  // Window Style
                                  0, 0,      // X, Y
                                  0, 0,      // Width, Height
                                  0,         // hWndParent
                                  0,         // hMenu
                                  HInstance, // hInstance
                                  nil);      // CreateParam
 
        if FHandle = 0 then
            raise Exception.Create(
                'Unable to create hidden window. ' +
                ' Error #' + IntToStr(GetLastError) + '.');
 
        // We have a window. In the associated data, we record a reference
        // to our object. This will later allow to call the WndProc method to
        // handle messages sent to the window.
    {$IFDEF WIN64}
        SetWindowLongPtr(FHandle, 0, INT_PTR(Self));
    {$ELSE}
        SetWindowLong(FHandle, 0, Longint(Self));
    {$ENDIF}
        Inc(GWndHandleCount);
    finally
        LeaveCriticalSection(GWndHandlerCritSect);
    end;
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TMsgHandlingWorkerThread.Create(Suspended: Boolean);
begin
    FHandle := INVALID_HANDLE_VALUE;
    inherited Create(Suspended);
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMsgHandlingWorkerThread.DeallocateHWnd;
begin
    // No handle, nothing to do
    if FHandle = INVALID_HANDLE_VALUE then
        Exit;
 
{$IFDEF WIN64}
    SetWindowLongPtr(FHandle, 0, 0); // Delete object reference
{$ELSE}
    SetWindowLong(FHandle, 0, 0);    // Delete object reference
{$ENDIF}
    DestroyWindow(FHandle);          // Destroy hidden window
    FHandle := INVALID_HANDLE_VALUE; // No more handle
 
    EnterCriticalSection(GWndHandlerCritSect);
    try
        Dec(GWndHandleCount);
        if GWndHandleCount <= 0 then
            // Unregister the window class use by the component.
            // This is necessary to do so from a DLL when the DLL is unloaded
            // (that is when DllEntryPoint is called with dwReason equal to
            // DLL_PROCESS_DETACH.
            Windows.UnregisterClass(WinThreadWindowClassName, HInstance);
    finally
        LeaveCriticalSection(GWndHandlerCritSect);
    end;
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMsgHandlingWorkerThread.Execute;
begin
    NameThreadForDebugging(ansistring( ClassName ));
    AllocateHWnd;
    try
        MessageLoop;
    finally
        DeallocateHWnd
    end;
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TMsgHandlingWorkerThread.GetHandle: HWND;
begin
    EnterCriticalSection(GWndHandlerCritSect);
    try
        Result := FHandle;
    finally
        LeaveCriticalSection(GWndHandlerCritSect);
    end;
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Loop thru message processing until the WM_QUIT message is received
// The loop is broken when WM_QUIT is retrieved.
procedure TMsgHandlingWorkerThread.MessageLoop;
var
    MsgRec : TMsg;
begin
    // If GetMessage retrieves the WM_QUIT, the return value is FALSE and
    // the message loop is broken.
    while GetMessage(MsgRec, 0, 0, 0) do begin
        TranslateMessage(MsgRec);
        DispatchMessage(MsgRec)
    end;
    Terminate;
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMsgHandlingWorkerThread.WndProc(var MsgRec: TMessage);
begin
    MsgRec.Result := DefWindowProc(Handle, MsgRec.Msg,
                                   MsgRec.wParam, MsgRec.lParam);
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// WndControlWindowsProc is a callback function used for message handling
function WndControlWindowsProc(
    ahWnd   : HWND;
    auMsg   : UINT;
    awParam : WPARAM;
    alParam : LPARAM): LRESULT; {$IFNDEF CLR} stdcall; {$ENDIF}
var
    Obj    : TObject;
    MsgRec : TMessage;
begin
    // When the window is created, we receive the following messages:
    // #129 WM_NCCREATE
    // #131 WM_NCCALCSIZE
    // #1   WM_CREATE
    // #5   WM_SIZE
    // #3   WM_MOVE
    // Later we receive:
    // #28  WM_ACTIVATEAPP
    // When the window is destroyed we receive
    // #2   WM_DESTROY
    // #130 WM_NCDESTROY
 
    // When the window was created, we stored a reference to the object
    // into the storage space we asked windows to have
{$IFDEF WIN64}
    Obj := TObject(GetWindowLongPtr(ahWnd, 0));
{$ELSE}
    Obj := TObject(GetWindowLong(ahWnd, 0));
{$ENDIF}
    // Check if the reference is actually our object type
    if not (Obj is TMsgHandlingWorkerThread) then
        Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
    else begin
        // Internally, Delphi use TMessage to pass parameters to his
        // message handlers.
        MsgRec.Msg    := auMsg;
        MsgRec.wParam := awParam;
        MsgRec.lParam := alParam;
        TMsgHandlingWorkerThread(Obj).WndProc(MsgRec);
        Result := MsgRec.Result;
    end;
end;
 
 
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
 
initialization
    InitializeCriticalSection(GWndHandlerCritSect);
 
finalization
    DeleteCriticalSection(GWndHandlerCritSect);
 
end.

  TMyWorkerThread = class(TMsgHandlingWorkerThread)
  public
    procedure WndProc(var Msg: TMessage); override;
  end;

 var
    WThread : TMyWorkerThread;

   WThread := TMyWorkerThread.Create(TRUE);
   WThread.Start;
  
procedure TMyWorkerThread.WndProc(var Msg: TMessage);
const
  DBT_DeviceArrival = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBTF_Media = $0001;
  DBT_DevTyp_Volume = $0002;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

type
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  //if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  if (pDBVol^.dbcv_devicetype and DBT_DevTyp_Volume) = DBT_DevTyp_Volume then
  begin
    Maske := pDBVol^.dbcv_unitmask;
    for i := 0 to 25 do
    begin
      if (Maske and 1) = 1 then
        Result := Char(i + Ord('A')) + ':';
      Maske := Maske shr 1;
    end;
  end;
end;

var
  Drive: string;
  w: DWORD;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        if length(Drive)>0 then
        begin
          AllocConsole;
          Writeln(Drive);
        end;
      end;
    {DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
      end;}
  end;
end;  

Po ludzku napisane https://github.com/mrDIMAS/AutomatedLIBS/blob/master/3rdparty/AvaSpecDLL-setup32/MAINDIR/examples/Borland%20Delphi%206/U_Usb.pas Mimo, że kod starszy od węgla myślę, że powinien działać zarówno na 32 jak i 64 bit a to dzięki użyciu wbudowanych funkcji AllocateHWnd i DeallocateHWnd, które raczej są poprawnie napisane pod obie platformy natomiast ten subclasing i w drugim kodzie ich implementacja niekoniecznie. Wystarczy przeczytać https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowlongptra i widać niepotrzebną zabawę z dyrektywami i w ogóle nie wiadomo po co na nowo wynajdować koło.

@Marius.Maximus: Rozumiem, że podany przykładowy kod jest rozwiązaniem obsługi komunikatów. Jak rozumiem tworzy ukryte okno, które łapie komunikat (dzięki czemu nie musi to być główne okno aplikacji) i go odpowiednio przetwarza. To rozwiązanie uniwersalne. W tym "moim" przykładowym kodzie jestem pewien problemem był typ danych funkcji SetWindowLong() (albo w ogóle jej nieprawidłowe użycie). W kodzie François mamy inne deklaracje w zależności od architektury...

{$IFDEF WIN64}
    SetWindowLongPtr(FHandle, 0, INT_PTR(Self));
{$ELSE}
    SetWindowLong(FHandle, 0, Longint(Self));
{$ENDIF}

@kAzek: Tak, ten przykład jest schludny i powinien robić co trzeba. Skorzystam z fragmentów kodu z drugiego postu (jest prosty i działa). De facto, ja nie potrzebuję super zaawansowanego rozwiązania. Na moje potrzeby wystarczy detekcja zdarzenia i litera napędu, nic więcej.
@furious programming: Wciąż testuję najnowsze wydanie Delphi CE... szukam problemów i ograniczeń - bardzo mnie boli brak wsparcia dla kompilacji z linii poleceń i licencja na rok (wciąż jesteśmy na łasce/nie łasce korporacji).

Panowie, dziękuję za zainteresowanie tematem. Browar dla Was! :)

Pepe napisał(a):

Hej,
Proszę o poradę co tutaj jest nie tak w tym kodzie.
Przykładowy programik ma za zadanie wykryć podpięcie jak i wysunięcie napędu (dysku, pendriva, etc) USB.
Wykorzystywany jest tutaj komunikat WM_DEVICECHANGE. Programik-demo napisałem przed chwilą, ale sam kod obsługi komunikatu NIE jest mój (kiedyś znalazłem go na necie)...
Używam kompilatora Delphi CE 11.3 (chociaż wątpię, by kompilator był problemem). ---> Edycja: A może jednak?

O co chodzi. Program działa prawidłowo w wersji 32-bitowej. Program NIE działa w wersji 64-bit.
Niestety, nie mam zielonego pojęcia co jest nie tak. Bardzo proszę o sprawdzenie - gdzie leży problem (ja nie mam pojęcia co debuger chce mi powiedzieć - to jest po chińsku! :P).
Dlaczego wersja 64-bitowa przykładowej aplikacji się wysypuje?

USB_DETECTOR.zip

W załączniku źródła.

Dziękuję za ewentualną pomoc.
-Pawel

EDYCJA
Z ciekawości skompilowałem ten kod w starszej wersji Delphi (10.4.2) i OBIE wersje (32bit i 64bit) działają prawidłowo! Jak to możliwe?
Czym może różnić się Delphi 11.3 od starszej wersji? Co muszę ewentualnie zmienić?

Jak wygląda stacktrace?