Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi USB Laufwerk erkennen (https://www.delphipraxis.net/112699-usb-laufwerk-erkennen.html)

Gentleman 25. Apr 2008 15:45


USB Laufwerk erkennen
 
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

dominikkv 25. Apr 2008 16:05

Re: USB Laufwerk erkennen
 
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...

Gentleman 25. Apr 2008 17:21

Re: USB Laufwerk erkennen
 
Danke, jetzt funktioniert es!

Allerdings bekomme ich keinen Laufwerksbuchstaben.


Gruß,
Lennard

Schwedenbitter 17. Sep 2009 22:02

Re: USB Laufwerk erkennen
 
Zitat:

Zitat von Gentleman
... Allerdings bekomme ich keinen Laufwerksbuchstaben.

Hast Du irgend eine Lösung gefunden? Ich bekomme auch nicht hin.

Gruß, Alex

RWarnecke 18. Sep 2009 04:50

Re: USB Laufwerk erkennen
 
Dieser Tipp von den Schweizern sollte Dir weiterhelfen.

himitsu 18. Sep 2009 06:09

Re: USB Laufwerk erkennen
 
@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. :stupid:

RWarnecke 18. Sep 2009 07:12

Re: USB Laufwerk erkennen
 
Zitat:

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. :stupid:

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.

Schwedenbitter 23. Sep 2009 14:23

Re: USB Laufwerk erkennen
 
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 :wall:
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;


Alle Zeitangaben in WEZ +1. Es ist jetzt 22:58 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz