Форум: "Система";
Текущий архив: 2003.10.13;
Скачать: [xml.tar.bz2];

Вниз

Как получить список всех носителей информаци?   Найти похожие ветки 

← →
Номолос   (2003-07-26 09:16) [0]

Я хотел бы получить лист а) физических б) логических дисков (Floppy,
HDD и пр.). Как это можно сделать?

---

← →
Alex Konshin   (2003-07-26 10:10) [1]

Что ты хочешь увидеть в этом списке?

Возьми утилиту winobj с сайта www.sysinternals.com и посмотри, что можно достать. Если тебе это подходит, то могу научить, как это сделать.

---

← →
ZZ   (2003-07-26 11:39) [2]

Поиск по сайту->искать в кладовке->DeviceIoControl
Скачать и посмотреть...

---

← →
Spawn   (2003-07-26 12:14) [3]

5-ти минутное дело. Главное иметь хелп под рукой.

procedure TForm1.Button1Click(Sender: TObject);
var
Buf:PAnsiChar;
i, counter:integer;
begin
try
Counter:=0;
GetMem(Buf,128);
GetLogicalDriveStrings(128,Buf);
for i:=0 to 127 do
if Buf[i]=#0 then
begin
Inc(Counter);
if Counter=2 then Exit;
case GetDriveType(PAnsiChar(@Buf[i-3])) of
0:ShowMessage(PAnsiChar(@Buf[i-3])+" The drive type cannot be determined");
DRIVE_REMOVABLE:ShowMessage(PAnsiChar(@Buf[i-3])+" - Removable drive");
DRIVE_FIXED:ShowMessage(PAnsiChar(@Buf[i-3])+" - Fixed drive");
DRIVE_REMOTE:ShowMessage(PAnsiChar(@Buf[i-3])+" - Drive remote");
DRIVE_CDROM:ShowMessage(PAnsiChar(@Buf[i-3])+" - CD-ROM");
DRIVE_RAMDISK:ShowMessage(PAnsiChar(@Buf[i-3])+" - RAM Disk");
end;
end
else
( Buf) 5-ти минутное дело. Главное иметь хелп под рукой.

procedure TForm1.Button1Click(Sender: TObject);
var
Buf:PAnsiChar;
i, counter:integer;
begin
try
Counter:=0;
GetMem(Buf,128);
GetLogicalDriveStrings(128,Buf);
for i:=0 to 127 do
if Buf[i]=#0 then
begin
Inc(Counter);
if Counter=2 then Exit;
case GetDriveType(PAnsiChar(@Buf[i-3])) of
0:ShowMessage(PAnsiChar(@Buf[i-3])+" The drive type cannot be determined");
DRIVE_REMOVABLE:ShowMessage(PAnsiChar(@Buf[i-3])+" - Removable drive");
DRIVE_FIXED:ShowMessage(PAnsiChar(@Buf[i-3])+" - Fixed drive");
DRIVE_REMOTE:ShowMessage(PAnsiChar(@Buf[i-3])+" - Drive remote");
DRIVE_CDROM:ShowMessage(PAnsiChar(@Buf[i-3])+" - CD-ROM");
DRIVE_RAMDISK:ShowMessage(PAnsiChar(@Buf[i-3])+" - RAM Disk");
end;
end
else
Counter:=0;
finally
FreeMem(Buf);
end;
end;



---

← →
ZZ   (2003-07-26 13:11) [4]

Spawn
Будет хорошо если ты скажешь что это такое мыы получим :)

---

← →
Spawn   (2003-07-26 13:34) [5]

Список логических дисков.

---

← →
Номолос   (2003-07-28 21:03) [6]

Огромное спасибо за логические диски, но может кто-то знает что-нибудь и про физические? Я вот о них узнал из програмки Hex Workshop 4.1 ( http://www.softportal.pp.ru/freesoftware/177/). Если не в лом качать почти 3 мега, то можете тоже глянуть.

---

← →
Alex Konshin   (2003-07-29 04:31) [7]

Я же тебе ответил.
Можешь посмотреть мой пример http://home.earthlink.net/~akonshin/files/HDDInfo.zip
Или что-то в таком духе:


uses
Windows, SysUtils, ntdll;

//-------------------------------------------------------------
function EnumNt5IdeDeviceCallBack( pusObjectName : PNtUnicodeString; ObjectTypeName : String; DirectoryHandle : THandle; UserData : Pointer ) : Boolean;
const
sDevicePeffix : PChar = "IdeDevice";
lenDevicePrefix = 9;
var sObjectName : String;
hDevice : THandle;
begin
Result := True;
if CompareText(ObjectTypeName,"Device")<>0 then Exit;
sObjectName := NtUnicodeStringToString(pusObjectName);
if StrLComp(PChar(sObjectName),sDevicePeffix,lenDevicePrefix)<>0 then Exit;
hDevice := OpenObject(pusObjectName,DirectoryHandle,GENERIC_READ or GENERIC_WRITE);
if hDevice=INVALID_HANDLE_VALUE then
begin
WriteLn("NtOpenObject failed for ",sObjectName);
WriteLn(SysErrorMessage(GetLastError));
Exit;
end;
try

// Do something ...


finally
CloseHandle(hDevice);
end;
end;
//-------------------------------------------------------------
function EnumNt5ScsiDeviceCallBack( pusObjectName : PNtUnicodeString; ObjectTypeName : String; DirectoryHandle : THandle; UserData : Pointer ) : Boolean;
const
sPort = "Port";
sLun = "Lun";
var sObjectName : String;
hDevice : THandle;
begin
Result := True;
if CompareText(ObjectTypeName,"Device")<>0 then Exit;
sObjectName := NtUnicodeStringToString(pusObjectName);
if (Pos(sPort,sObjectName)=0)or(Pos(sLun,sObjectName)=0) then Exit;
hDevice := OpenObject(pusObjectName,DirectoryHandle,GENERIC_READ or GENERIC_WRITE);
if hDevice=INVALID_HANDLE_VALUE then
begin
WriteLn("NtOpenObject failed for ",sObjectName);
WriteLn(SysErrorMessage(GetLastError));
Exit;
end;
try

// Do something ...


finally
CloseHandle(hDevice);
end;
end;

var i : Integer;
rc, dwSize : DWORD;

//=============================================================
begin

try

EnumNtObjects( "\Device\Ide", EnumNt5IdeDeviceCallBack, nil );
EnumNtObjects( "\Device\Scsi", EnumNt5ScsiDeviceCallBack, nil );

except
on E:Exception do
begin
( E.ClassName+": "+E.Message) Я же тебе ответил.
Можешь посмотреть мой пример http://home.earthlink.net/~akonshin/files/HDDInfo.zip
Или что-то в таком духе:


uses
Windows, SysUtils, ntdll;

//-------------------------------------------------------------
function EnumNt5IdeDeviceCallBack( pusObjectName : PNtUnicodeString; ObjectTypeName : String; DirectoryHandle : THandle; UserData : Pointer ) : Boolean;
const
sDevicePeffix : PChar = "IdeDevice";
lenDevicePrefix = 9;
var sObjectName : String;
hDevice : THandle;
begin
Result := True;
if CompareText(ObjectTypeName,"Device")<>0 then Exit;
sObjectName := NtUnicodeStringToString(pusObjectName);
if StrLComp(PChar(sObjectName),sDevicePeffix,lenDevicePrefix)<>0 then Exit;
hDevice := OpenObject(pusObjectName,DirectoryHandle,GENERIC_READ or GENERIC_WRITE);
if hDevice=INVALID_HANDLE_VALUE then
begin
WriteLn("NtOpenObject failed for ",sObjectName);
WriteLn(SysErrorMessage(GetLastError));
Exit;
end;
try

// Do something ...


finally
CloseHandle(hDevice);
end;
end;
//-------------------------------------------------------------
function EnumNt5ScsiDeviceCallBack( pusObjectName : PNtUnicodeString; ObjectTypeName : String; DirectoryHandle : THandle; UserData : Pointer ) : Boolean;
const
sPort = "Port";
sLun = "Lun";
var sObjectName : String;
hDevice : THandle;
begin
Result := True;
if CompareText(ObjectTypeName,"Device")<>0 then Exit;
sObjectName := NtUnicodeStringToString(pusObjectName);
if (Pos(sPort,sObjectName)=0)or(Pos(sLun,sObjectName)=0) then Exit;
hDevice := OpenObject(pusObjectName,DirectoryHandle,GENERIC_READ or GENERIC_WRITE);
if hDevice=INVALID_HANDLE_VALUE then
begin
WriteLn("NtOpenObject failed for ",sObjectName);
WriteLn(SysErrorMessage(GetLastError));
Exit;
end;
try

// Do something ...


finally
CloseHandle(hDevice);
end;
end;

var i : Integer;
rc, dwSize : DWORD;

//=============================================================
begin

try

EnumNtObjects( "\Device\Ide", EnumNt5IdeDeviceCallBack, nil );
EnumNtObjects( "\Device\Scsi", EnumNt5ScsiDeviceCallBack, nil );

except
on E:Exception do
begin
WriteLn(E.ClassName+": "+E.Message);
Exit;
end;
end;

end.


Упоминаемый юнит ntdll можно взять из примера NativeApp с моего сайта.

---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2003.10.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.01 c