Помогите с процедурой работы с внешним носителем

[dolphin705]

Вот код

function DriveExists(Drive: Byte):boolean; 
var
LogDrives: set of 0..25;
begin
Integer(LogDrives):=GetLogicalDrives;
Result:=Drive in LogDrives;
end;


Procedure DriveD;
var
D:byte;
begin
if DriveExists(D) = true then
 if GetDriveType('D:') = DRIVE_REMOVABLE or DRIVE_FIXED then
  begin
   ///действия
  end
  else
  exit;
end;

Здесь вроде бы ошибка в DriveExists

[Levsha100]

Может это поможет...http://www.delphisources.ru/pages/fa...ve_exists.html

[dolphin705]

Да нет, я ведь без ListBox работаю, мне нужно просто проверить вставлен диск в систему или нет

[dolphin705]

Ну что, никто не знает да?

[Лукманов Александр]

С какого то сайта

Определить готовность устройства и наличие в нем носителя проще всего при помощи функции API GetDiskFreeSpace. Данная функция при вызове должна получать имя диска в формате "диск:\" в виде строки PCHAR. Если устройство готово к работе и в нем есть носитель, то возвращается TRUE, при ошибках или отсутствии носителя - FALSE. По этому признаку можно судить о наличии дискеты в дисководе. Кроме того, при успешном выполнении функция заполняет последние четыре параметра информацией о диске:

SectorsPerCluster - число секторов на кластер
BytesPerSector - число байт на сектор
NumberOfFreeClusters - число свободных кластеров
TotalNumberOfClusters - общее число кластеров на диске

Function DiskInDrive(ADriveLetter : Char) : Boolean;
var
  SectorsPerCluster,
  BytesPerSector,
  NumberOfFreeClusters,
  TotalNumberOfClusters   : Cardinal;
begin
  Result := GetDiskFreeSpace(PChar(ADriveLetter+':\'),
                              SectorsPerCluster,
                              BytesPerSector,
                              NumberOfFreeClusters,
                              TotalNumberOfClusters);

end;

В FAQ по Delphi можно встретить другой вариант реализации:

 Result := false;
 try
  ChDir('a:\');
  Result := true;
 except end;

Такой вариант (известно множество его реализаций - главное, что принцип основан на применении ChDir) несколько некорректен, т.к. приводит к смене текущего каталога, что не всегда желательно. Решить эту проблему позволяет запоминание текущего каталога при помощи функции GetDir и его восстановление после проверки при помощи ChDir.
Известен еще один способ - проверка при помощи FindFirst:

var
 SR  : TSearchRec;
 Res : integer;
 OldErrMode : integer;
begin
 // Запоминаем текущий режим обработки ошибок и устанавливаем SEM_FAILCRITICALERRORS
 // Это необходимо для подавления появления окна с сообщение о том, что устройство не готово
 OldErrMode = SetErrorMode(SEM_FAILCRITICALERRORS);
 try
  Res := FindFirst('a:\*.*', faAnyfile, SR);
  FindClose(SR);
 finally
  SetErrorMode(OldErrMode)
 end;
end;

[mihali4]

Вроде бы приводил уже:

function IsDriveReady(DriveLetter : char) : bool;
var
OldErrorMode : Word;
OldDirectory : string;
begin
OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
GetDir(0, OldDirectory);
{$I-}
ChDir(DriveLetter + ':\');
{$I+}
if IoResult > 0 then
Result := False
else
Result := True;
ChDir(OldDirectory);
SetErrorMode(OldErrorMode);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if not IsDriveReady(Edit1.Text[1]) then
ShowMessage('Диска нет')
else
ShowMessage('Диск есть');
end;

Особенность - отключение диалога "Window's critical Error".

[dolphin705]

mihali4, спасибо, как всегда на высоте!
Только вопрос, эта функция для всех типов съёмных носителей? Или только гибких дисков?

[mihali4]

Для всех, в том числе и CD/DVD, SD/MMC/MS/XD - проверено.