下载本文示例代码
摘要 介绍在Delphi编程环境下实现开启光驱盘盒的主要技术和方法，该程序以托盘方式驻留状态栏中，可以设置为随系统启动而启动，不但能够控制一个光驱，而且还能动态检测某台电脑上的光驱数目，创建相应的控制菜单，实现有选择性控制光驱。 关键词 Delphi程序 光驱控制 弹出菜单 过程 事件 引言 通常，我们打开和关闭光驱是通过按动光驱上开关按钮来实现的，但有时候手动方式显得很不方便，尤其是在一台电脑上安装多个光驱的情形下，同时光驱的损耗在手动方式下也是最大的，Delphi是个功能强大且容易的编程工具，可不可以利用编程方法来取代手工操作呢？通过摸索与实践终于将这一想法利用Delphi编程得以实现，该程序不但能够控制一个光驱，而且还可以选择性地控制某个光驱和所有光驱的开启与关闭，这对那些操作多个光驱而又懒得弯腰的电脑人确实会方便许多。 编程思路 编程思路：通过弹出菜单及事件控制光驱。 1、弹出菜单的实现 运行Delphi并新建一个工程， 在uses部分引用Registry, Mmsystem两个单元文件，在窗体中添加一个名称为PopmenuCDctrl弹出菜单组建，并添加6个菜单项，窗体TForm1的Popupmenu 项设为PopmenuCDctrl，PopmenuCDctrl的名称和主要属性赋值见表1。表1 TPopupmenu组建属性表
名称
组件类型
组件CAPTION
主要过程及事件
说明
mMenuTitle
TMenuItem
==光驱控制==
无
弹出菜单标签
mOpenCDROM
TMenuItem
打开CDROM盒
生成子菜单(
打开光驱子菜单
mCloseCDROM
TMenuItem
关闭CDROM盒
生成子菜单
关闭光驱子菜单
mAutoRun
TMenuItem
置启动时执行
mAutoRunClick
开机运行
mNotAutoRun
TMenuItem
自动执行无效
SetCDAutoRun(False)
取消开机运行
mCloseApp
TMenuItem
关闭控制程序
Application.Terminate;
关闭控制程序 设置后的弹出菜单效果如图1所示所示，其中mOpenCDROM（打开CDROM盒）和mCloseCDROM（关闭CDROM盒）菜单将根据电脑中光驱个数自动生成相应的菜单栏目。
图1 弹出菜单效果图 2、声明的变量和函数：
… …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 … … 1)列出光驱数目和生成子菜单
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 thenbegin 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; 2)打开CDROM盒的函数
function OpenCDROM(Drive:pChar):Boolean; // 打开CDROMvar 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;共2页。 1 2 :
摘要 介绍在Delphi编程环境下实现开启光驱盘盒的主要技术和方法，该程序以托盘方式驻留状态栏中，可以设置为随系统启动而启动，不但能够控制一个光驱，而且还能动态检测某台电脑上的光驱数目，创建相应的控制菜单，实现有选择性控制光驱。 关键词 Delphi程序 光驱控制 弹出菜单 过程 事件 引言 通常，我们打开和关闭光驱是通过按动光驱上开关按钮来实现的，但有时候手动方式显得很不方便，尤其是在一台电脑上安装多个光驱的情形下，同时光驱的损耗在手动方式下也是最大的，Delphi是个功能强大且容易的编程工具，可不可以利用编程方法来取代手工操作呢？通过摸索与实践终于将这一想法利用Delphi编程得以实现，该程序不但能够控制一个光驱，而且还可以选择性地控制某个光驱和所有光驱的开启与关闭，这对那些操作多个光驱而又懒得弯腰的电脑人确实会方便许多。 编程思路 编程思路：通过弹出菜单及事件控制光驱。 1、弹出菜单的实现 运行Delphi并新建一个工程， 在uses部分引用Registry, Mmsystem两个单元文件，在窗体中添加一个名称为PopmenuCDctrl弹出菜单组建，并添加6个菜单项，窗体TForm1的Popupmenu 项设为PopmenuCDctrl，PopmenuCDctrl的名称和主要属性赋值见表1。表1 TPopupmenu组建属性表
名称
组件类型
组件CAPTION
主要过程及事件
说明
mMenuTitle
TMenuItem
==光驱控制==
无
弹出菜单标签
mOpenCDROM
TMenuItem
打开CDROM盒
生成子菜单(
打开光驱子菜单
mCloseCDROM
TMenuItem
关闭CDROM盒
生成子菜单
关闭光驱子菜单
mAutoRun
TMenuItem
置启动时执行
mAutoRunClick
开机运行
mNotAutoRun
TMenuItem
自动执行无效
SetCDAutoRun(False)
取消开机运行
mCloseApp
TMenuItem
关闭控制程序
Application.Terminate;
关闭控制程序 设置后的弹出菜单效果如图1所示所示，其中mOpenCDROM（打开CDROM盒）和mCloseCDROM（关闭CDROM盒）菜单将根据电脑中光驱个数自动生成相应的菜单栏目。
图1 弹出菜单效果图 2、声明的变量和函数：
… …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 … … 1)列出光驱数目和生成子菜单
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 thenbegin 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; 2)打开CDROM盒的函数
function OpenCDROM(Drive:pChar):Boolean; // 打开CDROMvar 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;共2页。 1 2 :
下载本文示例代码
用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制用Delphi程序实现对光驱盘盒的开关控制
