AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

USB Laufwerk erkennen

Ein Thema von Gentleman · begonnen am 25. Apr 2008 · letzter Beitrag vom 23. Sep 2009
Antwort Antwort
Gentleman

Registriert seit: 29. Sep 2004
302 Beiträge
 
Turbo Delphi für Win32
 
#1

USB Laufwerk erkennen

  Alt 25. Apr 2008, 16:45
Hallo,

Ich möchte in meinem Programm eine Benachrichtigung erhalten, sobald ein USB-Stick oder eine externe Festplatte angeschlossen wird. Nun habe ich die Suche bemüht und folgendes gefunden: USB Stick erkennen
Problem ist nun allerdings, dass ich mit der Verwendung nicht richtig klar komme. Könnte mir jemand erklären, wie ich diese Prozedur verwenden muss, damit ich sie für meine Zwecke nutzen kann?


Gruß,
Lennard
Lennard
Der Vorteil der Klugheit besteht darin, dass man sich dumm stellen kann. Das Gegenteil ist schon schwieriger. (Kurt Tucholsky)
  Mit Zitat antworten Zitat
dominikkv

Registriert seit: 30. Sep 2006
Ort: Gundelfingen
1.109 Beiträge
 
Delphi 2007 Professional
 
#2

Re: USB Laufwerk erkennen

  Alt 25. Apr 2008, 17:05
Delphi-Quellcode:
interface
  type
    TFenster = class(TForm) // deine Form halt...
      // bla
      procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
      // bla
    end;

implementation

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;
vllt noch nach den entstrechenden Units suchen und einbinden...
Dominik
Wer anderen eine Grube gräbt, hat ein Gruben-Grab-Gerät!
  Mit Zitat antworten Zitat
Gentleman

Registriert seit: 29. Sep 2004
302 Beiträge
 
Turbo Delphi für Win32
 
#3

Re: USB Laufwerk erkennen

  Alt 25. Apr 2008, 18:21
Danke, jetzt funktioniert es!

Allerdings bekomme ich keinen Laufwerksbuchstaben.


Gruß,
Lennard
Lennard
Der Vorteil der Klugheit besteht darin, dass man sich dumm stellen kann. Das Gegenteil ist schon schwieriger. (Kurt Tucholsky)
  Mit Zitat antworten Zitat
Schwedenbitter

Registriert seit: 22. Mär 2003
Ort: Finsterwalde
622 Beiträge
 
Turbo Delphi für Win32
 
#4

Re: USB Laufwerk erkennen

  Alt 17. Sep 2009, 23:02
Zitat von Gentleman:
... Allerdings bekomme ich keinen Laufwerksbuchstaben.
Hast Du irgend eine Lösung gefunden? Ich bekomme auch nicht hin.

Gruß, Alex
Alex Winzer
  Mit Zitat antworten Zitat
Benutzerbild von RWarnecke
RWarnecke

Registriert seit: 31. Dez 2004
Ort: Stuttgart
4.408 Beiträge
 
Delphi XE8 Enterprise
 
#5

Re: USB Laufwerk erkennen

  Alt 18. Sep 2009, 05:50
Dieser Tipp von den Schweizern sollte Dir weiterhelfen.
Rolf Warnecke
App4Mission
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#6

Re: USB Laufwerk erkennen

  Alt 18. Sep 2009, 07:09
@RWarnecke: ich glaub nicht, denn damit müßte er ja kräftig Polling betreiben und immer wieder die aktuellen Laufwerke auslesen und mit 'ner älteren Liste vergleichen, nur um neu angesteckte Laufwerke zu erkennen.
$2B or not $2B
  Mit Zitat antworten Zitat
Benutzerbild von RWarnecke
RWarnecke

Registriert seit: 31. Dez 2004
Ort: Stuttgart
4.408 Beiträge
 
Delphi XE8 Enterprise
 
#7

Re: USB Laufwerk erkennen

  Alt 18. Sep 2009, 08:12
