CD Remember

Как-то раз в один прекрасный день решил я у друга взять на денек очередной диск поиграть - и в итоге забыл его в дисководе у другого друга... Вот и решил я написать программу-напоминалку: при завершении работы она выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска нет - она даже не пикнет )?

Исходный код модуля:

unit cd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, MMSystem;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function FindCD:Integer;
var
  i, DType:integer;
  str:string;
  drive:integer;

begin
  Result:=0;
  for i:=65 to 90 do
  begin
    str:=chr(i)+':\';
    DType:=GetDrivetype(PChar(str));
    case DType of
      0: drive:=0;
      1: drive:=1;
      DRIVE_CDROM : drive:=i;
    end;
    if not ((DType=0) or (Dtype=1)) then
      Result:=drive;
  end;
end;

function DiskInDrive(Drive: Char): Boolean;
var 
  ErrorMode: word; 
begin 
  { переводим в верхний регистр } 
  if Drive in ['a'..'z'] then Dec(Drive, $20); 
  { убеждаемся, что это буква } 
  if not (Drive in ['A'..'Z']) then 
    raise EConvertError.Create('Not a valid drive ID');

  //отключаем критические ошибки// 

  ErrorMode := SetErrorMode(SEM_FailCriticalErrors); 
  try 
    if DiskSize (Ord(Drive) - $40) = -1 then 
      Result := False 
    else 
      Result := True; 
  finally 
    { восстанавливаем старый режим ошибок } 
    SetErrorMode(ErrorMode); 
  end; 
end;

procedure ChooseCloseMode;
begin
  Form1.Height:=290;
  Form1.Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.text:=(chr(Findcd)+':\');
  Button1.Enabled:=false;
  Label1.Enabled:=false;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if DiskInDrive(chr(findcd))=true then
  begin
    Canclose:=false;
    Form1.Show;
  end
  else // если нет
    CanClose:=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  ChooseCloseMode;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  mciSendString('Set cdaudio door open wait', nil, 0, handle);
  Button1.Enabled:=true;
  Label1.Enabled:=true;
  BitBtn1.Enabled:=false;
  Bitbtn2.Enabled:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  mciSendString('Set cdaudio door closed wait', nil, 0, handle);
  ChooseCloseMode;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Radiobutton1.Checked=true then
    ExitWindowsEx(EWX_POWEROFF or EWX_SHUTDOWN,0)
  else
  if Radiobutton2.Checked=true then
    ExitWindowsEx(EWX_REBOOT,0);
end;

end.

Немного кривоваты комментарии, но кому нужно - разберется.

Код .DPR файла:

program cdrem;

uses
  Forms,
  cd in 'cd.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.ShowMainForm:=false;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Компилятор: Delphi 5