Свойство диска

Belanserg · #1 12.07.2014, 14:33

Как открыть окно свойства диска (например диска C:\) из delphi7?

Alegun · #2 13.07.2014, 01:52

Проверено под W7 на D7

Код:

uses
 ShellAPI;
procedure ShowDiskProperties( Path: string );
var
 SEInfo: SHELLEXECUTEINFO;
begin
 FillChar( SEInfo, SizeOf( SEInfo ), 0 );
 SEInfo.cbSize := SizeOf( SHELLEXECUTEINFO );
 with SEInfo do
  begin
   fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
   Wnd := Application.Handle;
   lpFile := PChar( Path );
   lpVerb := 'Properties';
   lpParameters := '';
   hInstApp := 0;
   lpIDList := nil;
   lpDirectory := PChar( Path );
   nShow := SW_SHOWNORMAL;
   end;
 ShellExecuteEx( @SEInfo );
end;

Пример вызова

Код:

...
ShowDiskProperties( 'c:' );
...

MotoArhangel · #3 13.07.2014, 04:53

Код:

{>> Получение сведений о диске (метка/имя диска, файловая система, серийный номер)  
    
Получение информации о любом диске.  
Работает на FDD, HDD, CD, другие не пробовал.  
    
Создайте модуль с именем HDDInfo и полностью скопируйте в него весь текст.  
    
Copyright: Собственное написание (Осипов Евгений Анатольевич)   
***************************************************** } 
     
unit HDDInfo;   
     
interface 
     
Uses Windows;   
     
Const {Константы для TypeOfDisk функции GetDisks} 
DiskUnknown=0; {Неизвестные диски} 
DiskNone=1; {Отсутствующие диски} 
DiskFDD=DRIVE_REMOVABLE; {Съёмные диски, дискеты} 
DiskHDD=DRIVE_FIXED; {Не съёиные диски, жёсткие диски} 
DiskNet=DRIVE_REMOTE; {Сетевые диски} 
DiskCDROM=DRIVE_CDROM; {CD ROM} 
DiskRAM=DRIVE_RAMDISK; {Диски в ОЗУ} 
     
{Получить имена нужных дисков} 
function GetDisks(TypeOfDisk : Word) : String;   
     
{Функция получения информации о диске (HDD,FDD,CD) с буквой Disk} 
{  
Передаваемые значения:  
Disk - Буква диска  
    
Получаемые значения:  
VolumeName - Метка/Имя тома  
FileSystemName - Файловая система  
VolumeSerialNo - Серийный номер диска (можно привязывать к диску программы)  
MaxComponentLength - Максимальная длинна имени файла  
FileSystemFlags - Флаги смотрите в справке Delphi по GetVolumeInformation  
    
Функция возвращает true, если всё прошло успешно (диск нашёлся),  
и false, если возникли проблемы, например диска нет в дисководе,  
либо дисковода такого вообще нет  
} 
Function GetHDDInfo(Disk : Char;Var VolumeName, FileSystemName : String;   
Var VolumeSerialNo, MaxComponentLength, FileSystemFlags:LongWord) : Boolean;   
     
implementation 
     
function GetDisks(TypeOfDisk : Word) : String;{Получить имена нужных дисков} 
var 
  DriveArray : array[1..26] of Char;   
  I : integer;   
begin 
DriveArray:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';   
for I := 1 to 26 do 
  if GetDriveType(PChar(DriveArray[i]+':\')) = TypeOfDisk then   
    Result := Result+DriveArray[i];   
end;   
     
Function GetHDDInfo(Disk : Char;Var VolumeName, FileSystemName : String;   
  Var VolumeSerialNo, MaxComponentLength, FileSystemFlags:LongWord) : Boolean;   
  Var  
_VolumeName,_FileSystemName:array [0..MAX_PATH-1] of Char;   
_VolumeSerialNo,_MaxComponentLength,_FileSystemFlags:LongWord;   
Begin  
if GetVolumeInformation(PChar(Disk+':\'),_VolumeName,MAX_PATH,@_VolumeSerialNo,   
   _MaxComponentLength,_FileSystemFlags,_FileSystemName,MAX_PATH) then 
Begin  
VolumeName:=_VolumeName;   
VolumeSerialNo:=_VolumeSerialNo;   
MaxComponentLength:=_MaxComponentLength;   
FileSystemFlags:=_FileSystemFlags;   
FileSystemName:=_FileSystemName;   
Result:=True;   
End   
else   
  Result:=False;   
End;   
end.

Применение:

Код:

USES ..., ..., ..., HDDInfo; {Добавляем наш модуль} 
     
{Нужно создать на форме компонент TLabel , Name которого ставим в Disks} 
{И в событии главной формы OnActicate написать это:} 
     
procedure TMyForm.FormActivate(Sender: TObject);   
Var  
S,SOut : String;   
I : Integer;   
VolumeName,FileSystemName : String;   
VolumeSerialNo,MaxComponentLength,FileSystemFlags:LongWord;   
begin 
S:=GetDisks(DiskHDD); {Получаем список Жёстких дисков (Параметр DiskHDD)} 
SOut:='';   
For I:=1 to Length(S) do {Получаем информацию о всех дисках и пишем в TLabel на форме} 
Begin  
{Если диск существует/вставлен ...} 
if GetHDDInfo(S[i], VolumeName, FileSystemName, VolumeSerialNo,   
MaxComponentLength, FileSystemFlags) then {... тогда собираем информацию} 
SOut:=SOut+   
'Диск: '+S[i]+#13#10+   
'Метка: '+VolumeName+#13#10+   
'Файловая система: '+FileSystemName+#13+#10+   
'Серийный номер: '+IntToHex(VolumeSerialNo,8)+#13+#10+   
'Макс. длина имени файла: '+IntToStr(MaxComponentLength)+#13+#10+   
'Flags: '+IntToHex(FileSystemFlags,4)+#13#10+#13#10;   
End;   
Disks.Caption:=SOut; {Выводим в компонент TLabel полученные данные о дисках} 
end;

Источник:DRKB

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Belanserg (13.07.2014)