通常 我们打开和关闭光驱是通过按动光驱上开关按钮来实现的 但有时候手动方式显得很不方便 尤其是在一台电脑上安装多个光驱的情形下 同时光驱的损耗在手动方式下也是最大的 Delphi是个功能强大且容易的编程工具 可不可以利用编程方法来取代手工操作呢？通过摸索与实践终于将这一想法利用Delphi编程得以实现 该程序不但能够控制一个光驱 而且还可以选择性地控制某个光驱和所有光驱的开启与关闭 这对那些操作多个光驱而又懒得弯腰的电脑人确实会方便许多
编程思路
编程思路 通过弹出菜单及事件控制光驱
弹出菜单的实现
运行Delphi并新建一个工程 在uses部分引用Registry Mmsystem两个单元文件 在窗体中添加一个名称为PopmenuCDctrl弹出菜单组建 并添加 个菜单项 窗体TForm 的Popupmenu 项设为PopmenuCDctrl PopmenuCDctrl的名称和主要属性赋值见表
表 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; tmppopmenu tmpPopmenu :TMenuItem; function OpenCDROM(Drive:pChar):Boolean; function CloseCDROM(Drive:pChar):Boolean; implementation … …
)列出光驱数目和生成子菜单
procedure TForm PopupMenu Popup(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; tmppopmenu :=TMenuItem Create(Self); tmppopmenu AutoHotkeys:=maManual; tmppopmenu OnClick := menuOpenCdrom; mOpenCDROM Add(tmppopmenu ); tmppopmenu Caption :=UpperCase(mydrive)+ : ; tmppopmenu :=TMenuItem Create(Self); tmppopmenu AutoHotkeys:=maManual; tmppopmenu OnClick := menuCloseCdrom; mCloseCDROM Add(tmppopmenu ); tmppopmenu Caption :=UpperCase(mydrive)+ : ; end; DRIVE_RAMDISK: MyDrive:=Drive; DRIVE_REMOTE: MyDrive:=Drive; end; end; //当光驱多于 个生成 所有光驱 控制菜单项 if mOpenCDROM Count > then begin tmppopmenu :=TMenuItem Create(Self); tmppopmenu Caption:= 所有光驱 ; tmppopmenu OnClick := menuOpenCdrom; mOpenCDROM Add(tmppopmenu ); tmppopmenu :=TMenuItem Create(Self); tmppopmenu Caption:= 所有光驱 ; tmppopmenu OnClick := menuCloseCdrom; mCloseCDROM Add(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_Open Flags Longint(@OpenParm)); If Res<> then exit; DeviceID:=OpenParm wDeviceID ; try Res:=mciSendCommand(DeviceID MCI_SET MCI_SET_DOOR_OPEN ); If Res= then exit; Result:=True; finally mciSendCommand(DeviceID mci_Close Flags Longint(@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_Open Flags Longint(@OpenParm)); If Res<> then exit; DeviceID:=OpenParm wDeviceID ; try Res:=mciSendCommand(DeviceID MCI_SET MCI_SET_DOOR_CLOSED ); If Res= then exit; Result:=True; finally mciSendCommand(DeviceID mci_Close Flags Longint(@OpenParm)); end; end;
)置程序启动时执行菜单鼠标事件
procedure TForm mAutorunClick(Sender: TObject); var Reg: TRegistry; begin if Application ExeName= then // 判断应用程序文件名是否为空 begin MessageBox(Handle 应用程序名称不可以为空 错误 MB_OK+MB_ICONERROR); Exit; end; // 初始化AppFileName //GetMem(Application ExeName ); // edit text GetTextBuf(AppFileName ); Reg:=TRegistry Create; try Reg RootKey:=HKEY_LOCAL_MACHINE; if (Reg OpenKey( Sofare\Microsoft\Windows\CurrentVersion\Run False))=True then begin // 在注册表中添加数值 Reg WriteString( MyStartup Application ExeName); end else MessageBox(Handle 打开注册表失败 错误 MB_OK+MB_ICONERROR); finally Reg CloseKey; Reg Free; end; end;
)程序自动执行无效的菜单鼠标事件
procedure TForm mNotautorunClick(Sender: TObject); var Reg: TRegistry; begin Reg:=TRegistry Create; try Reg RootKey:=HKEY_LOCAL_MACHINE; if (Reg OpenKey( Sofare\Microsoft\Windows\CurrentVersion\Run False))=True then begin // 在注册表中添加数值 Reg DeleteValue( MyStartup ); end else MessageBox(Handle 打开注册表失败 错误 MB_OK+MB_ICONERROR); finally Reg CloseKey; Reg Free; end; end;
)打开光驱子菜单的事件过程
procedure TForm MenuOpenCdrom(Sender : TObject); var i:integer; begin with Sender as TMenuItem do begin if Menuindex = mOpenCDROM Count then //判断鼠标是否点击 所有光驱 子菜单项 begin for i := to Menuindex do //打开所有光驱 begin // Menuindex:=i; Mycdrom :=pchar(mopenCdrom Items[i] Caption); OpenCdrom(Mycdrom); end; end else begin Mycdrom :=pchar(mopenCdrom Items[Menuindex] Caption); OpenCdrom(Mycdrom); end; end;
)关闭光驱子菜单事件过程
procedure TForm MenuCloseCdrom(Sender : TObject); var i:integer; begin with Sender as TMenuItem do begin if Menuindex = mCloseCDROM Count then //判断鼠标是否点击 所有光驱 子菜单项 begin for i := to Menuindex do // //关闭所有光驱 begin Mycdrom :=pchar(mCloseCdrom Items[i] Caption); CloseCdrom(Mycdrom); end; end else Mycdrom :=pchar(mCloseCdrom Items[Menuindex] Caption); CloseCdrom(Mycdrom); end; end;
)关闭控制程序子菜单事件过程:
procedure TForm mCloseAppClick(Sender: TObject); begin Application terminate; //程序终止 end;
通过上述的函数和过程实现了对光驱的控制 运行以下该程序 用鼠标右键点击所见窗口 弹出图 菜单效果 选择所要控制开关的光驱盘号 显然光驱盒开始听任程序的摆布 该程序可以进一步改造后将其窗体隐去 放入状态栏中 实现程序托盘功能等 由于限于篇幅 将此部分省去
本程序Windows 操作系统+ Delphi 实现和调试通过
lishixinzhi/Article/program/Delphi/201311/24757