procedure TForm1.Button1Click(Sender: TObject);
const
NameSize = 4;
VolumeCount = 26;
TotalSize = NameSize * VolumeCount;
Report = 'Volume: %s %s';
var
Buff, Volume: String;
lpQuery: array [0..MAXCHAR - 1] of Char;
I, Count: Integer;
begin
SetLength(Buff, TotalSize);
Count := GetLogicalDriveStrings(TotalSize, @Buff[1]) div NameSize;
if Count = 0 then
Memo1.Lines.Add(SysErrorMessage(GetLastError))
else
for I := 0 to Count - 1 do
begin
Volume := PChar(@Buff[(I * NameSize) + 1]);
case GetDriveType(PChar(Volume)) of
DRIVE_UNKNOWN: Memo1.Lines.Add(Format(Report, [Volume,
'The drive type cannot be determined.']));
DRIVE_NO_ROOT_DIR: Memo1.Lines.Add(Format(Report, [Volume,
'The root path is invalid. For example, no volume is mounted at the path.']));
DRIVE_REMOVABLE:
begin
Volume[3] := #0;
QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
Volume[3] := '\';
if String(lpQuery) = '\Device\Floppy0' then
Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk A:.']))
else
if String(lpQuery) = '\Device\Floppy1' then
Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk B:.']))
else
Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Flash Drive.']));
end;
DRIVE_FIXED:
begin
Volume[3] := #0;
QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
Volume[3] := '\';
if Copy(String(lpQuery), 1, 22) = '\Device\HarddiskVolume' then
Memo1.Lines.Add(Format(Report, [Volume,
'The disk cannot be removed from the drive.']))
else
Memo1.Lines.Add(Format(Report, [Volume,
'The drive is a SUBST disk on path: "' +
Copy(String(lpQuery), 5, Length(String(lpQuery))) + '"']));
end;
DRIVE_REMOTE: Memo1.Lines.Add(Format(Report, [Volume,
'The drive is a remote (network) drive.']));
DRIVE_CDROM: Memo1.Lines.Add(Format(Report, [Volume,
'The drive is a CD-ROM drive.']));
DRIVE_RAMDISK: Memo1.Lines.Add(Format(Report, [Volume,
'The drive is a RAM disk.']));
else
Memo1.Lines.Add(Format(Report, [Volume, 'Xpen znaet chto :)']));
end;
end;
end;
end.
Автор: Александр (Rouse_) Багель
Программа на Delphi, которая определяет тип логических дисковых устройств, подключенных к компьютеру, и отображает результаты в контроле Memo на форме.
Для определения типа логического диска программа использует функцию GetLogicalDriveStrings, чтобы получить список строк логических диск, а затем проходит по этому списку с помощью цикла for. Для каждого строки диска она вызывает функцию GetDriveType, чтобы получить тип диска, и затем использует оператор case для определения типа диска.
Возможные типы дисков, которые могут быть обнаружены этой программой:
DRIVE_UNKNOWN: Тип диска не может быть определен.
DRIVE_NO_ROOT_DIR: Корневая папка недействительна. Например, на пути нет монтированной тома.
DRIVE_REMOVABLE: Удаляемый диск, например, флоппи-диск или флэш-накопитель.
Если диск является флоппи-диском, программа проверяет, является ли он диском A: или B:, и отображает соответствующее сообщение.
Если это не флоппи-диск, она предполагает, что это флэш-накопитель, и отображает сообщение об этом.
DRIVE_FIXED: Фиксированный диск, например, жесткий диск. Она проверяет, является ли диск удаляемым, запросив DOS-устройство имени с помощью функции QueryDosDevice, и если нет, она отображает сообщение об этом.
Если диск является объемом жесткого диска, программа отображает сообщение о том, что диск не может быть извлечен из драйва.
Если диск является SUBST-диском на пути, она отображает сообщение с путем.
DRIVE_REMOTE: Удаленный диск (сетевой) диск.
DRIVE_CDROM: Диск CD-ROM.
DRIVE_RAMDISK: RAM-накопитель.
Программа также включает в себя обработку ошибок для случаев, когда функция GetLogicalDriveStrings не удается, и отображает сообщение об ошибке в таких случаях.
Обратите внимание, что это код очень старый (от 2001 года) и может не работать на современных системах Windows. Кроме того, он использует устаревшие API и функции, которые могут не быть подходящими для использования в новых приложениях.
Определение типа логического диска можно выполнить с помощью функции GetDriveType, которая возвращает код типа диска, аналогично кодам, определенным в константном типе TDriveType.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал