引言
通常，我們打開和關閉光驅是通過按動光驅上開關按鈕來實現的，但有時候手動方式顯得很不方便，尤其是在一台電腦上安裝多個光驅的情形下，同時光驅的損耗在手動方式下也是最大的，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 最終彈出菜單的效果圖
