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.

Автор: Blabsadm

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