USB-Seriennummer auslesen

[Schorschi5566]

Hallo zusammen,

nach einiger Sucherei und eigenen Experimenten habe ich eine Funktion zum Ermitteln der hardwaremäßigen Seriennummer eines angeschlossenen USB-Sticks erstellt, die unter WinXP bis Win 7 funktioniert.

Übergeben wird eine Stringlist mit zu prüfenden Seriennummern. Ist eine der Nummern die Seriennummer eines angeschlossenen USB-Sticks, wird True zurückgeliefert. Bisher haben alle Sticks, die ich hier zur Verfügung habe funktioniert, darunter auch Werbesticks.

Man muss nur die SetupAPI aus dem Jediprojekt mit einbinden. Der CfgMgr ist nicht notwendig.

Getestet habe ich das Ganze bisher unter folgenden Betriebssystemen:
Win XP 32, Win7 32/64, Server 2003 R2, Server 2008 R2. (Vista sollte auch funktionieren. Vielleicht sogar Win2k.)

Quellen: Alles was man bei Google und hier zum Thema findet. ;)

Vielleicht ist's ja was für die Codelib.


Grüße,
Uwe

Delphi-Quellcode:

// SetupApi muss eingebunden sein!
function FindUsbSerialNumber(SerialNumbers : TStrings): Boolean;
const
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
var
  StorageGUID: TGUID;
  pHandle: HDEVINFO;
  DevData: TSPDevInfoData;
  DeviceInterfaceData: TSPDeviceInterfaceData;
  FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
  bSuccess: Boolean;
  iDevn, i, iPos: Integer;
  dwBytesReturned: DWORD;
  sDevStr, sSerialNumber : string;
begin
  Result := False;
  StorageGUID := GUID_DEVINTERFACE_USB_DEVICE;

  // alle angeschlossenen USB-Geräte prüfen
  pHandle := SetupDiGetClassDevs(@StorageGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
  if pHandle = Pointer(INVALID_HANDLE_VALUE) then
    Exit;

  try
    iDevn := 0;
    repeat
      DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
      bSuccess := SetupDiEnumDeviceInterfaces(pHandle, nil, StorageGUID, iDevn, DeviceInterfaceData);
      if bSuccess then
      begin
        DevData.cbSize := SizeOf(DevData);
        dwBytesReturned := 0;
        SetupDiGetDeviceInterfaceDetail(pHandle, @DeviceInterfaceData, nil, 0, dwBytesReturned, @DevData);
        if (dwBytesReturned <> 0) then
        begin
          FunctionClassDeviceData := AllocMem(dwBytesReturned);
          try
            FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
            if SetupDiGetDeviceInterfaceDetail(pHandle, @DeviceInterfaceData,
              FunctionClassDeviceData, dwBytesReturned, dwBytesReturned, @DevData) then
            begin
              sDevStr := copy(PWideChar(@FunctionClassDeviceData.DevicePath), 0, MaxInt);
              // Seriennummer aus sDevStr extrahieren
              iPos := Pos('#', sDevStr);
              if iPos > -1 then
              begin
                sSerialNumber := copy(sDevStr, iPos + 1, MaxInt);
                iPos := Pos('#', sSerialNumber);
                if iPos > -1 then
                begin
                  sSerialNumber := copy(sSerialNumber, iPos + 1, MaxInt);
                  iPos := Pos('#', sSerialNumber);
                  if iPos > -1 then
                  begin
                    sSerialNumber := copy(sSerialNumber, 1, iPos - 1);
                    // alle übergebenen Seriennummern vergleichen
                    i := 0;
                    while (i < SerialNumbers.Count) and not Result do
                    begin
                      Result := AnsiUpperCase(sSerialNumber) = SerialNumbers[i];
                      Inc(i);
                    end;
                  end;
                end;
              end;
            end;
          finally
            FreeMem(FunctionClassDeviceData);
          end;
        end;
      end;
      Inc(iDevn);
    until Result or not bSuccess;
  finally
    SetupDiDestroyDeviceInfoList(pHandle);
  end;
end;

[sx2008]

Wenn man den Code so ändern würde, dass die gefundenen Seriennummern in die Stringliste eingetragen werden, dann wäre das eine nützliche Funktion.
Dass die gefundene Seriennummer mit einer übergebenen Liste abgeglichen wird ist doch eher etwas einschränkend.

[Schorschi5566]

Hallo sx2008,

Ich hab's aber "so rum" gebraucht.

Aber es ist ja kein 1000-Zeiler. Das kriegst Du schon hin, oder? Wenn nicht, einfach nochmal fragen. ;)


Grüße,
Uwe

[generic]

Was du für dich mal ausprobieren könntest:

