CD Remember
Материал из DRKB
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
ID: 01405