USB Stick erkennen

[Jelly]

Hallo zusammen,

wie kann ich erkennen wenn ein USB Stick an einen USB Port angeschlossen rsp. entfernt wird. Sinn der Sache ist, daß ich daraufhin ein Laufwerk sharen will. Diese Freigaben gehen nämlich bei jedem Entfernen verloren und sind beim nächsten Anschließen nicht mehr verfügbar.

Ach ja: OS ist w2k

Gruß,
Tom

[silentAMD]

hier ein sourcecode für laufwerkserkennung beim entfernen/anschliessen

Delphi-Quellcode:

procedure TFenster.WMDeviceChange(var Msg: TMessage);
type PDevBroadcastHdr = ^TDevBroadcastHdr;
 TDevBroadcastHdr = packed record
 dbcd_size, dbcd_devicetype, dbcd_reserved: DWORD; end;
type PDevBroadcastVolume = ^TDevBroadcastVolume;
 TDevBroadcastVolume = packed record
 dbcv_size, dbcv_devicetype, dbcv_reserved, dbcv_unitmask: DWORD;
 dbcv_flags: Word; end;
function GetDrive(pDBVol: PDevBroadcastVolume): string; 
var i: Byte; Maske: DWORD;
begin
if (pDBVol^.dbcv_flags and $0001) = $0001 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;
begin
case Msg.wParam of
 $8000:
  if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = $0002 then
   Pan('Datenträger in Laufwerk '+GetDrive(PDevBroadcastVolume(Msg.lParam))+'eingelegt');
 $8004:
  if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = $0002 then
  begin
   Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
   Pan('Datenträger aus Laufwerk '+Drive+'entfernt');
   if not(Drive = '') and (Drive[1] = ExtractFilePath(ParamStr(0))[1]) then Close;
  end;
 end;
end;

MFG

[edit=Luckie]Delphi-Tags gesetzt. Mfg, Luckie[/edit]

[Jelly]

Hey danke, das klappt fast einwandfrei. Krieg nur noch nicht den Unterschied zwischen Netzlaufwerken und physischen Laufwerken hin, ist aber nicht so schlimm.

Gruß,
Tom

[The-X]

Zitat:

Zitat von Jelly

Hey danke, das klappt fast einwandfrei. Krieg nur noch nicht den Unterschied zwischen Netzlaufwerken und physischen Laufwerken hin, ist aber nicht so schlimm.

Gruß,
Tom

Dazu sag ich nur GetDriveType :nerd:

[CReber]

Mit welchem Ereignis muss man die procedure verknüpfen?

[Robert Marquardt]

Also der Name WmDeviceChange sollte ein Hinweis sein: WM_DEVICECHANGE.

[J Kadison]

Hey!

Das ganze hört sich echt super an, hab da blos ein problem, und zwar bin absoluter noob :)
naja okay so schlimm auch net, aber ich hab bei dem QT noch ein zwei broblemchen ^^ und zwar:

1. Wie binde ich denn denn in mein Programm ein?
bzw. wie aktiviere ich den (ist das ü-haupt ein Hook) ?"

2. Was ist denn die Funktion/Procedur "Pan()"
bzw. in welcher API ist die denn enthalten?
die wird nämlich bei mir nicht gefunden

Delphi-Quellcode:

[Fehler] Unit1.pas(204): Undefinierter Bezeichner: 'Pan'

Wäre echt super wenn das noch jemand erklären könnte!

Schonmal vielen dank im voraus!

[nahpets]

[ot]in Pan.Tau 8) [/ot]

Quatsch, ersetzt es durch ShowMessage und gut ist.

[DeddyH]

Das scheint eine selbstgeschriebene Methode zu sein (zumindest kenn ich auch kein Pan). Das gibt aber nur eine Meldung aus, Du kannst es also auch durch z.B. ShowMessage ersetzen.

[J Kadison]

Jaja, wer so ne dumme frage stellt, den kann ich auch nur als DAU bezeichnen :wall:

Joa ne, erst lesen, dann fragen stellen :oops:

Dankeschön für die 1. Antwort, aber die andere Frage bleibt ^^

Wie registrier/deregistrier ich denn nun diese Prozedur?
Wäre echt supi, wenn mir das noch jemand ausführlich erklären könnte :)

[DeddyH]

Delphi-Quellcode:

type TFenster = class(TForm)
  ...
private
  procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  ...
end;

Wobei Du "TFenster" natürlich durch den Namen Deiner Form ersetzen musst. Im implementation-Teil der Unit dann halt den Code von oben (mit ersetztem Pan ;) ) einsetzen.

[nahpets]

Schau mal, ob Dir ansonsten das das weiterhilft: http://delphiheaven.blogspot.com/200...nected-or.html

