unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CheckFloppy(driveletter: Char) : string;
var
mask: string[6];
sRec: TSearchRec;
oldMode: Cardinal;
retcode: Integer;
begin
oldMode:= SetErrorMode(SEM_FAILCRITICALERRORS);
mask:= '?:\*.*';
mask[1] := driveletter;
{$I-}
retcode := FindFirst (mask, faAnyfile, SRec);
FindClose(SRec);
{$I+}
case retcode of
0: Result := 'Disk with files found.';
-18: Result := 'Empty Disk Found.';
-21, -3: Result := 'DOS Error Drive Not Ready';
else
Result := 'NO Disk in Drive'; { unformatted disk in drive }
end;
SetErrorMode(oldMode);
end; { DriveState }
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(CheckFloppy('A'));
end;
end.