Erkennen, ob USB-Stick oder SD-Card eingesteckt oder herausgenommen?

[AlexII]

Hallo,

habe folgenden Code halb gefunden, halb ergänzt um zu erkennen wann ein USB-Stick oder SD-Card ein- oder herausgekommen werden. Das ganze ist etwas anders geschrieben, als viele Beispiele hier zu diesem Thema, da die LCL von Lazarus nicht alle Messages vom OS an die Anwendung weiterleitet. Nun möchte ich fragen, ob sich das ganze jemand anschauen kann, um eventuelle Fehler zu beseitigen oder das ganze irgendwie einfacher zu schreiben.

Vielen, vielen Dank!

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;


const
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  DBT_DEVICEARRIVAL          = $8000;          // system detected a new device
  DBT_DEVICEREMOVECOMPLETE   = $8004;          // device is gone
  DBT_DEVTYP_DEVICEINTERFACE = $00000005;      // device interface class
  DBT_DEVTYP_VOLUME          = $00000002;


var
  Form1: TForm1;

implementation

uses JwaWinUser, JwaDbt;

{$R *.lfm}

type
  TMWndProc = Windows.WNDPROC;

var
   OldWndProc: TMWndProc;

function MyWndProc(my_wnd : HWND; Msg : UINT; my_wparam : WPARAM; my_lparam : LPARAM): LRESULT; stdcall;
var
  devType : Integer;
  Datos : PDevBroadcastHdr;
begin
  Result := 0;
  case Msg of
    WM_DEVICECHANGE:
    begin
      if (my_wparam = DBT_DEVICEARRIVAL) or (my_wparam = DBT_DEVICEREMOVECOMPLETE) then
      begin
        Datos := PDevBroadcastHdr(Pointer(my_lparam));
        devType := Datos^.dbch_devicetype;

        if devType = DBT_DEVTYP_VOLUME then
        begin
           if my_wparam = DBT_DEVICEARRIVAL then
             ShowMessage('USB-Gerät eingesteckt!')
           else
             ShowMessage('USB-Gerät herausgenommen!');
        end;
      end;

      // Return TRUE to grant the request
      // Return BROADCAST_QUERY_DENY to deny the request.

      // Weiß nicht genau was ich hier zurück geben soll

    end; // WM_DEVICECHANGE
  end; // case

  Result := Windows.CallWindowProc(OldWndProc, my_wnd, Msg, my_wparam, my_lparam);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  dbi: DEV_BROADCAST_DEVICEINTERFACE_W;
  dbv: DEV_BROADCAST_VOLUME;
  Size: Integer;
  RDN: HDEVNOTIFY;
  arr : array[0 .. 0] of word;
