Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Дисковое оборудование



Вернуться к списку функций
 Получение сведений о диске (метка/имя диска, файловая система, серийный номер)

 Прислал: cyborg (Бузулук) ( 23 мая 2002 г. )
©  Собственное написание (Осипов Евгений Анатольевич)
 Описание:
Получение информации о любом диске.
Работает на FDD, HDD, CD, другие не пробовал.

Создайте модуль с именем HDDInfo и полностью скопируйте в него весь текст.

 Зависимости:
Все Windows (32S, 95, NT)

 Ограничения:
Проверено в Delphi6 и WinXP

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Получение сведений о диске (метка/имя диска, файловая система, серийный номер)

Получение информации о любом диске.
Работает на FDD, HDD, CD, другие не пробовал.

Создайте модуль с именем HDDInfo и полностью скопируйте в него весь текст.

Зависимости: Все Windows (32S,95,NT)
Автор:       cyborg, cyborg1979@newmail.ru, ICQ:114205759, Бузулук
Copyright:   Собственное написание (Осипов Евгений Анатольевич)
Дата:        23 мая 2002 г.
***************************************************************** }

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;


Вернуться к списку функций

Наверх ▲