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 von Schorschi5566:

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.

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.

[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.