begin
  arr[0] := 0;
  Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE_W);
  ZeroMemory(@dbi, Size);
  dbi.dbcc_size := Size;
  dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  dbi.dbcc_reserved := 0;
  dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;
  dbi.dbcc_name := arr;
  RDN := RegisterDeviceNotificationW(Form1.Handle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
  if not Assigned(RDN) then
    ShowMessage('Error Register Message');

  Size := SizeOf(DEV_BROADCAST_VOLUME);
  ZeroMemory(@dbv, Size);
  dbv.dbcv_size := Size;
  dbv.dbcv_devicetype := DBT_DEVTYP_VOLUME;
  dbv.dbcv_reserved := 0;
  dbv.dbcv_flags := 0;
  RDN := RegisterDeviceNotification(Form1.Handle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
  if not Assigned(RDN) then
    ShowMessage('Error Register Message');

  OldWndProc := TMWndProc(Windows.GetWindowLong(Self.Handle, GWL_WNDPROC));
  Windows.SetWindowLong(Self.Handle, GWL_WNDPROC, LongInt(@MyWndProc));
end;


end.

[Dalai]

• Form1.Handle -> ganz schlechte Idee. Besser ist Self.Handle.
• Was sollen die ShowMessages im Fehlerfall? Warum nicht das machen, was eigentlich jeder macht, und auch von MS empfohlen wird: GetLastError? Oder noch besser:
  Delphi-Quellcode:

  ShowMessage(SysErrorMessage(GetLastError));

  bzw. eine Exception raisen.
• Copy'n'Paste ist ne dumme Sau, schau dir mal die Parameter in den Aufrufen von RegisterDeviceNotification ganz genau an.

Das nur mal beim schnellen Drüberschauen aufgefallen.

MfG Dalai

[AlexII]

Danke Dir, so sieht's nun aus:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
var
  dbi: DEV_BROADCAST_DEVICEINTERFACE_W;
  dbv: DEV_BROADCAST_VOLUME;
  Size: Integer;
  RDN: HDEVNOTIFY;
  arr : array[0 .. 0] of word;
begin
  arr[0] := 0;
  Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE_W);
  ZeroMemory(@dbi, Size);
  dbi.dbcc_size := Size;
  dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  dbi.dbcc_reserved := 0;
  dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;
  dbi.dbcc_name := arr;
  RDN := RegisterDeviceNotificationW(Self.Handle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
  if not Assigned(RDN) then
    ShowMessage('1: ' + SysErrorMessage(GetLastError));

  Size := SizeOf(DEV_BROADCAST_VOLUME);
  ZeroMemory(@dbv, Size);
  dbv.dbcv_size := Size;
  dbv.dbcv_devicetype := DBT_DEVTYP_VOLUME;
  dbv.dbcv_reserved := 0;
  dbv.dbcv_flags := 0;
  RDN := RegisterDeviceNotification(Self.Handle, @dbv, DEVICE_NOTIFY_WINDOW_HANDLE);
  if not Assigned(RDN) then
    ShowMessage('2: ' + SysErrorMessage(GetLastError));

  OldWndProc := TMWndProc(Windows.GetWindowLong(Self.Handle, GWL_WNDPROC));
  Windows.SetWindowLong(Self.Handle, GWL_WNDPROC, LongInt(@MyWndProc));
end;

Die Zeile

Zitat:

ShowMessage('2: ' + SysErrorMessage(GetLastError));

gibt nun folgendes aus:

Zitat:

Der Dienst hat einen dienstspezifischen Fehlercode zurückgegeben

Was heiß das eigentlich? Also ein Fehler ist es nicht, oder?

[Luckie]

Man könnte jetzt über die Bedeutung des Wortes Fehlercode philosophieren. :roll:

[AlexII]

Zitat:

Zitat von Luckie (Beitrag 1307321)

Man könnte jetzt über die Bedeutung des Wortes Fehlercode philosophieren. :roll:

Aber was kann das heißen, was mache ich falsch?

[Dalai]

Nur eine Vermutung: Vielleicht musst du

Code:

dbcv_unitmask

The logical unit mask identifying one or more logical units. Each bit in the mask corresponds to one logical drive. Bit 0 represents drive A, bit 1 represents drive B, and so on.

noch setzen?

Übrigens: bei reserved-Parametern sollte man aufpassen und diese besser gar nicht anfassen. Auch wenn sich durch deine Zuweisung wahrscheinlich nichts ändert, würde ich sie komplett weglassen.

Bist du sicher, dass Lazarus keine WM_DEVICECHANGE Nachrichten verarbeitet? Wenn es das tut, könnte dies helfen: Benachrichtigung bei CD-Wechsel. Oder man nimmt gleich eine Klasse: Delphi 7 unit to control USB devices events.

MfG Dalai

[AlexII]

Zitat:

Zitat von Dalai (Beitrag 1307335)

Nur eine Vermutung: Vielleicht musst du

Code:

dbcv_unitmask

The logical unit mask identifying one or more logical units. Each bit in the mask corresponds to one logical drive. Bit 0 represents drive A, bit 1 represents drive B, and so on.

noch setzen?

Mit welchem Wert soll ich das belegen?

Zitat:

Zitat von Dalai (Beitrag 1307335)

Übrigens: bei reserved-Parametern sollte man aufpassen und diese besser gar nicht anfassen. Auch wenn sich durch deine Zuweisung wahrscheinlich nichts ändert, würde ich sie komplett weglassen.

Ok, mache ich.

Zitat:

Zitat von Dalai (Beitrag 1307335)

Bist du sicher, dass Lazarus keine WM_DEVICECHANGE Nachrichten verarbeitet?[/URL].

Ja. Kann jetzt nicht genau sagen, was genau und wie, aber ich habe es mehrmals so gelesen.

Ich überlege schon lieber mit nem Timer zu arbeiten, der alle x Sekunden nach Laufwerken Umschau hält, denn alles andere wird so langsam kompliziert und instabil.

[Dalai]

Zitat:

Zitat von AlexII (Beitrag 1307340)

Mit welchem Wert soll ich das belegen?

Probier's doch mal aus, ob dann RegisterDeviceNotification erfolgreich zurückkommt, wenn du nur irgendein Laufwerk angibst, eben als Bitmaske; das müsste 1, 2, 4, 8, 16 usw. sein.

Zitat:

Ja. Kann jetzt nicht genau sagen, was genau und wie, aber ich habe es mehrmals so gelesen.

Nur gelesen oder auch ausprobiert?

MfG Dalai

[Popov]

Also den kleinen Tipp von mir hast du nicht umgesetzt?

Delphi-Quellcode:

type
  TForm1 = class(TForm)
  private
    { Private-Deklarationen }
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//Reagiert auf Hinzufügen oder entfernen von Laufwerken
procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
  DBT_DEVICEARRIVAL = $8000; // System eindeckt ein neues Grerät
  DBT_DEVICEREMOVECOMPLETE = $8004; // Gerät wurde entfernt
begin
  inherited;

  case Msg.wParam of
  DBT_DEVICEARRIVAL: //hinzu
      begin
        ShowMessage('Ein Gerät wurde hinzugefügt.');
      end;
  DBT_DEVICEREMOVECOMPLETE: //entfernen
      begin
        ShowMessage('Ein Gerät wurde entfernt.');
      end;
  end;
end;

[AlexII]

Zitat:

Zitat von Popov (Beitrag 1307369)

Also den kleinen Tipp von mir hast du nicht umgesetzt?

Bin gerade dabei... aber dieser Code hier wird wahrscheinlich mit Lazarus nicht funktionieren. LCL leitet die Message an die App bzw. das Form nicht weiter. Habe es gelesen... nachdem ich viele Beispiele hier ausprobiert habe und die nicht funktionierten.

[hathor]

Mit LAZARUS 1.4.0 getestet:

Delphi-Quellcode:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  OldWProc: WNDPROC;

implementation

{$R *.lfm}

{ TForm1 }

const DBT_DEVICEARRIVAL = $8000;
//const DBT_DEVICEQUERYREMOVE = $8001;
//const DBT_DEVICEQUERYREMOVEFAILED = $8002;
//const DBT_DEVICEREMOVEPENDING = $8003;
const DBT_DEVICEREMOVECOMPLETE = $8004;
//const DBT_DEVICETYPESPECIFIC = $8005;
//const DBT_CONFIGCHANGED = $0018;

procedure MM(s:string); begin Form1.Memo1.lines.add(s); end;

procedure FindDrives;
var
  Drive: Char;
  DriveLetter: string;
begin
  MM('The following drives were found in this computer:');
  MM('');
  // Search all drive letters
  for Drive := 'A' to 'Z' do
  begin
    DriveLetter := Drive + ':\';
    case GetDriveType(PChar(DriveLetter)) of
     DRIVE_REMOVABLE: MM(DriveLetter + ' USB Stick/Drive');
     DRIVE_FIXED:     MM(DriveLetter + ' Fixed Drive');
     DRIVE_REMOTE:    MM(DriveLetter + ' Network Drive');
     DRIVE_CDROM:     MM(DriveLetter + ' CD/DVD/BR Drive');
     DRIVE_RAMDISK:   MM(DriveLetter + ' RAM Disk');
    end;
  end;
  MM('------------------------------------------------');
end;

function MyWndProc(hWnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case uiMsg of
    WM_DEVICECHANGE:
  case wParam of
  DBT_DEVICEARRIVAL:
      begin
        Windows.Beep(1000,250); Windows.Beep(1500,250);
          Form1.Memo1.clear;
          MM('DEVICECHANGE: Drive added.');
        FindDrives;
        Exit;
      end;
  DBT_DEVICEREMOVECOMPLETE:
      begin
        Windows.Beep(2000,250); Windows.Beep(1500,250);
          Form1.Memo1.clear;
          MM('DEVICECHANGE: Drive removed.');
        FindDrives;
        Exit;
      end;
  end;
  end;
  Result := CallWindowProc(OldWProc, hWnd, uiMsg, wParam, lParam);
end;

procedure SetMyWndProc(Handle : THandle);
begin
     OldWProc := WNDPROC(SetWindowLongPtr(Handle, GWL_WNDPROC, LONG_PTR(@MyWndProc)));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     SetMyWndProc(Handle);
     FindDrives;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.clear;
  FindDrives;
end;

end.

[BadenPower]

Zitat:

Zitat von hathor (Beitrag 1307480)

Mit LAZARUS 1.4.0 getestet:

Funktioniert mit einem USB-Stick, aber nicht mit einer Speicherkarte.

[hathor]

Bei meinem Notebook wird die SD-Card (POPPSTAR 32GB) erkannt.

[BadenPower]

Zitat:

Zitat von hathor (Beitrag 1307509)

Bei meinem Notebook wird die SD-Card (POPPSTAR 32GB) erkannt.

Am Rechnersystem, an dem ich Deinen Code getestet hatte, hängt an einem USB-Anschluß ein CardReader, welchem immer 4 Laufwerke zugeordnet sind.

Es wird also kein Laufwerk erzeugt, wenn eine Karte eingesteckt wird und kein Laufwerk entfernt, wenn die Karte herausgenommen wird.

[Popov]

Ich weiß nicht unter was der fest eingebauter CardReader läuft, aber ein Wechsellaufwerk sollte es nicht sein. Somit sollte auch keine Meldung kommen, denn das Laufwerk ist schon da und bleibt, lediglich ein Speichermedium wird gemountet. Wenn du also ein DS Karte einsteckst, dann ist es genau so wie wenn du eine CD in das CD Laufwerk einlegst.

Neben den bei hathors Code aufgelisteten Laufwerke gibt es noch paar andere:

Delphi-Quellcode:

function DriveType(DriveByte: Byte): String;
begin
  case GetDriveType(PChar(Chr(DriveByte + Ord('A')) + ':\')) of
    DRIVE_UNKNOWN:      Result := 'unbekannt';
    DRIVE_NO_ROOT_DIR:  Result := 'Laufwerk existiert nicht';
    DRIVE_REMOVABLE:    Result := 'Wechselmedium';
    DRIVE_FIXED:        Result := 'Festplatte';
    DRIVE_REMOTE:       Result := 'Netzwerk';
    DRIVE_CDROM:        Result := 'CD-ROM/DVD';
    DRIVE_RAMDISK:      Result := 'RAM Disk';
  else
    Result := 'anderer Laufwerkstyp';
  end;
end;

[AlexII]

Bei mir läuft der Code von hathor irgendwie instabil. Mal läuft alles, die Laufwerke werden erkannt und angezeigt, mal nicht...

Nachtrag: hab's rausgefunden wieso. In FormCreate muss noch SetMyWndProc(Handle); rein.

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
  SetMyWndProc(Handle); // <-------
  FindDrives;
end;

Schade nur, dass das die SD-Karten nicht erkennt, dass in einen bereits angeschlossenen Card-Reader eingesteckt werden. Wie bereits im #14 erwähnt.

[Popov]

Das ist jetzt nur so ins Freie geschossen, aber bei einer SD Karte würde ich nicht prüfen ob ein Laufwerk gewechselt wurde, sondern eher ob ein neuer Datenträger gemountet wurde.

[mm1256]

Um in meiner App mit zu bekommen, ob ein Datenträger eingelegt wurde, verwende ich das da

[AlexII]

Zitat:

Zitat von Popov (Beitrag 1307597)

Das ist jetzt nur so ins Freie geschossen, aber bei einer SD Karte würde ich nicht prüfen ob ein Laufwerk gewechselt wurde, sondern eher ob ein neuer Datenträger gemountet wurde.

Das stimmt, nur muss eine Message an die App darüber gesendet werden.

[AlexII]

Zitat:

Zitat von mm1256 (Beitrag 1307628)

Um in meiner App mit zu bekommen, ob ein Datenträger eingelegt wurde, verwende ich das da

Was meinst Du mit "eingelegt"? Ob ein Laufwerk X: oder so auftaucht oder ob ein Datenträger gemountet wurde?

[mm1256]

Probier es doch einfach aus. Sind ja nur ein paar Zeilen Code. Es funktioniert jedenfalls, wenn ein Laufwerk vorhanden ist (in diesem Fall ein Cardreader) und in den Reader eine Karte eingesteckt wird. Unabhängig davon, ob vor dem Einlegen der Karte das Laufwerk vorhanden war oder nicht.

Ich benutze die Funktion um zu verhindern, dass während mein Installationsprogramm läuft weitere Autorun-Funktionen (z.B. der Installationsdatenträger wird entfernt und nochmals eingelegt) ausgeführt werden

Delphi-Quellcode:

procedure TFoo.FormCreate(Sender: TObject);
begin
  MsgID_AutoPlayMessage := RegisterWindowMessage('QueryCancelAutoPlay' );
end;

procedure TFoo.WndProc(var Msg: TMessage);
begin
  if(MsgID_AutoPlayMessage = Msg.Msg) 
  then Msg.Result := 1 // kein Autoplay
  else inherited WndProc( Msg );
end;

[AlexII]

Ich probiere es gleich aus. Aber was ist wenn die Autorun-Funktionen im Windows deaktiviert sind?

Nachtrag: Ja, wenn die automatische Wiedergabe (Autorun-Funktionen) deaktiviert ist, bringt der Code nichts. Die eingelegte bzw. gemountete SD-Karte wird von der App nicht erkannt. Aber trotzdem danke, werde es einbauen um die lästigen Autoruns fern zu halten.

[hathor]

Vielleicht ist GUID_IO_VOLUME_MOUNT die Lösung:
(In LAZARUS nicht getestet, bei XE7 funktioniert es.)

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FWindow: HWND;
    FDevNotificationHandle: HDEVNOTIFY;
    procedure WndMethod(var Message: TMessage);
    function HandleDeviceChange(Event: DWORD; Data: Pointer): Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  DEV_BROADCAST_HANDLE = record
    dbch_size: DWORD;
    dbch_devicetype: DWORD;
    dbch_reserved: DWORD;
    dbch_handle: THandle;
    dbch_hdevnotify: HDEVNOTIFY;
    dbch_eventguid: TGUID;
    dbch_nameoffset: LONG;
  end;

const
  DBT_DEVTYP_DEVICEINTERFACE = $0005;
  GUID_IO_VOLUME_MOUNT: TGUID = '{B5804878-1A96-11D2-8FFD-00A0C9A06D32}';

procedure TForm1.FormCreate(Sender: TObject);
var
  dbh: DEV_BROADCAST_HANDLE;
begin
  FWindow := AllocateHWnd(WndMethod);
  dbh := Default(DEV_BROADCAST_HANDLE);
  dbh.dbch_size := SizeOf(dbh);
  dbh.dbch_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  dbh.dbch_eventguid := GUID_IO_VOLUME_MOUNT;
  FDevNotificationHandle := RegisterDeviceNotification(FWindow, @dbh,
    DEVICE_NOTIFY_WINDOW_HANDLE);
  Win32Check(FDevNotificationHandle <> nil);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FDevNotificationHandle <> nil then
    Win32Check(UnregisterDeviceNotification(FDevNotificationHandle));
  DeallocateHWnd(FWindow);
end;

procedure TForm1.WndMethod(var Message: TMessage);
begin
  case Message.Msg of
    WM_DEVICECHANGE:
      Message.Result := ord(HandleDeviceChange(Message.WParam,
        Pointer(Message.LParam)));
  else
    Message.Result := DefWindowProc(FWindow, Message.Msg, Message.WParam,
      Message.LParam);
  end;
end;

function TForm1.HandleDeviceChange(Event: DWORD; Data: Pointer): Boolean;
begin
  Winapi.Windows.Beep(2000,100); Winapi.Windows.Beep(1000,100);
  Memo1.Lines.Add(Format('%4x', [Event]));
  Result := True;
  case Event of
  $07:    Memo1.Lines.Add('DEVICECHANGE');
  $8000:  Memo1.Lines.Add('DEVICEARRIVAL');
  $8004:  Memo1.Lines.Add('DEVICEREMOVECOMPLETE');
(* oder
   7:      Memo1.Lines.Add('DEVICECHANGE');
   32768 : Memo1.Lines.Add('DEVICEARRIVAL');
   32769 : Memo1.Lines.Add('');
   32770 : Memo1.Lines.Add('');
   32771 : Memo1.Lines.Add('');
   32772 : Memo1.Lines.Add('DEVICEREMOVECOMPLETE');
   32773 : Memo1.Lines.Add('');
*)
  end;
end;

end.

(*
Bedeutungen der angezeigten Codes:
WM_DEVICECHANGE 0x07
DBT_CONFIGCHANGECANCELED 0x19
DBT_CONFIGCHANGED 0x18
DBT_CUSTOMEVENT 0x8006
DBT_DEVICEARRIVAL 0x8000 <--------------------
DBT_DEVICEQUERYREMOVE 0x8001
DBT_DEVICEQUERYREMOVEFAILED 0x8002
DBT_DEVICEREMOVECOMPLETE 0x8004 <-------------
DBT_DEVICEREMOVEPENDING 0x8003
DBT_DEVICETYPESPECIFIC 0x8005
DBT_QUERYCHANGECONFIG 0x17
DBT_USERDEFINED 0xffff
*)