[J Kadison]

Hey

Das mit dem

Delphi-Quellcode:

private
  procedure WMDeviceChange(var Msg: TMessage);

hatte ich mir schon gedacht, aber das Message hatte ich vergessen.
Naja wie gesagt, ihr seid echt spitze :zwinker:

:party: :party: :party: !!!

[turboPASCAL]

Ich habe den obigen Sourcecode mal Formatiert und "nachgebessert".
Soweit funktioniert die Erkennung des USB-Sticks bis auf die im Quelltext gekennz. Stelle.
dbcv_flags ergibt immer bei mir den Wert "0" unter Vista, auch im original von oben.

Hat jmd. eine Ahnung woran das liegen kann ?

Delphi-Quellcode:

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  DBT_DEVICEARRIVAL           = $8000; // A device or piece of media has been inserted and is now available.
  DBT_DEVICEQUERYREMOVE       = $8001; // Permission is requested to remove a device or piece of media. Any application can deny this request and cancel the removal.
  DBT_DEVICEQUERYREMOVEFAILED = $8002; // A request to remove a device or piece of media has been canceled.
  DBT_DEVICEREMOVECOMPLETE    = $8004; // A device or piece of media has been removed.

  DBT_DEVTYP_VOLUME           = $00000002; // Logical volume. This structure is a DEV_BROADCAST_VOLUME structure.
  DBTF_MEDIA                  = $0001;     // Change affects media in drive. If not set, change affects physical device or drive.
  DBTF_NET                    = $0002;     // Indicated logical volume is a network volume.

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

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

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Drive: String;

  function GetDrive(pDBVol: PDevBroadcastVolume): string;
  var
    i: Byte;
    Maske: DWORD;
    DevBroadcastVolume: TDevBroadcastVolume;
  begin
    DevBroadcastVolume := pDBVol^; // for Debug
    if (pDBVol^.dbcv_flags and DBTF_MEDIA) = DBTF_MEDIA 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;

begin
  case Msg.wParam of
    DBT_DEVICEARRIVAL:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DEVTYP_VOLUME then
        Label1.Caption := 'Datenträger in Laufwerk '+ GetDrive(PDevBroadcastVolume(Msg.lParam))+'eingelegt';
    DBT_DEVICEREMOVECOMPLETE:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DEVTYP_VOLUME then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        Label1.Caption := 'Datenträger aus Laufwerk '+Drive+'entfernt';
      end;
  end;
end;

end.

[RWarnecke]

Ich benutze den Tipp von den Schweizern oder diesen Code, der nicht von mir ist :

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
  private
    { Private declarations }
  public
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMDeviceChange(var Msg: TMessage);
type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size, dbcd_devicetype, dbcd_reserved: DWORD;
  end;
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size, dbcv_devicetype, dbcv_reserved, dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

  function GetDrive(pDBVol: PDevBroadcastVolume): string;
  var
    i: Byte; Maske: DWORD;
  begin
    if (pDBVol^.dbcv_flags and $0001) = $0001 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;
begin
  case Msg.wParam of
  $8000:
    if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = $0002 then
     Label1.Caption := 'Datenträger in Laufwerk '+GetDrive(PDevBroadcastVolume(Msg.lParam))+'eingelegt';
  $8004:
    if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = $0002 then
    begin
     Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
     Label1.Caption := 'Datenträger aus Laufwerk '+Drive+'entfernt';
     if not(Drive = '') and (Drive[1] = ExtractFilePath(ParamStr(0))[1]) then Close;
    end;
  end;
end;

end.

Funktioniert wunderbar mit USB-Sticks und USB-Festplatten.

[himitsu]

also 'ne Angabe daß sich bunter Vista was geändert hat, steht nicht da
http://msdn.microsoft.com/en-us/library/aa363249.aspx
aber es werden anscheinend dennoch viele Nachrichten nicht mehr oder anders versendet (ich erinner mich da böse an die Standby/Hibernation-Nachrichten :wall: )

der Code erinnert mich auch Stark an diesen zur CD-Erkennung:
http://msdn.microsoft.com/en-us/library/aa363215.aspx
vielleicht sollte man auch noch 'ne Prüfung des Laufwerktyps einbauen, nicht daß man hier ausvershen noch von CDs, DVDs und USB-Festplatten und anderen Speicherkarten erschlagen wird.

[RWarnecke]

Ich benutze den Sourcecode aus meinem letzten Posting in meinem Programm SystemInfo. Allerdings rufe ich dann jeweils die Funktion wieder auf, die mir die Daten zu den Festplatten, USB-Sticks, USB-Massenspeichergeräten und den CD/DVD-Laufwerken ausliest.

[MiKaEr]

