以下是dephi5.0下的例程,在7.0下不能运行,???
unit Unit1;//控制光驱
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses MMSystem;
function IsDriveCD(Drive:char):longbool;
var DrivePath: string;
begin
DrivePath:=Drive+':\';
result:=LongBool(GetDriveType(PChar(DrivePath)) and Drive_cdrom);
end;
//弹出光驱
function EjectCD(Drive:char):bool;
var
mp:TMediaPlayer;
begin
result:=false;
Application.ProcessMessages;
if not IsDriveCD(Drive) then exit;
mp:=TMediaPlayer.Create(NIL);
mp.Visible:=false;
mp.Parent:=application.MainForm;
mp.Shareable:=true;
mp.DeviceType:=dtCDAudio;
mp.Filename:=Drive+':';
mp.open;
application.ProcessMessages ;
mciSendCommand(mp.DeviceID, mci_set,mci_set_door_open,0);
application.ProcessMessages ;
mp.close;
application.processmessages;
mp.free;
result:=true;
end;
function CloseCD(Drive:char):boolean;
var
mp:TMediaplayer;
begin
result:=false;
Application.ProcessMessages;
mp:=TMediaplayer.create(NIl);
mp.visible:=false;
mp.Parent:=application.MainForm;
mp.shareable:=true;
mp.Devicetype:=dtCDAudio;
mp.filename:=Drive+':';
mp.open;
application.ProcessMessages;
mciSendCommand(mp.DeviceID,MCI_SET,MCI_SET_DOOR_CLOSED,0);
application.ProcessMessages;
mp.close;
application.processmessages;
mp.free;
result:=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not EjectCD('F') then
ShowMessage('Not a cd drive');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
closeCD('F');
end;
end.