用Delphi实现对光驱盘盒的开关控制

　摘要 介绍在Delphi编程环境下实现开启光驱盘盒的主要技术和方法，该程序以托盘方式驻留状态栏中，可以设置为随系统启动而启动，不但能够控制一个光驱，而且还能动态检测某台电脑上的光驱数目，创建相应的控制菜单，实现有选择性控制光驱。

　　关键词 Delphi程序 光驱控制 弹出菜单 过程 事件

　　引言

　　通常，我们打开和关闭光驱是通过按动光驱上开关按钮来实现的，但有时候手动方式显得很不方便，尤其是在一台电脑上安装多个光驱的情形下，同时光驱的损耗在手动方式下也是最大的，Delphi是个功能强大且容易的编程工具，可不可以利用编程方法来取代手工操作呢？通过摸索与实践终于将这一想法利用Delphi编程得以实现，该程序不但能够控制一个光驱，而且还可以选择性地控制某个光驱和所有光驱的开启与关闭，这对那些操作多个光驱而又懒得弯腰的电脑人确实会方便许多。

　　编程思路

　　编程思路：通过弹出菜单及事件控制光驱。

　　1、弹出菜单的实现

　　运行Delphi并新建一个工程， 在uses部分引用Registry, Mmsystem两个单元文件，在窗体中添加一个名称为PopmenuCDctrl弹出菜单组建，并添加6个菜单项，窗体TForm1的Popupmenu 项设为PopmenuCDctrl，PopmenuCDctrl的名称和主要属性赋值见表1。

　　表1 TPopupmenu组建属性表

[table][tr][td=1,1,109]
名称
[/td][td=1,1,81]
组件类型
[/td][td=1,1,119]
组件CAPTION
[/td][td=1,1,144]
主要过程及事件
[/td][td=1,1,115]
说明
[/td][/tr][tr][td=1,1,109]
mMenuTitle
[/td][td=1,1,81]
TMenuItem
[/td][td=1,1,119]
==光驱控制==
[/td][td=1,1,144]
无
[/td][td=1,1,115]
弹出菜单标签
[/td][/tr][tr][td=1,1,109]
mOpenCDROM
[/td][td=1,1,81]
TMenuItem
[/td][td=1,1,119]
打开CDROM盒
[/td][td=1,1,144]
生成子菜单(
[/td][td=1,1,115]
打开光驱子菜单
[/td][/tr][tr][td=1,1,109]
mCloseCDROM
[/td][td=1,1,81]
TMenuItem
[/td][td=1,1,119]
关闭CDROM盒
[/td][td=1,1,144]
生成子菜单
[/td][td=1,1,115]
关闭光驱子菜单
[/td][/tr][tr][td=1,1,109]
mAutoRun
[/td][td=1,1,81]
TMenuItem
[/td][td=1,1,119]
置启动时执行
[/td][td=1,1,144]
mAutoRunClick
[/td][td=1,1,115]
开机运行
[/td][/tr][tr][td=1,1,109]
mNotAutoRun
[/td][td=1,1,81]
TMenuItem
[/td][td=1,1,119]
自动执行无效
[/td][td=1,1,144]
SetCDAutoRun(False)
[/td][td=1,1,115]
取消开机运行
[/td][/tr][tr][td=1,1,109]
mCloseApp
[/td][td=1,1,81]
TMenuItem
[/td][td=1,1,119]
关闭控制程序
[/td][td=1,1,144]
Application.Terminate;
[/td][td=1,1,115]
关闭控制程序
[/td][/tr][/table]
　　设置后的弹出菜单效果如图1所示所示，其中mOpenCDROM（打开CDROM盒）和mCloseCDROM（关闭CDROM盒）菜单将根据电脑中光驱个数自动生成相应的菜单栏目。

图片：51_3710_3808a3192e16e1a.gif

图1 弹出菜单效果图

　　2、声明的变量和函数：

[table=90%][tr][td]… …

procedure mCloseAppClick(Sender: TObject);
procedure mAutorunClick(Sender: TObject);
procedure mNotautorunClick(Sender: TObject);
procedure PopmenuCDctrlPopup(Sender: TObject);

private
　{ Private declarations }
　procedure MenuOpenCdrom(Sender : TObject);
　procedure MenuCloseCdrom(Sender : TObject);
var
　Form1: TForm1;
　MYDRIVE:char;
　Mycdrom:pchar;
　tmppopmenu1,tmpPopmenu2:TMenuItem;
　function OpenCDROM(Drive:pChar):Boolean;
　function CloseCDROM(Drive:pChar):Boolean;
　implementation
　… …[/td][/tr][/table]
　　1)列出光驱数目和生成子菜单

[table=90%][tr][td]procedure TForm1.PopupMenu1Popup(Sender: TObject);
　var Drive :char;
begin;
　mOpenCdrom.Clear; //清除打开光驱子菜单项
　mCloseCdrom.Clear; //清除打开光驱子菜单项
　//列出光驱数目和生成子菜单

　for Drive:='a' to 'z' do
　begin
　　Case GetDriveType(Pchar(Drive+':')) of
　　　DRIVE_REMOVABLE:
　　　MyDrive:=Drive;
　　　DRIVE_FIXED:
　　　MyDrive:=Drive;
　　　DRIVE_CDROM:
　　begin
　　　MyDrive:=Drive;
　　　tmppopmenu1:=TMenuItem.Create(Self);
　　　tmppopmenu1.AutoHotkeys:=maManual;
　　　tmppopmenu1.OnClick := menuOpenCdrom;
　　　mOpenCDROM.Add(tmppopmenu1);
　　　tmppopmenu1.Caption :=UpperCase(mydrive)+':';
　　　tmppopmenu2:=TMenuItem.Create(Self);
　　　tmppopmenu2.AutoHotkeys:=maManual;
　　　tmppopmenu2.OnClick := menuCloseCdrom;
　　　mCloseCDROM.Add(tmppopmenu2);
　　　tmppopmenu2.Caption :=UpperCase(mydrive)+':';
　end;

　DRIVE_RamdISK:
　MyDrive:=Drive;
　DRIVE_REMOTE:
　MyDrive:=Drive;
end;
end;

//当光驱多于1个生成“所有光驱”控制菜单项

if mOpenCDROM.Count > 1 then
begin
　tmppopmenu1:=TMenuItem.Create(Self);
　tmppopmenu1.Caption:='所有光驱';
　tmppopmenu1.OnClick := menuOpenCdrom;
　mOpenCDROM.Add(tmppopmenu1);
　tmppopmenu2:=TMenuItem.Create(Self);
　tmppopmenu2.Caption:='所有光驱';
　tmppopmenu2.OnClick := menuCloseCdrom;
　mCloseCDROM.Add(tmppopmenu2);
end;

end;[/td][/tr][/table]　2)打开CDROM盒的函数

[table=90%][tr][td]function OpenCDROM(Drive:pChar):Boolean; // 打开CDROM
var
　Res:MciError;
　OpenParm:TMCI_OPEN_Parms;
　Flags:Dword;
　s:string;
　DeviceID:Word;
begin
　Result:=false;
　s:=Drive+':';
　flags:=mci_Open_Type or mci_Open_Element;
　With OpenParm do
　begin
　　dwCallBack:=0;
　　lpstrDeviceType:='CDAudio';
　　lpstrElementName:=PChar(s);
　end;
　Res:=mciSendCommand(0,mci_Open,Flags,Longint(@OpenParm));
　If Res<>0 then exit;
　DeviceID:=OpenParm.wDeviceID ;
　try
　　Res:=mciSendCommand(DeviceID,MCI_SET,MCI_SET_DOOR_OPEN,0);
　　If Res=0 then exit;
　　Result:=True;
　finally
　　mciSendCommand(DeviceID,mci_Close,Flags,Longint(@OpenParm));
　end;
end;[/td][/tr][/table]
　　3)关闭CDROM盒的函数

[table=90%][tr][td]function CloseCDROM(Drive:pChar):Boolean; // 关闭CDROM
var
　Res:MciError;
　OpenParm:TMCI_OPEN_Parms;
　Flags:Dword;
　s:string;
　DeviceID:Word;
　begin
　　Result:=false;
　　s:=Drive+':';
　　flags:=mci_Open_Type or mci_Open_Element;
　　With OpenParm do
　　begin
　　　dwCallBack:=0;
　　　lpstrDeviceType:='CDAudio';
　　　lpstrElementName:=PChar(s);
　　end;
　　Res:=mciSendCommand(0,mci_Open,Flags,Longint(@OpenParm));
　　If Res<>0 then exit;
　　DeviceID:=OpenParm.wDeviceID ;
　　try
　　　Res:=mciSendCommand(DeviceID,MCI_SET,MCI_SET_DOOR_CLOSED,0);
　　　If Res=0 then exit;
　　　Result:=True;
　　finally
　　　mciSendCommand(DeviceID,mci_Close,Flags,Longint(@OpenParm));
　　end;
　end;[/td][/tr][/table]
　　4)置程序启动时执行菜单鼠标事件

procedure TForm1.mAutorunClick(Sender: TObject); var 　Reg: TRegistry; begin 　if Application.ExeName='' then // 判断应用程序文件名是否为空 　begin 　　MessageBox(Handle,'应用程序名称不可以为空。','错误',MB_OK+MB_ICONERROR); 　　Exit; 　end; 　// 初始化AppFileName 　//GetMem(Application.ExeName,256); 　// edit1.text.GetTextBuf(AppFileName,256); 　Reg:=TRegistry.Create; 　try 　　Reg.RootKey:=HKEY_LOCAL_MACHINE; 　　if (Reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun',False))=True then 　　begin 　　　// 在注册表中添加数值 　　　Reg.WriteString('MyStartup',Application.ExeName); 　　end 　　else 　　　MessageBox(Handle,'打开注册表失败。','错误',MB_OK+MB_ICONERROR); 　　finally 　　　Reg.CloseKey; 　　　Reg.Free; 　　end; 　end;

5)程序自动执行无效的菜单鼠标事件

procedure TForm1.mNotautorunClick(Sender: TObject); var 　Reg: TRegistry; begin 　Reg:=TRegistry.Create; 　try 　　Reg.RootKey:=HKEY_LOCAL_MACHINE; 　　if (Reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun',False))=True then 　　begin 　　　// 在注册表中添加数值 　　　Reg.DeleteValue('MyStartup'); 　　end 　　else 　　　MessageBox(Handle,'打开注册表失败。','错误',MB_OK+MB_ICONERROR); 　　finally 　　　Reg.CloseKey; 　　　Reg.Free; 　　end; 　end;

　　6)打开光驱子菜单的事件过程

procedure TForm1.MenuOpenCdrom(Sender : TObject); 　var i:integer; 　begin 　with Sender as TMenuItem do begin 　　if Menuindex = mOpenCDROM.Count-1 then //判断鼠标是否点击”所有光驱”子菜单项 　　begin 　　for i := 0 to Menuindex-1 do //打开所有光驱 　　begin 　　　// Menuindex:=i; 　　　Mycdrom :=pchar(mopenCdrom.Items.Caption); 　　　OpenCdrom(Mycdrom); 　　end; 　　end else 　　begin 　　　Mycdrom :=pchar(mopenCdrom.Items[Menuindex].Caption); 　　　OpenCdrom(Mycdrom); 　　end; 　end;

　　7)关闭光驱子菜单事件过程

procedure TForm1.MenuCloseCdrom(Sender : TObject); var i:integer; begin 　with Sender as TMenuItem do begin 　if Menuindex = mCloseCDROM.Count-1 then //判断鼠标是否点击”所有光驱”子菜单项 　begin 　for i := 0 to Menuindex-1 do // //关闭所有光驱 　begin 　　Mycdrom :=pchar(mCloseCdrom.Items.Caption); 　　CloseCdrom(Mycdrom); 　end; 　end else 　　Mycdrom :=pchar(mCloseCdrom.Items[Menuindex].Caption); 　　CloseCdrom(Mycdrom); 　end; end;

　　8)关闭控制程序子菜单事件过程:

procedure TForm1.mCloseAppClick(Sender: TObject); begin 　Application.terminate; //程序终止 end;

　　通过上述的函数和过程实现了对光驱的控制，运行以下该程序，用鼠标右键点击所见窗口，弹出图2菜单效果，选择所要控制开关的光驱盘号，显然光驱盒开始听任程序的摆布。该程序可以进一步改造后将其窗体隐去，放入状态栏中，实现程序托盘功能等，由于限于篇幅，将此部分省去。

　　本程序Windows 2000操作系统+ Delphi 5.0 实现和调试通过。

图片：51_3710_cc48b8cf867ed5c.gif

图2 最终弹出菜单的效果图