Subversion Repositories userdetect2

Rev

Rev 89 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. // http://stackoverflow.com/questions/5202270/in-delphi7-how-can-i-retrieve-hard-disk-unique-serial-number
  2.  
  3. unit hddinfo;
  4.  
  5. interface
  6.  
  7. function GetDriveSerial(const Drive: AnsiChar):string;
  8.  
  9. implementation
  10.  
  11. uses
  12.   SysUtils,
  13.   StrUtils,
  14.   ActiveX,
  15.   ComObj,
  16.   Variants;
  17.  
  18. // http://stackoverflow.com/questions/4292395/how-to-get-manufacturer-serial-number-of-an-usb-flash-drive
  19. // Modified
  20.  
  21. function VarArrayToStr(const vArray: variant): string;
  22.  
  23.     function _VarToStr(const V: variant): string;
  24.     var
  25.     Vt: integer;
  26.     begin
  27.     Vt := VarType(V);
  28.         case Vt of
  29.           varSmallint,
  30.           varInteger  : Result := IntToStr(integer(V));
  31.           varSingle,
  32.           varDouble,
  33.           varCurrency : Result := FloatToStr(Double(V));
  34.           varDate     : Result := VarToStr(V);
  35.           varOleStr   : Result := WideString(V);
  36.           varBoolean  : Result := VarToStr(V);
  37.           varVariant  : Result := VarToStr(Variant(V));
  38.           varByte     : Result := char(byte(V));
  39.           varString   : Result := String(V);
  40.           varArray    : Result := VarArrayToStr(Variant(V));
  41.         end;
  42.     end;
  43.  
  44. var
  45.   i : integer;
  46. begin
  47.     Result := '[';
  48.      if (VarType(vArray) and VarArray)=0 then
  49.        Result := _VarToStr(vArray)
  50.     else
  51.     for i := VarArrayLowBound(vArray, 1) to VarArrayHighBound(vArray, 1) do
  52.      if i=VarArrayLowBound(vArray, 1)  then
  53.       Result := Result+_VarToStr(vArray[i])
  54.      else
  55.       Result := Result+'|'+_VarToStr(vArray[i]);
  56.  
  57.     Result:=Result+']';
  58. end;
  59.  
  60. function VarStrNull(const V:OleVariant):string; //avoid problems with null strings
  61. begin
  62.   Result := '';
  63.   if not VarIsNull(V) then
  64.   begin
  65.     Result := VarToStr(V);
  66.   end;
  67. end;
  68.  
  69. function GetWMIObject(const objectName: String): IDispatch; //create the Wmi instance
  70. var
  71.   chEaten: Integer;
  72.   BindCtx: IBindCtx;
  73.   Moniker: IMoniker;
  74. begin
  75.   OleCheck(CreateBindCtx(0, bindCtx));
  76.   OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
  77.   OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
  78. end;
  79.  
  80. function GetDriveSerial(const Drive:AnsiChar):string;
  81. var
  82.   FSWbemLocator  : OleVariant;
  83.   objWMIService  : OLEVariant;
  84.   colDiskDrives  : OLEVariant;
  85.   colLogicalDisks: OLEVariant;
  86.   colPartitions  : OLEVariant;
  87.   objDiskDrive   : OLEVariant;
  88.   objPartition   : OLEVariant;
  89.   objLogicalDisk : OLEVariant;
  90.   oEnumDiskDrive : IEnumvariant;
  91.   oEnumPartition : IEnumvariant;
  92.   oEnumLogical   : IEnumvariant;
  93.   iValue         : LongWord;
  94.   DeviceID       : string;
  95. begin;
  96.   Result:='';
  97.   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  98.   objWMIService := FSWbemLocator.ConnectServer('.', 'root\CIMV2', '', '');
  99.   colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive','WQL',0);
  100.   oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;
  101.   while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do
  102.   begin
  103.      DeviceID        := StringReplace(VarStrNull(objDiskDrive.DeviceID),'\','\\',[rfReplaceAll]); //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.
  104.      colPartitions   := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[DeviceID]));//link the Win32_DiskDrive class with the Win32_DiskDriveToDiskPartition class
  105.      oEnumPartition  := IUnknown(colPartitions._NewEnum) as IEnumVariant;
  106.       while oEnumPartition.Next(1, objPartition, iValue) = 0 do
  107.        begin
  108.         colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+VarStrNull(objPartition.DeviceID)+'"} WHERE AssocClass = Win32_LogicalDiskToPartition'); //link the Win32_DiskPartition class with theWin32_LogicalDiskToPartition class.
  109.         oEnumLogical  := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;
  110.           while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
  111.           begin
  112.             if  SameText(VarStrNull(objLogicalDisk.DeviceID),Drive+':')  then //compare the device id
  113.             begin
  114.               Result := objDiskDrive.SerialNumber;
  115.               if Result <> '' then exit;
  116.  
  117.               // Some drivers of the USB disks does not expose the manufacturer serial number on the Win32_DiskDrive.SerialNumber property, so on this cases we can extract the serial number from the PnPDeviceID property.
  118.               Result:=VarStrNull(objDiskDrive.PnPDeviceID);
  119.               if AnsiStartsText('USBSTOR', Result) then
  120.               begin
  121.                iValue:=LastDelimiter('\', Result);
  122.                 Result:=Copy(Result, iValue+1, Length(Result));
  123.               end;
  124.               objLogicalDisk:=Unassigned;
  125.               Exit;
  126.             end;
  127.             objLogicalDisk:=Unassigned;
  128.           end;
  129.           objPartition:=Unassigned;
  130.        end;
  131.        objDiskDrive:=Unassigned;
  132.   end;
  133. end;
  134.  
  135. initialization
  136.   CoInitialize(nil);
  137. finalization
  138.   CoUninitialize;
  139. end.
  140.