Changeset 21 for trunk/UPhysDrive.pas

Timestamp:

Apr 2, 2016, 11:12:47 PM (9 years ago)

Author:

chronos

Message:

• Added: Suport for physical drive enumeration under Windows.

Location:

trunk

Files:

• . (modified) (1 prop)
• UPhysDrive.pas (modified) (4 diffs)

trunk

@@ -2 +2 @@
 lib
 CoolDisk.lps
+CoolDisk.exe

@@ -2 +2 @@
 lib
 CoolDisk.lps
+CoolDisk.exe

trunk/UPhysDrive.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs, UFindFile, UCommon;
+  Classes, SysUtils, Contnrs, UFindFile, UCommon
+  {$IFDEF Windows},ActiveX,ComObj,Variants
+  {$ENDIF};
 
 type
@@ -29 +31 @@
     procedure LoadToStrings(Strings: TStrings);
     procedure Detect;
+  private
+    {$IFDEF Windows}
+    procedure GetWin32DiskDriveInfo;
+    {$ENDIF}
   end;
 
@@ -109 +115 @@
   end;
   {$ENDIF}
+  {$IFDEF Windows}
+  GetWin32DiskDriveInfo;
+  {$ENDIF}
   // Drive located using filename
   NewDriveInfo := TDriveInfo.Create;
@@ -120 +129 @@
 end;
 
+{$IFDEF Windows}
+procedure TDriveList.GetWin32DiskDriveInfo;
+const
+  WbemUser = '';
+  WbemPassword = '';
+  WbemComputer = 'localhost';
+  wbemFlagForwardOnly = $00000020;
+var
+  FSWbemLocator: OLEVariant;
+  FWMIService: OLEVariant;
+  FWbemObjectSet: OLEVariant;
+  FWbemObject: OLEVariant;
+  oEnum: IEnumvariant;
+  OutVar: LongWord;
+  NewDriveInfo: TDriveInfo;
+begin;
+  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, OutVar) = 0 do begin
+    NewDriveInfo := TDriveInfo.Create;
+    NewDriveInfo.Kind := dkPhysical;
+    NewDriveInfo.Model := FWbemObject.Properties_.Item('Caption').Value;
+    //NewDriveInfo.Model := FWbemObject.Properties_.Item('Model').Value;
+    NewDriveInfo.Size := FWbemObject.Properties_.Item('Size').Value;
+    NewDriveInfo.SectorSize := 4096;
+    NewDriveInfo.SectorCount := NewDriveInfo.Size div NewDriveInfo.SectorSize;
+    NewDriveInfo.Path := FWbemObject.Properties_.Item('DeviceID').Value;
+    Add(NewDriveInfo);
+
+    FWbemObject := Unassigned;
+  end;
+end;
+{$ENDIF}
+
+
 end.
 

@@ -2 +2 @@
 lib
 CoolDisk.lps
+CoolDisk.exe