function DiskInDrive(const Drive: char): Boolean; var DrvNum: byte;EMode: Word;begin result := false;DrvNum := ord(Drive);if DrvNum >= ord('a') then dec(DrvNum,$20);EMode := SetErrorMode(SEM_FAILCRITICALERRORS);tryif DiskSize(DrvNum-$40) <> -1 then result := trueelse messagebeep(0);finallySetErrorMode(EMode);end;end; |
Дополнение от читателя:
...можно для пущей функциональности добавить ряд строк:
|
function DiskInDrive(const Drive: char): Boolean; var DrvNum: byte; EMode: Word; begin result := true; // было false DrvNum := ord(Drive); if DrvNum >= ord('a') then dec(DrvNum,$20); EMode := SetErrorMode(SEM_FAILCRITICALERRORS); try while DiskSize(DrvNum-$40) = -1 do begin // при неудаче выводимдиалог if (Application.MessageBox('Диск не готов...'+chr(13)+chr(10)+'Повторить?',PChar('Диск '+UpperCase(Drive)),mb_OKCANCEL+mb_iconexclamation{IconQuestion})=idcancel) then beginResult:=false;Break;end;end;finally SetErrorMode(EMode); end; end; |
С уважением, [000076]
typeTDriveState( DS_NO_DISK, DS_UNFORMATTED_DISK, DS_EMPTY_DISK,DS_DISK_WITH_FILES ); Function DriveState( driveletter: Char ): TDriveState;Varmask: String[6];sRec: TSearchRec;oldMode: Cardinal;retcode: Integer;BeginoldMode: = SetErrorMode( SEM_FAILCRITICALERRORS );mask:= '?:\*.*';mask[1] := driveletter;{$I-} { не возбуждаем исключение при неудаче }retcode := FindFirst( mask, faAnyfile, SRec );FindClose( SRec );{$I+}Case retcode Of0: Result := DS_DISK_WITH_FILES; { обнаружен по крайней мере один файл }-18: Result := DS_EMPTY_DISK; { никаких файлов не обнаружено, но ok }-21: Result := DS_NO_DISK; { DOS ERROR_NOT_READY }ElseResult := DS_UNFORMATTED_DISK; { в моей системе значение равно -1785!}End;SetErrorMode( oldMode );End; { DriveState } |
Я тестировал код под Win NT 3.5, так что проверьте его на ошибки в ситуациях, когда дискета отсутствует или неотформатирована под Win 3.1 и WfW 3.11, если, конечно, это необходимо.
Ревизия для Win95:
case RetCode of0: Result := DS_DISK_WITH_FILES;-18: Result := DS_EMPTY_DISK;elseResult := DS_NO_DISK;end; |
[000527]