|
引言 通常，我们打开和关闭光驱是通过按动光驱上开关按钮来实现的，但有时候手动方式显得很不方便，尤其是在一台电脑上安装多个光驱的情形下，同时光驱的损耗在手动方式下也是最大的，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 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; 2)打开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:=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; 3)关闭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:=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; 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('Software\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; 5)程序自动执行无效的菜单鼠标事件 procedure TForm1.mNotautorunClick(Sender: TObject);
var
Reg: TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_LOCAL_MACHINE;
if (Reg.OpenKey('Software\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; 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[i].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[i].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 实现和调试通过。 图2 最终弹出菜单的效果图
|
