Программирование Delphi

Даже сегодня возникают ситуации, когда необходимо получить доступ к флоппи диску и работать с ним.

SetErrorMode. Функция SetErrorMode WinAPI Windows управляет тем, как операционная система обрабатывает некоторые типы серьезных ошибок. Когда установлена SEM_FAILCRITICALERRORS, операционная система не выводит окно критических ошибок, когда такое происходит. Вместо этого, операционная система отправляет сообщение об ошибке в вызывающий процесс.

Функция DiskSize возвращает размер диска в байтах. Диск при этом указывается так: 0 – текущий, 1 = A, 2 = B и т.д. ФункцияDiskSize возвращает -1, если номер диска является недопустимым.

Пример выполнения функции DiskSize:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  i:= DiskSize(4);
  Caption:= IntToStr(i);
end;

Функция DiskFree возвращает количество свободных байт на указанном номере диска. Нумерация дисков ведется так же, как и в функции DiskSize.

Функция SHFormatDrive не отображена в справочном файле и нигде не объявлена в Delphi. Так что мы должны объявить эту функцию в модуле Shell32.dll. Это обеспечит нам доступ к диалоговому окну форматирования. Для объявления функции из DLL, нужно добавить зарезервированное слово external и имя DLL в конце перечисления процедур или функций. Так же нужно добавить sdtcall, так как мы используем WIN32 API DLL.

Формат написания будет такой:

function SHFormatDrive(hwnd: HWND;
  Drive: Word; fmtID: Word;
  Options: Word): LongInt stdcall;
  external 'Shell32.dll' name 'SHFormatDrive';

Есть ли диск в дисководе?

Прежде, чем выполнять операции с диском, нужно проверить, есть ли диск в дисководе. Если диск в дисководе отсутствует, нужно вывести сообщение об этом, а не доверяться стандартным средствам Windows о критических ошибках.

procedure TForm1.Button1Click(Sender: TObject) ;
 var
    EMode:  Word;
 begin
   EMode := SetErrorMode(SEM_FAILCRITICALERRORS) ;
   try
     if DiskSize(Ord('A') - $40) <> -1 then
       ShowMessage('Диск в дисководе A: !')
     else
       ShowMessage('Нет диска в дисководе A: !') ;
   finally
     SetErrorMode(EMode) ;
   end;
 end;

Свободное место на диске

Если нужно что-то записать на диск, то желательно проверить свободное место на диске. Сделать это можно так:

procedure TForm1.Button2Click(Sender: TObject) ;
 var
    Drive: Byte;
    sFD, sSD : string;
    DFree, DSize : int64;
 begin
   Drive:=1;
   DFree:=DiskFree(Drive) ;
   DSize:=DiskSize(Drive) ;
   if (DFree <> -1) and (DSize <> -1) then
   begin
     sFD:='Свободно на диске: '+IntToStr(DFree div 1024)+' Kb';
     sSD:='Размер диска: '+IntToStr(DSize div 1024)+' Kb';
     ShowMessage(sFD + #13 + sSD) ;
   end;
 end;

Форматирование

В этом случае мы будем форматировать диск, используя стандартное окно форматирования Windows. Но можно использовать и DOS форматирование. Прежде всего добавьте ShellApi в раздел uses формы.

procedure TForm1.Button4Click(Sender: TObject) ;
 const
    SHFMT_DRV_A = 0;
    SHFMT_DRV_B = 1;
    SHFMT_ID_DEFAULT = $FFFF;
    SHFMT_OPT_QUICKFORMAT = 0;
    SHFMT_OPT_FULLFORMAT = 1;
    SHFMT_OPT_SYSONLY = 2;
    SHFMT_ERROR = -1;
    SHFMT_CANCEL = -2;
    SHFMT_NOFORMAT = -3;
 var
    FmtRes : LongInt;
 begin
   try
    FmtRes:=ShFormatDrive(Handle,
                          SHFMT_DRV_A,
                          SHFMT_ID_DEFAULT,
                          SHFMT_OPT_QUICKFORMAT) ;
    case FmtRes of
     SHFMT_ERROR:
      ShowMessage('Ошибка форматирования!') ;
     SHFMT_CANCEL:
      ShowMessage('Операция форматирование прервана пользователем.') ;
     SHFMT_NOFORMAT:
      ShowMessage('Диск не подлежит форматированию')
    else
      ShowMessage('Форматирование прошло успешно.') ;
    end;
   except
    ShowMessage('Произошла ошибка!')
   end;
 end;

Заключение

Иногда приходится форматировать и дискеты. Эта статья поможет Вам в поисках правильного решения. Все это не так сложно, как кажется на первый взгляд.