| Autor | 
Beitrag | 
 
neuling321 
        
 
Beiträge: 18 
 
Win10prof 
Delphi 10 Seattle Prof. 
 | 
Verfasst: Do 09.06.16 19:05 
 
Hallo
 
Wie kann ich mit Delphi die Seriennummer und den Namen der Physikalischen HDD auslesen?
 Also in C# geht das recht einfach, gibt es das auch für Delphi?
 		                                                          C#-Quelltext                                	 															1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12:
  				 | 									        private void Form1_Load(object sender, EventArgs e)         {                          ManagementObjectSearcher ds = new ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive");
              foreach (ManagementObject d in ds.Get())             {                 comboBoxDisks.Items.Add(d["Model"].ToString());             }             comboBoxDisks.SelectedIndex = -1; 
          }					 				 | 			 		 	   
 
 | 
 
 |  
Gerd Kayser 
        
 
Beiträge: 632 
Erhaltene Danke: 121 
 
Win 7 32-bit 
Delphi 2006/XE 
 | 
Verfasst: Do 09.06.16 21:36 
 
	   neuling321 hat folgendes geschrieben  : | 	 		  | Wie kann ich mit Delphi die Seriennummer und den Namen der Physikalischen HDD auslesen? | 	  
Mir fallen da auf Anhieb zwei Möglichkeiten ein: mit DeviceIoControl und mit WMI.
 Für WMI hier ein Beispiel:
 																	1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67:
  				 | 									unit Main;
  interface
  uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ActiveX, ComObj, StdCtrls;
  type   TForm1 = class(TForm)     Label1: TLabel;     Label2: TLabel;     Label3: TLabel;     Button1: TButton;     procedure Button1Click(Sender: TObject);     procedure FormCreate(Sender: TObject);   private        public        end;
  var   Form1: TForm1;
  implementation
  {$R *.dfm}
  procedure TForm1.Button1Click(Sender: TObject); const   WbemUser            ='';   WbemPassword        ='';   WbemComputer        ='localhost';   wbemFlagForwardOnly = $00000020; var   FSWbemLocator : OLEVariant;   FWMIService   : OLEVariant;   FWbemObjectSet: OLEVariant;   FWbemObject   : OLEVariant;   oEnum         : IEnumvariant;   iValue        : LongWord; begin;   CoInitialize(nil);   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');   FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);   FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive', 'WQL', wbemFlagForwardOnly);   oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;   while oEnum.Next(1, FWbemObject, iValue) = 0 do     begin       if FWbemObject.DeviceID = '\\.\PHYSICALDRIVE0' then         begin           Label1.Caption := 'Device-ID: ' + FWbemObject.DeviceID;           Label2.Caption := 'Modell: ' + FWbemObject.Model;           Label3.Caption := 'Seriennummer: ' + Trim(FWbemObject.SerialNumber);         end;       FWbemObject := Unassigned;     end;   CoUninitialize; end;
  procedure TForm1.FormCreate(Sender: TObject); begin   ReportMemoryLeaksOnShutdown := true; end;
  end.					 				 | 			 		 	  
Nützlich (u. a. zum Nachschlagen) sind u. a. folgende Links:
 1.  www.magsys.co.uk/delphi/magwmi.asp  MagWMI enthält Sourcen und eine Besipielanwendung.
 2.  theroadtodelphi.com/...delphi-code-creator/  Das Programm hat die Abfrage im oben stehenden Beispiel erzeugt.  
 
 | 
 
 |  
t.roller 
        
 
Beiträge: 118 
Erhaltene Danke: 34 
 
 
 
 | 
Verfasst: Fr 10.06.16 07:06 
 
Ab WINDOWS 8 gibt es über WMI mehr Informationen, siehe:
 
MSFT_PhysicalDisk class
 msdn.microsoft.com/e...h830532%28v=vs.85%29
Beispiel geht auch OHNE Administrator-Rechte und bei USB-Disks.
 																	1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94:
  				 | 									program WMI_PhysicalDisk;
  {$APPTYPE CONSOLE}
  uses    System.SysUtils,   Winapi.ActiveX,   System.Win.ComObj,   System.Variants;
  function VarToInt(const AVariant: Variant): INT64;begin Result := StrToIntDef(Trim(VarToStr(AVariant)), 0); end;
  procedure  GetMSFT_PhysicalDiskInfo; const   WbemUser =''; WbemPassword =''; WbemComputer ='localhost';   wbemFlagForwardOnly = $00000020; var   FSWbemLocator : OLEVariant;   FWMIService   : OLEVariant;   FWbemObjectSet: OLEVariant;   FWbemObject   : OLEVariant;   oEnum         : IEnumvariant;   iValue        : LongWord; begin;   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');   FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\Microsoft\Windows\Storage', WbemUser, WbemPassword);   FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM MSFT_PhysicalDisk','WQL',wbemFlagForwardOnly);   oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;   while oEnum.Next(1, FWbemObject, iValue) = 0 do   begin     Writeln(Format('AllocatedSize                       %d',[VarToInt(FWbemObject.AllocatedSize)]));    Writeln(Format('BusType                             %d',[VarToInt(FWbemObject.BusType)]));    Writeln(Format('CanPool                             %s',[VarToStr(FWbemObject.CanPool)]));    Writeln(Format('Description                         %s',[VarToStr(FWbemObject.Description)]));    Writeln(Format('DeviceId                            %s',[VarToStr(FWbemObject.DeviceId)]));    Writeln(Format('EnclosureNumber                     %d',[VarToInt(FWbemObject.EnclosureNumber)]));    Writeln(Format('FirmwareVersion                     %s',[VarToStr(FWbemObject.FirmwareVersion)]));    Writeln(Format('FriendlyName                        %s',[VarToStr(FWbemObject.FriendlyName)]));    Writeln(Format('HealthStatus                        %d',[VarToInt(FWbemObject.HealthStatus)]));    Writeln(Format('IsIndicationEnabled                 %s',[VarToStr(FWbemObject.IsIndicationEnabled)]));    Writeln(Format('IsPartial                           %s',[VarToStr(FWbemObject.IsPartial)]));    Writeln(Format('LogicalSectorSize                   %d',[VarToInt(FWbemObject.LogicalSectorSize)]));    Writeln(Format('Manufacturer                        %s',[VarToStr(FWbemObject.Manufacturer)]));    Writeln(Format('MediaType                           %d',[VarToInt(FWbemObject.MediaType)]));    Writeln(Format('Model                               %s',[VarToStr(FWbemObject.Model)]));    Writeln(Format('ObjectId                            %s',[VarToStr(FWbemObject.ObjectId)]));    Writeln(Format('OtherCannotPoolReasonDescription    %s',[VarToStr(FWbemObject.OtherCannotPoolReasonDescription)]));    Writeln(Format('PartNumber                          %s',[VarToStr(FWbemObject.PartNumber)]));    Writeln(Format('PassThroughClass                    %s',[VarToStr(FWbemObject.PassThroughClass)]));    Writeln(Format('PassThroughIds                      %s',[VarToStr(FWbemObject.PassThroughIds)]));    Writeln(Format('PassThroughNamespace                %s',[VarToStr(FWbemObject.PassThroughNamespace)]));    Writeln(Format('PassThroughServer                   %s',[VarToStr(FWbemObject.PassThroughServer)]));    Writeln(Format('PhysicalLocation                    %s',[VarToStr(FWbemObject.PhysicalLocation)]));    Writeln(Format('PhysicalSectorSize                  %d',[VarToInt(FWbemObject.PhysicalSectorSize)]));    Writeln(Format('SerialNumber                        %s',[VarToStr(FWbemObject.SerialNumber)]));    Writeln(Format('Size                                %d',[VarToInt(FWbemObject.Size)]));    Writeln(Format('SlotNumber                          %d',[VarToInt(FWbemObject.SlotNumber)]));    Writeln(Format('SoftwareVersion                     %s',[VarToStr(FWbemObject.SoftwareVersion)]));    Writeln(Format('SpindleSpeed                        %d',[VarToInt(FWbemObject.SpindleSpeed)]));    Writeln(Format('UniqueId                            %s',[VarToStr(FWbemObject.UniqueId)]));    Writeln(Format('Usage                               %d',[VarToInt(FWbemObject.Usage)]));     Writeln('-------------------------------------------------------------------');     FWbemObject:=Unassigned;   end; end; begin  try     CoInitialize(nil);     try       GetMSFT_PhysicalDiskInfo;     finally       CoUninitialize;     end;  except     on E:EOleException do         Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));     on E:Exception do         Writeln(E.Classname, ':', E.Message);  end;  Writeln('Press Enter to exit');  Readln; end.					 				 | 			 		 	  
Beispiel-Ausgabe: PhysicalDisk1 = SSD/USB, PhysicalDisk0 = HDD0
 
 AllocatedSize             0
 BusType                   7
 CanPool                   False
 Description               
 DeviceId                  1
 EnclosureNumber           0
 FirmwareVersion           3004
 FriendlyName              PhysicalDisk1
 HealthStatus              0
 IsIndicationEnabled       
 IsPartial                 True
 LogicalSectorSize         512
 Manufacturer              KINGSTON
 MediaType                 0
 Model                     SV300S37A240G
 OtherCannotPoolReasonDescription    
 PartNumber                
 PassThroughClass          
 PassThroughIds            
 PassThroughNamespace                
 PassThroughServer         
 PhysicalLocation          
 PhysicalSectorSize        512
 SerialNumber              00A1234xxxxxx    
 Size                      0
 SlotNumber                0
 SoftwareVersion           
 SpindleSpeed              -1
 UniqueId                  
 Usage                     1
 --------------------------------------------------
 AllocatedSize             0
 BusType                   11
 CanPool                   False
 Description               
 DeviceId                  0
 EnclosureNumber           0
 FirmwareVersion           2BC10001
 FriendlyName              PhysicalDisk0
 HealthStatus              0
 IsIndicationEnabled       
 IsPartial                 True
 LogicalSectorSize         512
 Manufacturer              
 MediaType                 3
 Model                     ST2000LM003 HN-M201RAD
 OtherCannotPoolReasonDescription    
 PartNumber                
 PassThroughClass          
 PassThroughIds            
 PassThroughNamespace                
 PassThroughServer         
 PhysicalLocation          
 PhysicalSectorSize        4096
 SerialNumber              S346J9xxxxxxxx
 Size                      0
 SlotNumber                0
 SoftwareVersion           
 SpindleSpeed              -1
 UniqueId                  50004xxxxxxxxx
 Usage                     1  
 
 | 
 
 |  
neuling321   
        
 
Beiträge: 18 
 
Win10prof 
Delphi 10 Seattle Prof. 
 | 
Verfasst: Sa 11.06.16 14:54 
 
Hallo zusammen
 
Vielen Dank
 Die erste Procedure von Gerd Kayser reicht mir eigentlich, mehr Infos brauche ich nicht.
 Nur habe ich ein Problem, die Abfrage bringt bei virtuellen HDD's einen Fehler.
 Kann man irgendwie abfragen, ob es eine Virtuelle oder eine Physikalische Harddisk ist?
 																	1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35:
  				 | 									 procedure TForm1.Button7Click(Sender: TObject); const   WbemUser            ='';   WbemPassword        ='';   WbemComputer        ='localhost';   wbemFlagForwardOnly = $00000020; var   FSWbemLocator : OLEVariant;   FWMIService   : OLEVariant;   FWbemObjectSet: OLEVariant;   FWbemObject   : OLEVariant;   oEnum         : IEnumvariant;   iValue        : LongWord;
  begin;   CoInitialize(nil);   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');   FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);    FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive', 'WQL', wbemFlagForwardOnly);    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;  
    while oEnum.Next(1, FWbemObject, iValue) = 0 do      begin       if FWbemObject.DeviceID = ('\\.\PHYSICALDRIVE0') then         begin           Label1.Caption := 'Device-ID: ' + FWbemObject.DeviceID;           Label2.Caption := 'Modell: ' + FWbemObject.Model;           Label3.Caption := 'Seriennummer: ' + Trim(FWbemObject.SerialNumber);         end;       FWbemObject := Unassigned;     end;   CoUninitialize; end;					 				 | 			 		 	  
Kann mir das jemand erklären?  
 
 | 
 
 |  
Gerd Kayser 
        
 
Beiträge: 632 
Erhaltene Danke: 121 
 
Win 7 32-bit 
Delphi 2006/XE 
 | 
Verfasst: So 12.06.16 16:06 
 
	   neuling321 hat folgendes geschrieben  : | 	 		  | die Abfrage bringt bei virtuellen HDD's einen Fehler. | 	  
Ein virtuelles Laufwerk hat keine Fabrikationsseriennummer, weil es eben keine Hardware ist. Diese Nummer darf nicht mit der Seriennummer verwechselt werden, die von Windows jeweils neu beim Formatieren vergeben wird. Wenn FWbemObject.SerialNumber leer ist (also NULL), dann führt ein Zugriff darauf zum Fehler.
 Ob eine virtuelle Platte vorliegt, erkennt man an FWbemObject.Model. Dann findet man dort einen entsprechenden Hinweis. Ein weiteres Merkmal ist das Fehlen der Fabrikationsseriennummer.
 Nachfolgend eine geänderte Version der Abfrage, soweit ich diese mit meiner Hardware testen konnte. Ich weiss allerdings nicht, ob das auch bei Partitionen funktioniert, die sich über mehr als ein Laufwerk erstrecken (z. B. bei Raid).
 																	1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148:
  				 | 									unit Main;
  interface
  uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, ActiveX, ComObj, StdCtrls, FileCtrl;
  const   IoCtl_Storage_Get_Device_Number = $2D1080;
  type   _Storage_Device_Number = record      DeviceType      : DWord;      DeviceNumber    : DWord;      PartitionNumber : DWord;   end;
  type   TLaufwerkstyp = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM, dtRAM);
  type   TForm1 = class(TForm)     Label1: TLabel;     Label2: TLabel;     Label3: TLabel;     Label4: TLabel;     Label5: TLabel;     Button1: TButton;     procedure Button1Click(Sender: TObject);     procedure FormCreate(Sender: TObject);   private        public        end;
  var   Form1: TForm1;
  implementation
  {$R *.dfm}
  procedure TForm1.Button1Click(Sender: TObject); const   WbemUser            ='';   WbemPassword        ='';   WbemComputer        ='localhost';   wbemFlagForwardOnly = $00000020; var   Temp          : TLaufwerkstyp;   TempStr       : string;   DevIoHandle   : THandle;   StoDevNum     : _Storage_Device_Number;   Ergebnis      : boolean;   Gelesen       : DWord;   FSWbemLocator : OLEVariant;   FWMIService   : OLEVariant;   FWbemObjectSet: OLEVariant;   FWbemObject   : OLEVariant;   oEnum         : IEnumvariant;   iValue        : LongWord; begin      TempStr := 'N:';   Label1.Caption := 'Laufwerk: ' + TempStr;
       Temp := TLaufwerkstyp(GetDriveType(PChar(TempStr)));
    if Temp <> dtFixed then     ShowMessage('Keine virtuelle / physikalische Festplatte!')   else     begin                          TempStr := '\\.\' + TempStr;       DevIoHandle := CreateFile(PChar(TempStr),                                 Generic_Read,                                 File_Share_Read or File_Share_Write,                                 nil,                                 Open_Existing,                                 0,                                 0);
        if DevIoHandle = Invalid_Handle_Value then         ShowMessage('Fehler bei CreateFile!')       else         begin           Ergebnis := DeviceIoControl(DevIoHandle,                                       IoCtl_Storage_Get_Device_Number,                                       nil,                                       0,                                       @StoDevNum,                                       SizeOf(StoDevNum),                                       Gelesen,                                       nil);           CloseHandle(DevIoHandle);         end;
        if not Ergebnis then         ShowMessage('Fehler bei DeviceIoControl!')       else         begin                      Label2.Caption := 'DeviceNumber: ' + IntToStr(StoDevNum.DeviceNumber);           Label3.Caption := 'PartitionNumber: ' + IntToStr(StoDevNum.PartitionNumber);
            CoInitialize(nil);           FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');           FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);           FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive', 'WQL', wbemFlagForwardOnly);           oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
            TempStr := '\\.\PHYSICALDRIVE' + IntToStr(StoDevNum.DeviceNumber);
            while oEnum.Next(1, FWbemObject, iValue) = 0 do             begin               if FWbemObject.DeviceID = TempStr then                 begin                   Label4.Caption := 'Modell: ' + FWbemObject.Model;
                                       if not VarIsNull(FWbemObject.SerialNumber) then                     Label5.Caption := 'Seriennummer: ' + Trim(FWbemObject.SerialNumber)                   else                     Label5.Caption := 'Keine Seriennummer, da virtuelles Laufwerk!';                 end;               FWbemObject := Unassigned;             end;           CoUninitialize;         end;     end; end;
  procedure TForm1.FormCreate(Sender: TObject); begin   ReportMemoryLeaksOnShutdown := true; end;
  end.					 				 | 			 		 	   
 
 | 
 
 |  
neuling321   
        
 
Beiträge: 18 
 
Win10prof 
Delphi 10 Seattle Prof. 
 | 
Verfasst: Mo 13.06.16 18:39 
 
Hallo,
 
Vielen Dank, aber Ida ist noch ein Fehler drin, ich muss ihn mal suchen.
 Er bringt mir auch bei einer Physischen HDD die Fehlermeldung "ShowMessage('Fehler bei DeviceIoControl!')"
 Werde ich aber schon rausfinden. Danke sehr    
 
 | 
 
 |  
icho2099 
        
 
Beiträge: 101 
Erhaltene Danke: 12 
 
WIN XP, WIN 7, WIN 10 
Delphi 6 Prof, Delphi 2005, FPC 
 | 
Verfasst: So 18.09.16 09:51 
 
In dem Zusammenhang die Frage:
 Hat jeder einzelne usb memory stick eine eindeutige Identität? 
 Oder anders, kann man einen usb stick, die Hardware, wieder erkennen? 
 
 Hintergrund ist die Aufgabe zu erkennen ob Daten als Kopie auf einem anderen 
 Medium als dem Original geliefert werden. 
 
 | 
 
 |  
t.roller 
        
 
Beiträge: 118 
Erhaltene Danke: 34 
 
 
 
 | 
Verfasst: So 18.09.16 12:22 
 
Kein Hersteller ist verpflichtet, eine Seriennummer oder UniqueId zu vergeben.
 
 Wenn man Glück hat, bekommt man beides: (Beispiel: 4GB-Stick, reale Daten gelöscht)
 
 AllocatedSize                       0
 BusType                             7
 CanPool                             False
 Description                         
 DeviceId                            1
 EnclosureNumber                     0
 FirmwareVersion                     2.00
 FriendlyName                        PhysicalDisk1
 HealthStatus                        0
 IsPartial                           True
 LogicalSectorSize                   512
 Manufacturer                        USB DISK
 MediaType                           0
 Model                               USB DISK        
 ObjectId                            {1}\\ASUS-NB\root/Microsoft/Windows/Storage/Providers_v2\SPACES_PhysicalDisk.ObjectId=
 "geloescht"
 PhysicalSectorSize                  512
 SerialNumber                        04191geloescht
 SpindleSpeed                        -1
 UniqueId                            USBSTOR\Disk&Ven_USB_DISK&Prod_USB_DISK&Rev_2.00\geloescht&0:ASUS-NB
 Usage                               1 
 
 | 
 
 |  
icho2099 
        
 
Beiträge: 101 
Erhaltene Danke: 12 
 
WIN XP, WIN 7, WIN 10 
Delphi 6 Prof, Delphi 2005, FPC 
 | 
Verfasst: Mo 19.09.16 06:40 
 
Ok, danke für die Antwort. 
 Demnach taugt das also nicht wirklich als Ersatz für einen Dongle. Wäre ja auch zu einfach gewesen. 
 
 | 
 
 |  
 
 
 |