Subversion Repositories userdetect2

Rev

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

Rev Author Line No. Line
89 daniel-mar 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 
 
95 daniel-mar 7 
function GetDriveSerial(const Drive: AnsiChar):string;
89 daniel-mar 8 
 
9 
implementation
10 
 
11 
uses
12 
  SysUtils,
95 daniel-mar 13 
  StrUtils,
89 daniel-mar 14 
  ActiveX,
15 
  ComObj,
16 
  Variants;
17 
 
95 daniel-mar 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 
 
89 daniel-mar 44 
var
95 daniel-mar 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;
89 daniel-mar 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');
95 daniel-mar 98 
  objWMIService := FSWbemLocator.ConnectServer('.', 'root\CIMV2', '', '');
89 daniel-mar 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
95 daniel-mar 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.
89 daniel-mar 109 
        oEnumLogical  := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;
110 
          while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
111 
          begin
95 daniel-mar 112 
            if  SameText(VarStrNull(objLogicalDisk.DeviceID),Drive+':')  then //compare the device id
89 daniel-mar 113 
            begin
95 daniel-mar 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;
89 daniel-mar 126 
            end;
95 daniel-mar 127 
            objLogicalDisk:=Unassigned;
89 daniel-mar 128 
          end;
95 daniel-mar 129 
          objPartition:=Unassigned;
130 
       end;
131 
       objDiskDrive:=Unassigned;
89 daniel-mar 132 
  end;
133 
end;
134 
 
95 daniel-mar 135 
initialization
136 
  CoInitialize(nil);
137 
finalization
138 
  CoUninitialize;
89 daniel-mar 139 
end.