Zitat von himitsu:
@RWarnecke: ich glaub nicht, denn damit müßte er ja kräftig Polling betreiben und immer wieder die aktuellen Laufwerke auslesen und mit 'ner älteren Liste vergleichen, nur um neu angesteckte Laufwerke zu erkennen.
Den fast gleichen Weg gehe ich in meinem SystemInfo. Ich rufe diese Funktion nur dann auf, wenn die Message vom Windows kommt, dass ein neues Laufwerk angeschlossen wurde.
Rolf Warnecke
App4Mission
  Mit Zitat antworten Zitat
Schwedenbitter

Registriert seit: 22. Mär 2003
Ort: Finsterwalde
622 Beiträge
 
Turbo Delphi für Win32
 
#8

Re: USB Laufwerk erkennen

  Alt 23. Sep 2009, 15:23
Ich komme damit nur bedingt klar.

Ich bin bisher so vorgegangen, dass ich GetLogicalDriveStrings bei jeder eingehenden Message das an- oder abstöpseln eines Laufwerks betreffend aufgerufen habe. Dann habe ich die Arrays [0..128] Of Char verglichen. Allerdings kann ich mit der Benutzung des PChar nichts anfangen und habe damm bedingt geschummelt.
Ich hatte herausgefunden, dass das Array eine Liste der vergebenen Laufwerksbuchstaben nach dem Schema 'A'+':'+'\'+#00 enthält. Jetzt habe ich einfach nur die Buchstaben verglichen und wenn dann z.B. vorher nach 'C' nichts mehr kam, dann war es der nächste Buchstabe und wenn zwischen z.B. 'C' und 'P' nichts kam und dann plötzlich ein 'I' auftauchte, hatte ich das Laufwerk auch gefunden.

Allerdings benötige ich für meine Zwecke die VID_ und PID_ des Gerätes. Die ermittle ich nun unter Einbindung der DBT.pas und der Registrierung eines UsbDeviceNotificationHandle in FormCreate gemäß des hier im Forum kursierenden Codes. Seit ich das tue, bekomme ich aber nur noch Hyroglyphen. Schlimmer noch: Das neue Laufwerk ist in dem Array nicht einmal mehr dabei
Ich brauche VID_ und PID_ aber, um das Gerät eindeutig zu identifizieren, sonst wäre mein Programm murks. Und ich müsste dann auch alle 26 Laufwerke druchprobieren, weil das neue nicht mehr auftaucht.

Delphi-Quellcode:
Var
   Drives      : Array [0..128] Of Char;
...

Procedure TForm1.FormCreate(Sender: TObject);
Begin
   GetLogicalDriveStrings(SizeOf(Drives), Drives);
...

Procedure TForm1.WMDeviceChange(Var Msg: TMessage);
   Function GetDrive: String;
   Var
      I         : Integer;
      Aktuell   : Array [0..128] Of Char;
   Begin
      GetLogicalDriveStrings(SizeOf(Aktuell), Aktuell);
      I:=0;
      Repeat
         Inc(I,4);
      Until (Aktuell[I]<>Drives[I]) Or (I>SizeOf(Aktuell));
      If I>SizeOf(Aktuell) Then
         Result:='Fehler'
      Else
         Result:=Aktuell[I]+Aktuell[I+1];
   End;
Var
   device            : PDevBroadcastHdr;
   DeviceInfoBlock   : PDevBroadcastDeviceInterface;
Begin
   device:=PDevBroadcastHdr(Msg.lParam);
   Case Msg.wParam Of
      $8000   :   If device.dbch_devicetype = DBT_DEVTYP_DEVICEINTERFACE Then
               Begin
                  ShowMessage(GetDrive);
                  DeviceInfoBlock:=PDevBroadcastDeviceInterface(Msg.LParam);
                  If IsDVR(String(Pchar(@DeviceInfoBlock.dbcc_name))) Then
                     Memo1.Lines.Add('Diktiergerät als Laufwerk '+GetDrive+' angeschlossen.');
                  Memo1.Lines.Add('-----');
                  GetLogicalDriveStrings(SizeOf(Drives), Drives);
               End;
      $8004   :   If device.dbch_devicetype = DBT_DEVTYP_DEVICEINTERFACE Then
               Begin
                  GetLogicalDriveStrings(SizeOf(Drives), Drives);
               End;
   End;
End;
Alex Winzer
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 17:31 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz