Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Номолос ©   (2003-07-26 09:16:00) 

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

Alex Konshin   (2003-07-29 04:31:00) [1]

Я же тебе ответил.
Можешь посмотреть мой пример 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 с моего сайта.

Номолос   (2003-07-28 21:03:00) [2]

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

Spawn   (2003-07-26 13:34:00) [3]

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

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

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

Spawn   (2003-07-26 12:14:00) [5]

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 11:39:00) [6]

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

Alex Konshin   (2003-07-26 10:10:00) [7]

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

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

Наверх

Титульная страница Поиск, карта сайта Написать письмо