wie genau benutzt man denn die unit von den schweizern?

http://www.swissdelphicenter.ch/de/showcode.php?id=2211

[DeddyH]

Instanz erzeugen und den beiden Events einen TNotifyEvent zuweisen.

[MiKaEr]

mein einziges problem ist:

wie sieht der aufbau eines solchen TNotifyEvents aus?

[DeddyH]

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FUSB: TComponentUSB;
    procedure DoOnConnect(Sender: TObject); //<- TNotifyEvent
    procedure DoOnDisconnect(Sender: TObject); //<- TNotifyEvent
  public
    { Public-Deklarationen }
  end;

...

procedure TForm1.DoOnConnect(Sender: TObject);
begin
  ShowMessage('Gerät angeschlossen');
end;

procedure TForm1.DoOnDisconnect(Sender: TObject);
begin
  ShowMessage('Gerät entfernt');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FUSB := TComponentUSB.Create(self);
  FUSB.OnUSBArrival := DoOnConnect;
  FUSB.OnUSBRemove := DoOnDisconnect;
end;

[MiKaEr]

ups.

sorry. jetzt weiß ich auch was ich falsch gemacht habe :oops:

ich habe das Sender: TObject vergessen

[himitsu]

PS: TNotifyEvent

Zitat:

Zitat von MiKaEr (Beitrag 1150116)

mein einziges problem ist:

wie sieht der aufbau eines solchen TNotifyEvents aus?

[DeddyH]

Hast Du auch selbst vorher nachgeschaut?

Zitat:

Code:

typedef void __fastcall (__closure *TNotifyEvent)(System::TObject* Sender);

Für reine Delphianer nicht sehr informativ :roll:

[MiKaEr]

mir fällt gerade auf, dass der auf der letzten seite vorgeschlagene source-code (WMDeviceChange) nicht funktioniert.

folgende funktion gibt keinen wert zurück, da

Delphi-Quellcode:

if (Maske and 1) = 1

niemals zutrifft:

Delphi-Quellcode:

 function GetDrive(pDBVol: PDevBroadcastVolume): string;
 var
  i: Byte;
  Maske: DWORD;
 begin
  if (pDBVol^.dbcv_flags and $0001) = $0001 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;

// GetDrive(PDevBroadcastVolume(Msg.lParam))

[DeddyH]

Welcher Wert steht denn in Maske?

[himitsu]

@Detlev: War auch vorwiegend als Beispiel gedacht. :stupid:
'ne lokale OH gibt's och noch, im Delphi-Quelltext steht es ganz genau und das CodeInsight, bzw. die Autovervollständigung zeichen auch die wichtigen pascalbezogenen Infos.

Falls man sich mal die Beschreibung zu DevBroadcastVolume ansieht, dann fällt Folgendes auf.

Zitat:

Gets the bit unit mask of the device. IE (bit 0 = A:, bit 1 = B:, etc..)

Mit der 1 liefert es also nur ein Ergebnis, wenn sich am ersten Laufwerk (also A: ) etwas verändert hat. :angle:

[DeddyH]

Das sehe ich aber anders.

Zitat:

Delphi-Quellcode:

for i := 0 to 25 do
begin
  if (Maske and 1) = 1 then Result := Char(i + Ord('A')) + ': ';
  Maske := Maske shr 1;
end;

Die Maske wird 26 mal auf gesetztes Bit geprüft und nach rechts geshiftet.

[himitsu]

:oops: Hab bei der Leerzeile aufgehört zu lesen ... wer kann den Ahnen, daß da noch was Wichtiges kommt. :stupid:

[ASM]

Zitat:

Zitat von MiKaEr (Beitrag 1150135)

mir fällt gerade auf, dass der auf der letzten seite vorgeschlagene source-code (WMDeviceChange) nicht funktioniert.

folgende funktion gibt keinen wert zurück, da

Delphi-Quellcode:

if (Maske and 1) = 1

niemals zutrifft:

Der Fehler liegt im Code

Code:

if (pDBVol^.dbcv_flags and $0001) = $0001 then

Der Wert "$0001" ist für den Wechsel eines CD/DVD-Laufwerks gültig.
Mit USB-Drives (Stick, Harddisk)) aber wird die dann folgende Schleife niemals durchlaufen, also der Laufwerksbuchstabe nicht erkannt.

Für USBs muss es vielmehr heißen:

Code:

 if (pDBVol^.dbcv_flags and DBTF_REMOVE) = DBTF_REMOVE then

wobei:

Code:

Const 
  DBTF_REMOVE = $0000;
  DBTF_MEDIA  = $0001;

[Assarbad]

Komplettes Beispiel (aber halt in C++): http://assarbad.net/stuff/arrived.zip :snowball: