引言
通常我们打开和关闭光驱是通过按动光驱上开关按钮来实现的但有时候手动方式显得很不方便尤其是在一台电脑上安装多个光驱的情形下同时光驱的损耗在手动方式下也是最大的Delphi是个功能强大且容易的编程工具可不可以利用编程方法来取代手工操作呢？通过摸索与实践终于将这一想法利用Delphi编程得以实现该程序不但能够控制一个光驱而且还可以选择性地控制某个光驱和所有光驱的开启与关闭这对那些操作多个光驱而又懒得弯腰的电脑人确实会方便许多
编程思路
编程思路通过弹出菜单及事件控制光驱
弹出菜单的实现
运行Delphi并新建一个工程 在uses部分引用Registry Mmsystem两个单元文件在窗体中添加一个名称为PopmenuCDctrl弹出菜单组建并添加个菜单项窗体TForm的Popupmenu 项设为PopmenuCDctrlPopmenuCDctrl的名称和主要属性赋值见表
表 TPopupmenu组建属性表
设置后的弹出菜单效果如图所示所示其中mOpenCDROM（打开CDROM盒）和mCloseCDROM（关闭CDROM盒）菜单将根据电脑中光驱个数自动生成相应的菜单栏目
图 弹出菜单效果图
声明的变量和函数
… …
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
Form: TForm;
MYDRIVE:char;
Mycdrom:pchar;
tmppopmenutmpPopmenu:TMenuItem;
function OpenCDROM(Drive:pChar):Boolean;
function CloseCDROM(Drive:pChar):Boolean;
implementation
… …
)列出光驱数目和生成子菜单
procedure TFormPopupMenuPopup(Sender: TObject);
var Drive :char;
begin;
mOpenCdromClear; //清除打开光驱子菜单项
mCloseCdromClear; //清除打开光驱子菜单项
//列出光驱数目和生成子菜单
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;
tmppopmenu:=TMenuItemCreate(Self);
tmppopmenuAutoHotkeys:=maManual;
tmppopmenuOnClick := menuOpenCdrom;
mOpenCDROMAdd(tmppopmenu);
tmppopmenuCaption :=UpperCase(mydrive)+:;
tmppopmenu:=TMenuItemCreate(Self);
tmppopmenuAutoHotkeys:=maManual;
tmppopmenuOnClick := menuCloseCdrom;
mCloseCDROMAdd(tmppopmenu);
tmppopmenuCaption :=UpperCase(mydrive)+:;
end;
DRIVE_RAMDISK:
MyDrive:=Drive;
DRIVE_REMOTE:
MyDrive:=Drive;
end;
end;
//当光驱多于个生成所有光驱控制菜单项
if mOpenCDROMCount > then
begin
tmppopmenu:=TMenuItemCreate(Self);
tmppopmenuCaption:=所有光驱;
tmppopmenuOnClick := menuOpenCdrom;
mOpenCDROMAdd(tmppopmenu);
tmppopmenu:=TMenuItemCreate(Self);
tmppopmenuCaption:=所有光驱;
tmppopmenuOnClick := menuCloseCdrom;
mCloseCDROMAdd(tmppopmenu);
end;
end;
)打开CDROM盒的函数
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:=;
lpstrDeviceType:=CDAudio;
lpstrElementName:=PChar(s);
end;
Res:=mciSendCommand(mci_OpenFlagsLongint(@OpenParm));
If Res<> then exit;
DeviceID:=OpenParmwDeviceID ;
try
Res:=mciSendCommand(DeviceIDMCI_SETMCI_SET_DOOR_OPEN);
If Res= then exit;
Result:=True;
finally
mciSendCommand(DeviceIDmci_CloseFlagsLongint(@OpenParm));
end;
end;
)关闭CDROM盒的函数
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:=;
lpstrDeviceType:=CDAudio;
lpstrElementName:=PChar(s);
end;
Res:=mciSendCommand(mci_OpenFlagsLongint(@OpenParm));
If Res<> then exit;
DeviceID:=OpenParmwDeviceID ;
try
Res:=mciSendCommand(DeviceIDMCI_SETMCI_SET_DOOR_CLOSED);
If Res= then exit;
Result:=True;
finally
mciSendCommand(DeviceIDmci_CloseFlagsLongint(@OpenParm));
end;
end;
)置程序启动时执行菜单鼠标事件
procedure TFormmAutorunClick(Sender: TObject);
var
Reg: TRegistry;
begin
if ApplicationExeName= then // 判断应用程序文件名是否为空
begin
MessageBox(Handle应用程序名称不可以为空错误MB_OK+MB_ICONERROR);
Exit;
end;
// 初始化AppFileName
//GetMem(ApplicationExeName);
// edittextGetTextBuf(AppFileName);
Reg:=TRegistryCreate;
try
RegRootKey:=HKEY_LOCAL_MACHINE;
if (RegOpenKey(Software\Microsoft\Windows\CurrentVersion\RunFalse))=True then
begin
// 在注册表中添加数值
RegWriteString(MyStartupApplicationExeName);
end
else
MessageBox(Handle打开注册表失败错误MB_OK+MB_ICONERROR);
finally
RegCloseKey;
RegFree;
end;
end;
)程序自动执行无效的菜单鼠标事件
procedure TFormmNotautorunClick(Sender: TObject);
var
Reg: TRegistry;
begin
Reg:=TRegistryCreate;
try
RegRootKey:=HKEY_LOCAL_MACHINE;
if (RegOpenKey(Software\Microsoft\Windows\CurrentVersion\RunFalse))=True then
begin
// 在注册表中添加数值
RegDeleteValue(MyStartup);
end
else
MessageBox(Handle打开注册表失败错误MB_OK+MB_ICONERROR);
finally
RegCloseKey;
RegFree;
end;
end;
)打开光驱子菜单的事件过程
procedure TFormMenuOpenCdrom(Sender : TObject);
var i:integer;
begin
with Sender as TMenuItem do begin
if Menuindex = mOpenCDROMCount then //判断鼠标是否点击所有光驱子菜单项
begin
for i := to Menuindex do //打开所有光驱
begin
// Menuindex:=i;
Mycdrom :=pchar(mopenCdromItems[i]Caption);
OpenCdrom(Mycdrom);
end;
end else
begin
Mycdrom :=pchar(mopenCdromItems[Menuindex]Caption);
OpenCdrom(Mycdrom);
end;
end;
)关闭光驱子菜单事件过程
procedure TFormMenuCloseCdrom(Sender : TObject);
var i:integer;
begin
with Sender as TMenuItem do begin
if Menuindex = mCloseCDROMCount then //判断鼠标是否点击所有光驱子菜单项
begin
for i := to Menuindex do // //关闭所有光驱
begin
Mycdrom :=pchar(mCloseCdromItems[i]Caption);
CloseCdrom(Mycdrom);
end;
end else
Mycdrom :=pchar(mCloseCdromItems[Menuindex]Caption);
CloseCdrom(Mycdrom);
end;
end;
)关闭控制程序子菜单事件过程:
procedure TFormmCloseAppClick(Sender: TObject);
begin
Applicationterminate; //程序终止
end;
通过上述的函数和过程实现了对光驱的控制运行以下该程序用鼠标右键点击所见窗口弹出图菜单效果选择所要控制开关的光驱盘号显然光驱盒开始听任程序的摆布该程序可以进一步改造后将其窗体隐去放入状态栏中实现程序托盘功能等由于限于篇幅将此部分省去
本程序Windows 操作系统+ Delphi 实现和调试通过
图 最终弹出菜单的效果图
