unit comHelpHDD;
interface
uses
Windows, Classes, jwaWinIOCTL;
type
TParatitionInfoRecord =
record
DriveLetter : Char;
PartitionStyle : Byte;
PartitionLength : Int64;
PartitionNumber : DWORD;
StartingOffset : Int64;
end;
PVolumenInfoEntry = ^TVolumenInfoEntry;
TVolumenInfoEntry =
record
DriveLetter : Char;
FileSystemID : Byte;
FileSystem :
String;
VolumeName :
String;
FreeSpace : Int64;
VolumeSize : Int64;
end;
PVolumeInfoRecord = ^TVolumeInfoRecord;
TVolumeInfoRecord =
Array of TVolumenInfoEntry;
PDriveLayoutRecord = ^TDriveLayoutRecord;
TDriveLayoutRecord =
record
PartitionStyle : DWORD;
PartitionCount : DWORD;
Union :
record
case Integer
of
0: (Mbr: DRIVE_LAYOUT_INFORMATION_MBR);
1: (Gpt: DRIVE_LAYOUT_INFORMATION_GPT);
end;
PartitionEntry :
array [0..3]
of TParatitionInfoRecord;
end;
PDeviceIdentRecord = ^TDeviceIdentRecord;
TDeviceIdentRecord =
record
SerialNumber :
String;
FirmwareRev :
String;
ModelNumber :
String;
InterfaceType :
String;
end;
TSizeFormat = (sfMB, sfGB, sfTB);
PDeviceInfoRecord = ^TDeviceInfoRecord;
TDeviceInfoRecord =
record
DeviceID : Byte;
DeviceLength : Int64;
IdentRecord : TDeviceIdentRecord;
LayoutRecord : TDriveLayoutRecord;
InfoRecord : TVolumeInfoRecord;
end;
function SizeFormatStr(DeviceSize : Int64; GiBs : Boolean = true) :
String;
function LBASizeToGB(DeviceSize : Int64; GiBs : Boolean = true) : Integer;
function MeasureDeviceInfoRecord(aDeviceID : Byte) : PDeviceInfoRecord;
implementation
uses
SysUtils,
ActiveX, Variants, WbemScript;
type
TDriveInfoObject =
class(TObject)
private
FDriveLetter : Char;
FDeviceID : Byte;
FPartitionNumber : DWORD;
public
constructor Create(aDrive : Char; aDeviceID: Byte; aPartitionNumber : DWORD);
property DriveLetter : Char
read FDriveLetter;
property DeviceID : Byte
read FDeviceID;
property PartitionNumber : DWORD
read FPartitionNumber;
end;
{**************************** TDriveInfoObject *******************************}
constructor TDriveInfoObject.Create(aDrive : Char; aDeviceID: Byte; aPartitionNumber : DWORD);
begin
FDriveLetter := aDrive;
FDeviceID := aDeviceID;
FPartitionNumber := aPartitionNumber;
end;
{**************************** Helpers *****************************************}
function LBASizeToGB(DeviceSize : Int64; GiBs : Boolean = true) : Integer;
var
I, J : Integer;
begin
if GiBs
then J := 1000000000
else J := 1073741824;
if DeviceSize = 0
then I := 0
else
begin
I := Round(DeviceSize / J);
while (I <= 1)
do
begin
if GiBs
then J := J
div 1000
else J := J
div 1024;
I := Round(DeviceSize / J);
end;
end;
Result := I;
end;
function SizeFormatStr(DeviceSize : Int64; GiBs : Boolean = true) :
String;
var
J : Int64;
begin
if GiBs
then J := 1000000000
else J := 1073741824;
if DeviceSize < J
then Result := '
MB'
else
if DeviceSize > J
then
begin
if GiBs
then J := J * 1000
else J := J * 1024;
if DeviceSize >= J
then Result := '
TB'
else Result := '
GB';
end;
end;
function FindDeviceByDriveLetter(DeviceID : Byte; aDetails : Boolean) : TStringList;
var
I : Integer;
hVolume : THandle;
SDN : STORAGE_DEVICE_NUMBER;
lpBytesReturned : Cardinal;
begin
Result := TStringList.Create;
try
for I := Ord('
C')
to Ord('
Z')
do
begin
hVolume := CreateFile(PChar(Format('
\\.\%s:', [Char(I)])),
GENERIC_READ,
FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING, 0, 0);
if hVolume <> INVALID_HANDLE_VALUE
then
begin
if DeviceIOControl(hVolume,
IOCTL_STORAGE_GET_DEVICE_NUMBER,
nil,
0,
@SDN,
SizeOf(SDN),
lpBytesReturned,
nil)
then
if SDN.DeviceType = FILE_DEVICE_DISK
then
if DeviceID = SDN.DeviceNumber
then
if aDetails
then
Result.AddObject(IntToStr(SDN.PartitionNumber), TDriveInfoObject.Create(Char(I), SDN.DeviceNumber, SDN.PartitionNumber))
else
Result.Add(Char(I) + '
:\');
end;
end;
except
Result.Free;
end;
end;
function DeviceExists(aDeviceName :
String) : Boolean;
var
DeviceHandle : THandle;
{$IFDEF VER200}
DeviceName : PWideChar;
{$ELSE}
DeviceName : PChar;
{$ENDIF}
GLI : GET_LENGTH_INFORMATION;
lpBytesReturned : Cardinal;
begin
DeviceName := StrAlloc(MAX_PATH);
StrPCopy(DeviceName, aDeviceName);
DeviceHandle := CreateFile(DeviceName, GENERIC_READ, FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
StrDispose(DeviceName);
Result := DeviceHandle <> INVALID_HANDLE_VALUE;
if Result
then
begin
if DeviceIOControl(DeviceHandle, IOCTL_DISK_GET_LENGTH_INFO,
nil, 0, @GLI, SizeOf(GLI), lpBytesReturned,
nil)
then
Result := GLI.Length.QuadPart > 0
else
Result := false;
CloseHandle(DeviceHandle);
end;
end;
function DeviceSize(aDeviceName :
String) : UInt64;
var
DeviceHandle : THandle;
{$IFDEF VER200}
DeviceName : PWideChar;
{$ELSE}
DeviceName : PChar;
{$ENDIF}
GLI : GET_LENGTH_INFORMATION;
lpBytesReturned : Cardinal;
begin
Result := 0;
DeviceName := StrAlloc(MAX_PATH);
StrPCopy(DeviceName, aDeviceName);
DeviceHandle := CreateFile(DeviceName, GENERIC_READ, FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
StrDispose(DeviceName);
if DeviceHandle <> INVALID_HANDLE_VALUE
then
begin
if DeviceIOControl(DeviceHandle, IOCTL_DISK_GET_LENGTH_INFO,
nil, 0, @GLI, SizeOf(GLI), lpBytesReturned,
nil)
then
Result := GLI.Length.QuadPart;
CloseHandle(DeviceHandle);
end;
end;
function GetDevicePartitionInfo(aDeviceName :
String;
var LayoutRecord: TDriveLayoutRecord) : Boolean;
var
DeviceHandle : THandle;
{$IFDEF VER200}
DeviceName : PWideChar;
{$ELSE}
DeviceName : PChar;
{$ENDIF}
pDLIE : PDRIVE_LAYOUT_INFORMATION_EX;
dwSize : DWORD;
lpBytesReturned : Cardinal;
I : Integer;
begin
Result := False;
GetMem(DeviceName, MAX_PATH);
StrPCopy(DeviceName, aDeviceName);
DeviceHandle:= CreateFile(DeviceName,
GENERIC_READ,
// or GENERIC_WRITE,
FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0);
if DeviceHandle <> INVALID_HANDLE_VALUE
then
begin
try
dwSize := SizeOf(_DRIVE_LAYOUT_INFORMATION_EX) + SizeOf(_PARTITION_INFORMATION_EX) * 31;
GetMem(pDLIE, dwSize);
FillChar(pDLIE^, dwSize, 0);
Result := DeviceIOControl(DeviceHandle, IOCTL_DISK_GET_DRIVE_LAYOUT_EX,
nil, 0,
pDLIE, dwSize, lpBytesReturned,
nil);
if Result
then
begin
LayoutRecord.PartitionStyle := pDLIE^.PartitionStyle;
LayoutRecord.PartitionCount := 0;
// LayoutRecord.Union := pDLIE^.Union;
for I := 0
to pDLIE^.PartitionCount - 1
do
if pDLIE^.PartitionEntry[I].PartitionLength.QuadPart > 0
then
begin
LayoutRecord.PartitionEntry[I].PartitionStyle := DWORD(pDLIE^.PartitionEntry[I].PartitionStyle);
LayoutRecord.PartitionEntry[I].PartitionLength:= pDLIE^.PartitionEntry[I].PartitionLength.QuadPart;
LayoutRecord.PartitionEntry[I].PartitionNumber:= pDLIE^.PartitionEntry[I].PartitionNumber;
LayoutRecord.PartitionEntry[I].StartingOffset := pDLIE^.PartitionEntry[I].StartingOffset.QuadPart;
Inc(LayoutRecord.PartitionCount);
end;
end;
FreeMem(pDLIE);
finally
CloseHandle(DeviceHandle);
end;
end;
FreeMem(DeviceName);
end;
function GetWMIDeviceInfo(aID : Byte; aWQLStr :
String;
var Data) : Boolean;
var
wmiLocator : ISWbemLocator;
wmiServices : ISWbemServices;
wmiObjectSet : ISWbemObjectSet;
wmiObject : ISWbemObject;
propSet : ISWbemPropertySet;
wmiProp : ISWbemProperty;
propEnum,
Enum : IEnumVariant;
ovVar : OleVariant;
lwValue : LongWord;
sValue,
sName :
String;
i : integer;
begin
CoInitialize(
nil);
wmiLocator := CoSWbemLocator.Create;
try
wmiServices := wmiLocator.ConnectServer('
.', '
root\CIMV2', '
', '
','
', '
', 0,
nil);
try
if Assigned(wmiServices)
then
begin
wmiObjectSet := wmiServices.ExecQuery(aWQLStr, '
WQL', wbemFlagReturnWhenComplete,
nil);
if wmiObjectSet.Count > 0
then
begin
Enum := (wmiObjectSet._NewEnum)
as IEnumVariant;
if ((Enum <>
nil)
and (Enum.Next (1, ovVar, lwValue) = S_OK))
then
begin
wmiObject := IUnknown(ovVar)
as SWBemObject;
propSet := wmiObject.Properties_;
propEnum := (propSet._NewEnum)
as IEnumVariant;
while (propEnum.Next (1, ovVar, lwValue) = S_OK)
do
begin
wmiProp := IUnknown(ovVar)
as SWBemProperty;
sName := AnsiLowercase(wmiProp.
Name);
svalue := #0;
if VarIsNull(wmiProp.Get_Value)
then
sValue := #0
else
begin
case wmiProp.CIMType
of
wbemCimtypeSint8,
wbemCimtypeUint8,
wbemCimtypeSint16,
wbemCimtypeUint16,
wbemCimtypeSint32,
wbemCimtypeUint32,
wbemCimtypeSint64 :
if VarIsArray(wmiProp.Get_Value)
then
begin
for I := 0
to VarArrayHighBound(wmiProp.Get_Value, 1)
do
begin
if I > 0
then sValue := sValue + '
|' ;
sValue := sValue + IntToStr(wmiProp.Get_Value[I]) ;
end ;
end
else
sValue := IntToStr(wmiProp.Get_Value);
wbemCimtypeReal32,
wbemCimtypeReal64 : sValue := FloatToStr (wmiProp.Get_Value);
wbemCimtypeBoolean :
if wmiProp.Get_Value
then svalue := '
True'
else svalue := '
False';
wbemCimtypeString,
wbemCimtypeUint64 :
if VarIsArray(wmiProp.Get_Value)
then
begin
for I := 0
to VarArrayHighBound (wmiProp.Get_Value, 1)
do
begin
if I > 0
then svalue := svalue + '
|' ;
sValue := sValue + wmiProp.Get_Value [I] ;
end ;
end
else
sValue := wmiProp.Get_Value;
wbemCimtypeDatetime : sValue := wmiProp.Get_Value;
wbemCimtypeReference :
begin
sValue := wmiProp.Get_Value;
end;
end;
end;
case aID
of
0 :
begin
if sName = '
serialnumber'
then TDeviceIdentRecord(Data).SerialNumber := TrimLeft(TrimRight(sValue));
if sName = '
firmwarerevision'
then TDeviceIdentRecord(Data).FirmwareRev := TrimLeft(TrimRight(sValue));
if sName = '
model'
then TDeviceIdentRecord(Data).ModelNumber := TrimLeft(TrimRight(sValue));
if sName = '
interfacetype'
then TDeviceIdentRecord(Data).InterfaceType := TrimLeft(TrimRight(sValue));
end;
1 :
begin
if sName = '
volumename'
then TVolumenInfoEntry(Data).VolumeName := TrimLeft(TrimRight(sValue));
if sName = '
filesystem'
then
begin
TVolumenInfoEntry(Data).FileSystem := TrimLeft(TrimRight(sValue));
if TVolumenInfoEntry(Data).FileSystem = '
FAT'
then TVolumenInfoEntry(Data).FileSystemID := 1
else
if TVolumenInfoEntry(Data).FileSystem = '
FAT32'
then TVolumenInfoEntry(Data).FileSystemID := 2
else
if TVolumenInfoEntry(Data).FileSystem = '
NTFS'
then TVolumenInfoEntry(Data).FileSystemID := 3
else
if TVolumenInfoEntry(Data).FileSystem = '
exFAT'
then TVolumenInfoEntry(Data).FileSystemID := 4
else
begin
TVolumenInfoEntry(Data).FileSystemID := 4;
TVolumenInfoEntry(Data).FileSystem := '
UNKNOWN';
end;
end;
if sName = '
freespace'
then TVolumenInfoEntry(Data).FreeSpace := StrToInt64(TrimLeft(TrimRight(sValue)));
if sName = '
size'
then TVolumenInfoEntry(Data).VolumeSize := StrToInt64(TrimLeft(TrimRight(sValue)));
end;
end;
end;
end;
end;
end;
finally
end;
finally
wmiLocator :=
nil;
CoUninitialize;
case aID
of
0 :
with TDeviceIdentRecord(Data)
do Result := (SerialNumber <> '
')
or (FirmwareRev <> '
')
or (ModelNumber <> '
')
or (InterfaceType <> '
');
1 :
with TVolumenInfoEntry(Data)
do Result := (VolumeName <> '
')
or (FileSystem <> '
');
end;
end;
end;
function MeasureDeviceInfoRecord(aDeviceID : Byte) : PDeviceInfoRecord;
var
DN :
String;
DL : TStringList;
WqlStr:
String;
Data : TDeviceIdentRecord;
DLR : TDriveLayoutRecord;
VIR : TVolumeInfoRecord;
I, J : Integer;
begin
DN := Format('
\\.\PHYSICALDRIVE%d', [aDeviceID]);
Result := New(PDeviceInfoRecord);
with Result^
do
begin
DeviceID := aDeviceID;
if DeviceExists(DN)
then
begin
DeviceLength := DeviceSize(DN);
DL := FindDeviceByDriveLetter(DeviceID, true);
try
if GetDevicePartitionInfo(DN, DLR)
then
begin
SetLength(VIR, DLR.PartitionCount);
for I := 0
to DLR.PartitionCount -1
do
begin
J :=
DL.IndexOf(IntToStr(DLR.PartitionEntry[I].PartitionNumber));
if J > -1
then
begin
DLR.PartitionEntry[I].DriveLetter := TDriveInfoObject(
DL.Objects[J]).DriveLetter;
VIR[I].DriveLetter := DLR.PartitionEntry[I].DriveLetter;
end;
end;
LayoutRecord := DLR;
WqlStr := Format('
SELECT * FROM Win32_DiskDrive WHERE DeviceID = ''
\\\\.\\PHYSICALDRIVE%d''
',[aDeviceID]);
if GetWMIDeviceInfo(0, WqlStr, Data)
then IdentRecord := Data;
for I := 0
to Length(VIR) -1
do
if VIR[I].DriveLetter <> '
'
then
begin
WqlStr := Format('
SELECT DeviceID, FileSystem, FreeSpace, Size, VolumeName From win32_LogicalDisk WHERE DeviceID = ''
%s:''
', [VIR[I].DriveLetter]);
GetWMIDeviceInfo(1, WqlStr, VIR[I]);
end;
InfoRecord := VIR;
end;
finally
DL.Free;
end;
end;
end;
end;
end.