知识大全用Delphi实现对光驱盘盒的开关控制

Posted 2022-07-22 菜单

篇首语：搓绳不能松劲，前进不能停顿。本文由小常识网(cha138.com)小编为大家整理，主要介绍了知识大全用Delphi实现对光驱盘盒的开关控制相关的知识，希望对你有一定的参考价值。

用Delphi实现对光驱盘盒的开关控制 以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容，让我们赶快一起来看一下吧！

引言

通常我们打开和关闭光驱是通过按动光驱上开关按钮来实现的但有时候手动方式显得很不方便尤其是在一台电脑上安装多个光驱的情形下同时光驱的损耗在手动方式下也是最大的 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 实现和调试通过

cha138/Article/program/Delphi/201311/24757

知识大全 用Delphi实现对光驱盘盒的开关控制

知识大全用Delphi实现对光驱盘盒的开关控制