unit uDevice;
interface
uses
Classes, Windows, jwaWindows;
type
TDeviceRec =
record
DeviceNr : DWORD;
DeviceStr :
String;
DriveStr :
String;
PartitionStr :
String;
PartitionNr : DWORD;
DeviceTyp : DEVICE_TYPE;
DiskGeometry : DISK_GEOMETRY;
PartitionData : PARTITION_INFORMATION;
end;
TDynDeviceRec =
record
DeviceNr : DWORD;
DeviceStr :
String;
DiskGeometry : DISK_GEOMETRY;
PartitionData :
Array of PARTITION_INFORMATION;
MediaTypeStr :
String;
end;
TDeviceRecList =
Array of TDeviceRec;
TDynDeviceRecList =
Array of TDynDeviceRec;
function GetAllLogicalDevices(
var aDeviceRecList : TDeviceRecList) : Boolean;
function GetAllPhysicalDevices(
var aDynDeviceRecList : TDynDeviceRecList) : Boolean;
implementation
uses SysUtils;
function MediaTypeToStr(aMediaType : MEDIA_TYPE) :
String;
begin
case aMediatype
of
F5_1Pt2_512 : Result := '
5.25" floppy, with 1.2MB and 512 bytes/sector';
F3_1Pt44_512 : Result := '
3.5" floppy, with 1.44MB and 512 bytes/sector';
F3_2Pt88_512 : Result := '
3.5" floppy, with 2.88MB and 512 bytes/sector';
F3_20Pt8_512 : Result := '
3.5" floppy, with 20MB and 512 bytes/sector';
F3_720_512 : Result := '
3.5" floppy, with 720KB and 512 bytes/sector';
F5_360_512 : Result := '
5.25" floppy, with 360KB and 512 bytes/sector';
F5_320_512 : Result := '
5.25" floppy, with 320KB and 512 bytes/sector';
F5_320_1024 : Result := '
5.25" floppy, with 360KB and 1024 bytes/sector';
F5_180_512 : Result := '
5.25" floppy, with 180KB and 512 bytes/sector';
F5_160_512 : Result := '
5.25" floppy, with 160KB and 512 bytes/sector';
RemovableMedia : Result := '
Removable media other than floppy';
FixedMedia : Result := '
Fixed hard disk media';
F3_120M_512 : Result := '
3.5" floppy, with 120MB and 512 bytes/sector';
F3_640_512 : Result := '
3.5" floppy, with 640MB and 512 bytes/sector';
F5_640_512 : Result := '
5.25" floppy, with 640KB and 512 bytes/sector';
F5_720_512 : Result := '
5.25" floppy, with 720KB and 512 bytes/sector';
F3_1Pt2_512 : Result := '
3.5" floppy, with 1.2MB and 512 bytes/sector';
F3_1Pt23_1024 : Result := '
3.5" floppy, with 1.23MB and 1024 bytes/sector';
F5_1Pt23_1024 : Result := '
5.25" floppy, with 1.23KB and 1024 bytes/sector';
F3_128Mb_512 : Result := '
3.5" floppy, with 128MB and 512 bytes/sector';
F3_230Mb_512 : Result := '
3.5" floppy, with 230MB and 512 bytes/sector';
F8_256_128 : Result := '
8" floppy, with 256KB and 128 bytes/sector';
F3_200Mb_512 : Result := '
3.5" floppy, with 200MB and 512 bytes/sector. (HiFD)';
F3_240M_512 : Result := '
3.5" floppy, with 240MB and 512 bytes/sector. (HiFD)';
F3_32M_512 : Result := '
3.5" floppy, with 32MB and 512 bytes/sector';
else Result := '
UNKNOWN';
// besser hier, falls mal was Unbekantes/Fehlerhaftes reinkommt
end;
end;
function DeviceTypeToStr(aDeviceType : DEVICE_TYPE):
String;
begin
case aDeviceType
of
FILE_DEVICE_BEEP : Result :='
BEEP';
FILE_DEVICE_CD_ROM : Result :='
CD-ROM';
FILE_DEVICE_CD_ROM_FILE_SYSTEM : Result :='
CD-ROM FILE-SYSTEM';
FILE_DEVICE_CONTROLLER : Result :='
CONTROLLER';
FILE_DEVICE_DATALINK : Result :='
DATALINK';
FILE_DEVICE_DFS : Result :='
DFS';
FILE_DEVICE_DISK : Result :='
DISK';
FILE_DEVICE_DISK_FILE_SYSTEM : Result :='
DISK FILE-SYSTEM';
FILE_DEVICE_FILE_SYSTEM : Result :='
FILE-SYSTEM';
FILE_DEVICE_INPORT_PORT : Result :='
INPORT-PORT';
FILE_DEVICE_KEYBOARD : Result :='
KEYBOARD';
FILE_DEVICE_MAILSLOT : Result :='
MAILSLOT';
FILE_DEVICE_MIDI_IN : Result :='
MIDI_IN';
FILE_DEVICE_MIDI_OUT : Result :='
MIDI_OUT';
FILE_DEVICE_MOUSE : Result :='
MOUSE';
FILE_DEVICE_MULTI_UNC_PROVIDER : Result :='
MULTI UNC-PROVIDER';
FILE_DEVICE_NAMED_PIPE : Result :='
NAMED-PIPE';
FILE_DEVICE_NETWORK : Result :='
NETWORK';
FILE_DEVICE_NETWORK_BROWSER : Result :='
NETWORK-BROWSER';
FILE_DEVICE_NETWORK_FILE_SYSTEM : Result :='
NETWORK FILE-SYSTEM';
FILE_DEVICE_NULL : Result :='
NULL';
FILE_DEVICE_PARALLEL_PORT : Result :='
PARALLEL-PORT';
FILE_DEVICE_PHYSICAL_NETCARD : Result :='
PHYSICAL-NETCARD';
FILE_DEVICE_PRINTER : Result :='
PRINTER';
FILE_DEVICE_SCANNER : Result :='
SCANNER';
FILE_DEVICE_SERIAL_MOUSE_PORT : Result :='
SERIAL MOUSE-PORT';
FILE_DEVICE_SERIAL_PORT : Result :='
SERIAL-PORT';
FILE_DEVICE_SCREEN : Result :='
SCREEN';
FILE_DEVICE_SOUND : Result :='
SOUND';
FILE_DEVICE_STREAMS : Result :='
STREAMS';
FILE_DEVICE_TAPE : Result :='
TAPE';
FILE_DEVICE_TAPE_FILE_SYSTEM : Result :='
TAPE FILE-SYSTEM';
FILE_DEVICE_TRANSPORT : Result :='
TRANSPORT';
FILE_DEVICE_UNKNOWN : Result :='
UNKNOWN';
FILE_DEVICE_VIDEO : Result :='
VIDEO';
FILE_DEVICE_VIRTUAL_DISK : Result :='
VIRTUAL-DISK';
FILE_DEVICE_WAVE_IN : Result :='
WAVE_IN';
FILE_DEVICE_WAVE_OUT : Result :='
WAVE_OUT';
FILE_DEVICE_8042_PORT : Result :='
8042-PORT';
FILE_DEVICE_NETWORK_REDIRECTOR : Result :='
NETWORK-REDIRECTOR';
FILE_DEVICE_BATTERY : Result :='
BATTERY';
FILE_DEVICE_BUS_EXTENDER : Result :='
BZS EXTENDER';
FILE_DEVICE_MODEM : Result :='
MODEM';
FILE_DEVICE_VDM : Result :='
VDM';
FILE_DEVICE_MASS_STORAGE : Result :='
MASS-STORAGE';
FILE_DEVICE_SMB : Result :='
SMB';
FILE_DEVICE_KS : Result :='
KS';
FILE_DEVICE_CHANGER : Result :='
CHANGER';
FILE_DEVICE_SMARTCARD : Result :='
SMARTCARD';
FILE_DEVICE_ACPI : Result :='
ACPI';
FILE_DEVICE_DVD : Result :='
DVD';
FILE_DEVICE_FULLSCREEN_VIDEO : Result :='
FULLSCREEN VIDEO';
FILE_DEVICE_DFS_FILE_SYSTEM : Result :='
DFS FILE-SYSTEM';
FILE_DEVICE_DFS_VOLUME : Result :='
DFS-VOLUME';
FILE_DEVICE_SERENUM : Result :='
SERENUM';
FILE_DEVICE_TERMSRV : Result :='
TERMINAL-SERVER';
FILE_DEVICE_KSEC : Result :='
KSEC';
FILE_DEVICE_FIPS : Result :='
FIPS';
FILE_DEVICE_INFINIBAND : Result :='
INFINIBAND';
else Result := IntToStr(aDeviceType);
end;
end;
function DeviceExists(aDeviceNumber : DWORD) : Boolean;
var
hVolume : THandle;
begin
hVolume := CreateFile(PChar(Format('
\\.\PHYSICALDRIVE%d', [aDeviceNumber])),
GENERIC_READ, FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
CloseHandle(hVolume);
Result := hVolume <> INVALID_HANDLE_VALUE;
end;
function GetDeviceNumber(aDriveLetter : PChar;
var aDeviceRec : TDeviceRec) : Boolean;
overload;
var
hVolume : THandle;
SDN : STORAGE_DEVICE_NUMBER;
DG : DISK_GEOMETRY;
pDLI : PDRIVE_LAYOUT_INFORMATION;
lpBytesReturned : DWORD;
begin
hVolume := CreateFile(PChar(Format('
\\.\%s:', [aDriveLetter])),
GENERIC_READ, FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
Result := hVolume <> INVALID_HANDLE_VALUE;
if Result
then
try
if DeviceIOControl(hVolume, IOCTL_STORAGE_GET_DEVICE_NUMBER,
nil, 0,
@SDN, SizeOf(SDN), @lpBytesReturned,
nil)
then
with aDeviceRec
do
begin
DeviceNr := SDN.DeviceNumber;
PartitionNr := SDN.PartitionNumber;
DeviceTyp := SDN.DeviceType;
DriveStr := Format('
%s:\', [aDriveLetter]);
case SDN.DeviceType
of
FILE_DEVICE_DISK : DeviceStr := Format('
\\.\PHYSICALDRIVE%d', [DeviceNr]);
else DeviceStr := Format('
DEVICE: %s ', [DeviceTypeToStr(DeviceTyp)]);
end;
PartitionStr := Format('
Partition%d', [PartitionNr]);
// Wenn schon WITH, warum dann nicht auch DiskGeometry und PartitionData darüber setzen? :D
// Wobei ich hier eigentlich lieber ganz auf WITH verzichten würde.
if DeviceIOControl(hVolume, IOCTL_DISK_GET_DRIVE_GEOMETRY,
nil, 0,
@DG, SizeOf(DG), @lpBytesReturned,
nil)
then
DiskGeometry := DG;
GetMem(pDLI, SizeOf(DRIVE_LAYOUT_INFORMATION) + 15 * SizeOf(PARTITION_INFORMATION));
try
if DeviceIOControl(hVolume, IOCTL_DISK_GET_DRIVE_LAYOUT,
nil, 0,
pDLI, dliSize, @lpBytesReturned,
nil)
then
PartitionData := pDLI^.PartitionEntry[aDeviceRec.PartitionNr-1];
finally
FreeMem(pDLI);
end;
end;
finally
CloseHandle(hVolume);
end;
end;
function GetDeviceNumber(aPhysicalDrive : Byte;
var aDynDeviceRec : TDynDeviceRec) : Boolean;
overload;
var
hVolume : THandle;
DG : DISK_GEOMETRY;
pDLI : PDRIVE_LAYOUT_INFORMATION;
lpBytesReturned : DWORD;
I, piCount,
begin
Result := false;
hVolume := CreateFile(PChar(Format('
\\.\PHYSICALDRIVE%d', [aPhysicalDrive])), GENERIC_READ,
FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
if hVolume <> INVALID_HANDLE_VALUE
then
try
aDynDeviceRec.DeviceNr := aPhysicalDrive;
aDynDeviceRec.DeviceStr:= pVolume;
if DeviceIOControl(hVolume, IOCTL_DISK_GET_DRIVE_GEOMETRY,
nil, 0,
@DG, SizeOf(DG), @lpBytesReturned,
nil)
then
begin
aDynDeviceRec.DiskGeometry := DG;
aDynDeviceRec.MediaTypeStr := MediaTypeToStr(DG.MediaType);
end;
GetMem(pDLI, SizeOf(DRIVE_LAYOUT_INFORMATION) + 15 * SizeOf(PARTITION_INFORMATION));
try
if DeviceIOControl(hVolume, IOCTL_DISK_GET_DRIVE_LAYOUT,
nil, 0,
pDLI, dliSize, @lpBytesReturned,
nil)
then
begin
piCount := 0;
for I := 0
to pDLI^.PartitionCount - 1
do
begin
if pDLI^.PartitionEntry[I].StartingOffset.LowPart = 0
then Break;
Inc(piCount);
end;
SetLength(aDynDeviceRec.PartitionData, piCount);
for I := 0
to piCount-1
do
aDynDeviceRec.PartitionData[I] := pDLI^.PartitionEntry[I];
Result := true;
end;
finally
FreeMem(pDLI, dliSize);
end;
finally
CloseHandle(hVolume);
end;
end;
function GetAllLogicalDevices(
var aDeviceRecList : TDeviceRecList) : Boolean;
var
drives : DWORD;
letter : Char;
SL : TStringList;
begin
Result := false;
SL := TStringList.Create;
try
for letter := '
C'
to '
Z'
do
case GetDriveType(PChar(letter + '
:\'))
of
DRIVE_REMOVABLE : SL.Add(letter);
DRIVE_FIXED : SL.Add(Letter);
end;
Result := SL.Count > 0;
if Result
then
begin
SetLength(aDeviceRecList, SL.Count-1);
for drives := 0
to SL.Count - 1
do
GetDeviceNumber(PChar(SL.Strings[drives]), aDeviceRecList[drives]);
end;
finally
SL.Free;
end;
end;
function GetAllPhysicalDevices(
var aDynDeviceRecList : TDynDeviceRecList) : Boolean;
var
I, J, C : Byte;
DR : TDynDeviceRec;
begin
C := 0;
SetLength(aDynDeviceRecList, HIGH(Byte));
for I := 0
to HIGH(BYTE)
do
if DeviceExists(I)
then
begin
if GetDeviceNumber(I, DR)
then
begin
with aDynDeviceRecList[C]
do // hier sollte wohl C hin und nicht I
begin
DeviceNr := DR.DeviceNr;
DeviceStr := DR.DeviceStr;
DiskGeometry := DR.DiskGeometry;
MediaTypeStr := DR.MediaTypeStr;
SetLength(PartitionData, Length(DR.PartitionData));
for J := 0
to Length(DR.PartitionData) - 1
do
PartitionData[J] := DR.PartitionData[J];
end;
Inc(C);
end;
end;
// else Break; // nein, sobald was fehlt, heißt es nicht, daß nichts mehr kommt.
// schließe mal zwei USB-Sicks o.Ä. an und entferne dann den zuerst angesteckten wieder.
// die Drive-Numbers werden nicht neu vergeben und demnach würdest du dann den 2. Stick übersehn
SetLength(aDynDeviceRecList, C);
Result := Length(aDynDeviceRecList) > 0;
end;
end.