Ich hab einen USB auf MicroSD Dongle.
Diese "USB-Sticks" liefern alle die gleiche Seriennummer (bzw. keine).
Ich kann mich nur gerade nicht Erinnern welche das war.
Es war was banales wie 12345678 oder 00000000.

[sx2008]

Zitat:

Zitat von Schorschi5566 (Beitrag 1147180)

Ich hab's aber "so rum" gebraucht.Aber es ist ja kein 1000-Zeiler. Das kriegst Du schon hin, oder?

Ich selbst brauche die Funktion z.Zt. nicht, sondern ich hab nur versucht dich in die richtige Richtung zu schubsen.
In der Überschrift steht "Seriennummer auslesen", in Wirklichkeit wird aber geprüft ob eine Seriennummer in einer Liste vorhanden ist.
Auch der Name "FindUsbSerialNumber()" passt nicht zu dem was die Funktion tut; sie müsste eher "CheckUsbSerialNumbers()" heissen.
Für die Code-Library wäre das Auslesen aller USB Seriennummern deutlich nützlicher als eine Funktion die nur prüft ob die erste gefundene USB Seriennummer in einer Stringliste enthalten ist.

[Sir Rufo]

Es ist auf jeden Fall - schon wegen der Wiederverwendbarkeit - sinnvoller die einzelnen Funktionsteile auseinander zu ziehen.

Möglich wäre folgende Implementierung:

Delphi-Quellcode:

unit USBSerialNumber;

interface

uses
  Classes;

function GetUSBSerialNumbers( AList : TStrings ) : Boolean;

function CheckUSBSerialNumbers( ASerialList : TStrings ) : Boolean; overload;
function CheckUSBSerialNumbers( ASerial : string ) : Boolean; overload;

implementation

uses
  SetupAPI;

function GetUSBSerialNumbers( AList : TStrings ) : Boolean;
// Hier die Original-Routine, die aber nur die Liste mit den ausgelesenen Seriennummern liefert

function CheckUSBSerialNumbers( ASerialList : TStrings ) : Boolean; overload;
var
  AList : TStrings;
begin
  Result := False;
  AList := TStringList.Create;
  try
    if GetUSBSerialNumbers( AList ) then
    // hier jetzt die Seriennummern vergleichen
  finally
    AList.Free;
  end;
end;

function CheckUSBSerialNumbers( ASerial : string ) : Boolean; overload;
var
  AList : TStrings;
begin
  AList := TStringList.Create;
  try
    AList.Add( ASerial );
    Result := CheckUSBSerialNumbers( AList );
  finally
    AList.Free;
  end;
end;

end.

[Schorschi5566]

Hallo zusammen,

wie man das Ganze verwendet, ist ja doch sehr von der Anwendung abhängig. Es geht nicht darum, wie und ob man TStringList verwendet. :roll:

Der Witz ist eigentlich, dass man GUID_DEVINTERFACE_USB_DEVICE verwendet und nicht die vielen anderen Deskriptoren (zum Beispiel Volume oder Hid), die zwar teilweise auch zum Ziel führen, aber unschöne Sonderbehandlungen für WinXP/Vista/Win7 zur Folge haben.

Wenn man per Google oder hier sucht, findet man relativ alte Beiträge, die selten bis gar nicht auf Win7 eingehen und eben nicht GUID_DEVINTERFACE_USB_DEVICE verwenden.

Wer sich mit der Seriennummerproblematik beschäftigt, findet meinen Ansatz vielleicht interessant, der aber nichts weiter ist als eine Umwandlung der vorhandenen Ansätze. Wie und ob das Ganze "codelibwürdig" ist, ist mir eigentlich nicht sonderlich wichtig. ;)

Grüße,
Uwe

P.S.: Das Problem mit USB-Sticks, die alle dieselbe Seriennummer haben, ist mir schon bekannt, war aber für meinen Anforderungsfall nicht von Belang. Es ging darum eine Anwendung nur dann zu starten, wenn ein USB-Stick aus einer Menge von zugelassenen USB-Sticks am Rechner steckt. Billig-USB-Sticks mit "Unseriennummern" wurden einfach nicht zugelassen.

[neo4a]

Hier noch als Ergänzung ein Code-Fragment über den WMI-Ansatz:

Delphi-Quellcode:

var
  objWMIService: OLEVariant;
  colItems: OLEVariant;
  colItem: OLEVariant;
  oEnum: IEnumvariant;
  i: Integer;

  aUSBSerial       : string;
  aRegexpr         : TArray<string>;
  aDeviceID        : string;

begin
  try
    objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
    colItems      := objWMIService.ExecQuery('Select * From Win32_DiskDrive Where InterfaceType="USB"', 'WQL', 0);
    oEnum         := IUnknown(colItems._NewEnum) as IEnumVariant;
    for i := 0 to colItems.Count - 1 do
      if oEnum.Next(1, colItem, iValue) = 0 then
      begin
        // Get the first part:
        aRegexpr := TRegEx.Split(colItem.PNPDeviceID, '\\');
        // Split with & and get the first part.
        aRegexpr := TRegEx.Split(aRegexpr[High(aRegexpr)], '&');
        aUSBSerial := aRegexpr[0];

        //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.
        aDeviceID      := StringReplace(VarStrNull(colItem.DeviceID),'\','\\',[rfReplaceAll]);

Beim Einsatz von zugelassenen USB-Sticks ist darauf zu achten, dass es für eine Reihe von OEM-Produkten (z.B. ChipsBank etc.) inoffizielle Software gibt, mit der man u.a. die Seriennr. und den Sticknamen setzen kann. Damit muss mein freundlicher Raubkopierer noch nicht mal mehr ein Hacker sein. AFAIK gibt es für einige Marken-Produkte (Sandisk) das - bislang - noch nicht. Wen es interessiert, der sucht einfach nach einer russischen Flashboot-Seite und erkundigt sich nach dem Stand der Dinge. Auf jeden Fall darf man sich mit der Abfrage einer zugelassenen Seriennr. allein auch nicht allzu sicher sein.

[Life]

Nabend :-)


hab mich durch eure code´s gearbeitet, (setupApi zwar zum download gefunden aber wie einbauen, bei dem anderen bekomme die Meldung das Form1 nicht deklariert wurde ...) bin in dem bereich noch absoluter Neuling.
..dennoch irgendwie bekomme es nicht wirklich gebacken das wenn einen bestimmten USB stick (snr Erkennung) anstecke sich dann eine bestimmte .exe (C:\magicn\menu.exe) öffnet....

Könnt Ihr mir da weiterhelfen?

[walharth]

Hallo zusammen,

ich verwende in meinem Programm den WMIService, um die angeschlossenen Laufwerke, vor allem die USB-Sticks zu erkennen. Dabei benötige ich die Variable FWbemObject.PNPDeviceID.

Leider habe ich nun bei einigen Usern festgestellt, dass das

FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive WHERE InterfaceType = "USB"');

bei einigen Tablet-Computern leer bleibt (u.a. auf dem Microsoft Surface Tablet mit Windows 10).

Ich suche nun nach einer 2. Möglichkeit, auf die ich zugreifen kann und hatte mir folgendes vorgestellt:

Falls das FWbemObjectSet nach dem Query-Befehl leer ist, könnte das Programm auf eine Alternative (evtl. eine kleine EXE in C++, ...) zurückgreifen, die aus meinem Delphi Programm heraus starte um die Laufwerke in eine Liste einzulesen (z.B. eine Textdatei). Leider bin ich mit C++ nicht vertraut.

Ich habe hier einen Link gefunden: https://stackoverflow.com/questions/...om-wmi-using-c


Wer könnte mir dabei weiterhelfen? Ich wäre für Eure Hilfe sehr dankbar!

[Andreas13]

Eine recht zuverlässige Routine, die auch bei USB-Laufwerken finktioniert, ist:

Delphi-Quellcode:

Function LWSerialID(CONST Drive: Char): String;
// Doberenz & Kowalski: Delphi 7 Kochbuch (2003) S. 822
VAR ID, dwx, dwy : DWord;
Begin
  IF GetVolumeInformation(pChar(Drive + ':\'), Nil, 0, @ID, dwx, dwy, Nil, 0) Then
    Result :=  IntToStr(ID)
  Else
    Result :=  'Error'
End; {LWSerialID}
{---------------}

Gruß, Andreas

[walharth]

Hallo Andreas13,

vielen Dank für die schnelle Antwort.

Ich habe die Funktion getestet. Die gibt mir aber leider nur die Seriennummer des Laufwerks. Ich benötige die PnPDeviceID.

[KodeZwerg]

RRUZ

Delphi-Quellcode:

program GetWMI_USBConnectedInfo;

{$APPTYPE CONSOLE}

uses
  Windows,
  Classes,
  ActiveX,
  Variants,
  SysUtils,
  WbemScripting_TLB;

procedure  GetUSBDiskDriveInfo;
var
  WMIServices  : ISWbemServices;
  Root,a,b     : ISWbemObjectSet;
  Item,Item2   : Variant;
  i,ii,iii,iiii: Integer;
  start,stop,freq:Int64;
begin
  QueryPerformanceFrequency(freq);
  QueryPerformanceCounter(start);

  WMIServices := CoSWbemLocator.Create.ConnectServer('.', 'root\cimv2','', '', '', '', 0, nil);
  Root := WMIServices.ExecQuery('Select * From Win32_DiskDrive','WQL', 0, nil);
  for i := 0 to Root.Count - 1 do
  begin
    Item := Root.ItemIndex(i);
    for ii := VarArrayLowBound(Item.Capabilities, 1) to VarArrayHighBound(Item.Capabilities, 1) do if (Item.Capabilities[ii] = 7) then begin
      Writeln('Caption      '+VarToStr(Item.Caption));
      Writeln('Name         '+VarToStr(Item.Name));
      Writeln('DeviceID     '+VarToStr(Item.DeviceID));
      Writeln('Partitions   '+VarToStr(Item.Partitions));
      Writeln('PNPDeviceID  '+VarToStr(Item.PNPDeviceID));
      Writeln('SerialNumber '+VarToStr(Item.SerialNumber));
      Writeln('Signature    '+VarToStr(Item.Signature));

      a := WMIServices.ExecQuery('ASSOCIATORS OF {Win32_DiskDrive.DeviceID=''' + VarToStr(Item.DeviceID) + '''} WHERE AssocClass = Win32_DiskDriveToDiskPartition','WQL', 0, nil);
      for iiii := 0 to a.Count - 1 do begin
        b := WMIServices.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID=''' + VarToStr(Variant(a.ItemIndex(iiii)).DeviceID) + '''} WHERE AssocClass = Win32_LogicalDiskToPartition','WQL', 0, nil);
        for iii := 0 to b.Count - 1 do begin
          Item2 := b.ItemIndex(iii);
          Writeln('Drive = ' + Item2.Caption);
        end;
      end;
      Writeln;
      Writeln;
    end;
  end;
  QueryPerformanceCounter(stop);
  if (freq > 0) then
    Writeln('Time took: ' + FloatToStr((stop-start) / freq))
  else
    Writeln('Unable to measure time!');
end;

begin
  try
    CoInitialize(nil);
    GetUSBDiskDriveInfo;
    Readln;
    CoUninitialize;
  except
    on E:Exception do
    Begin
        CoUninitialize;
        Writeln(E.Classname, ': ', E.Message);
        Readln;
    End;
  end;
end.

Hilft das?

[walharth]

Hallo KodeZwerg,

vielen Dank, aber leider liefert die Query "Root := WMIServices.ExecQuery('Select * From Win32_DiskDrive','WQL', 0, nil);"
auf einigen Windows Tablets eine leere Liste.

Ich bräuchte für diesen Fall eine Alternative ohne WMI.

Gruß
Walter

[mmw]

hallo,
vielleicht hilft das

https://github.com/RRUZ/delphi-wmi-c..._PnPEntity.pas

Gruß

[KodeZwerg]

Ich grübel gerade ob man über HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet die gewünschte Information erhält....

[walharth]

Hallo,

wie bereits erwähnt, habe ich die Routine welche mittels WMIService die am PC eingesteckten USB-Laufwerke ermittelt und anhand dieser Liste suche ich den USB-Stick, der die gewünschte PnPDeviceID enthält.

Ich habe aber einige User meines Programms, die ein Tablet-PC mit Windows 10 haben. Kurioserweise erkennt das System den USB Stick, jedoch liefert der WMIService eine leere Liste mit Laufwerksinfos (keine HDD oder SD, kein USB).

Nur für diesen speziellen Fall müsste eine Altnativroutine oder eine externe EXE im Hintergrund aufgerufen werden, welche die PnPDeviceID der USB Laufwerke OHNE WMI liefert.

Danke nochmals für eure Hilfe!

[KodeZwerg]

Zitat:

Zitat von walharth (Beitrag 1485616)

Tablet-PC mit Windows 10

Das verstehe ich selbst gerade noch nicht so ganz.
Auf MSDN steht halt:

Zitat:

Minimum supported client = Windows Vista
Minimum supported server = Windows Server 2008

Dann ist ein Tablet ein anderer client/server typ? Seltsam. Habe leider kein Tablet um das nachzuvollziehen.

Frage: Was hast Du denn mit der PnP-Id vor, vielleicht gibt es da ja möglichkeiten.

[walharth]

Hallo KodeZwerg,

Ich benötige die PnPDeviceID für die eindeutige Identifkation des USB-Sticks. Diese wird mit einer verschüsselten Version auf dem Stick verglichen. Die normale Seriennummer genügt leider nicht, da diese bei einigen Sticks nicht ermittelt werden kann, bez. gar nicht da ist.

[KodeZwerg]

Ahh! Dafür gibt es auch andere Mittel und Wege, ich würde mir über DeviceIoControl selbst was einzigartiges er"hash"en. (Kombination aus verschiedenen Informationen zusammenfassen und dann einen Hash wert generieren)
Schau mal bei Msdn rein, da sind dutzende Informationen zu finden.