用Delphi實現對光驅盤盒的開關控制

    引言

    通常我們打開和關閉光驅是通過按動光驅上開關按鈕來實現的但有時候手動方式顯得很不方便尤其是在一台電腦上安裝多個光驅的情形下同時光驅的損耗在手動方式下也是最大的Delphi是個功能強大且容易的編程工具可不可以利用編程方法來取代手工操作呢？通過摸索與實踐終於將這一想法利用Delphi編程得以實現該程序不但能夠控制一個光驅而且還可以選擇性地控制某個光驅和所有光驅的開啟與關閉這對那些操作多個光驅而又懶得彎腰的電腦人確實會方便許多

    編程思路

    編程思路通過彈出菜單及事件控制光驅

    彈出菜單的實現

    運行Delphi並新建一個工程 在uses部分引用Registry Mmsystem兩個單元文件在窗體中添加一個名稱為PopmenuCDctrl彈出菜單組建並添加個菜單項窗體TForm的Popupmenu 項設為PopmenuCDctrlPopmenuCDctrl的名稱和主要屬性賦值見表

    表 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;
    tmppopmenutmpPopmenu:TMenuItem;
    function OpenCDROM(Drive:pChar):Boolean;
    function CloseCDROM(Drive:pChar):Boolean;
    implementation
    … …

    )列出光驅數目和生成子菜單

    procedure TFormPopupMenuPopup(Sender: TObject);
    var Drive :char;
    begin;
    mOpenCdromClear; //清除打開光驅子菜單項
    mCloseCdromClear; //清除打開光驅子菜單項
    //列出光驅數目和生成子菜單
    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:=TMenuItemCreate(Self);
    tmppopmenuAutoHotkeys:=maManual;
    tmppopmenuOnClick := menuOpenCdrom;
    mOpenCDROMAdd(tmppopmenu);
    tmppopmenuCaption :=UpperCase(mydrive)+:;
    tmppopmenu:=TMenuItemCreate(Self);
    tmppopmenuAutoHotkeys:=maManual;
    tmppopmenuOnClick := menuCloseCdrom;
    mCloseCDROMAdd(tmppopmenu);
    tmppopmenuCaption :=UpperCase(mydrive)+:;
    end;
    DRIVE_RAMDISK:
    MyDrive:=Drive;
    DRIVE_REMOTE:
    MyDrive:=Drive;
    end;
    end;
    //當光驅多於個生成所有光驅控制菜單項
    if mOpenCDROMCount > then
    begin
    tmppopmenu:=TMenuItemCreate(Self);
    tmppopmenuCaption:=所有光驅;
    tmppopmenuOnClick := menuOpenCdrom;
    mOpenCDROMAdd(tmppopmenu);
    tmppopmenu:=TMenuItemCreate(Self);
    tmppopmenuCaption:=所有光驅;
    tmppopmenuOnClick := menuCloseCdrom;
    mCloseCDROMAdd(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_OpenFlagsLongint(@OpenParm));
    If Res<> then exit;
    DeviceID:=OpenParmwDeviceID ;
    try
    Res:=mciSendCommand(DeviceIDMCI_SETMCI_SET_DOOR_OPEN);
    If Res= then exit;
    Result:=True;
    finally
    mciSendCommand(DeviceIDmci_CloseFlagsLongint(@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_OpenFlagsLongint(@OpenParm));
    If Res<> then exit;
    DeviceID:=OpenParmwDeviceID ;
    try
    Res:=mciSendCommand(DeviceIDMCI_SETMCI_SET_DOOR_CLOSED);
    If Res= then exit;
    Result:=True;
    finally
    mciSendCommand(DeviceIDmci_CloseFlagsLongint(@OpenParm));
    end;
    end;

    )置程序啟動時執行菜單鼠標事件

    procedure TFormmAutorunClick(Sender: TObject);
    var
    Reg: TRegistry;
    begin
    if ApplicationExeName= then // 判斷應用程序文件名是否為空
    begin
    MessageBox(Handle應用程序名稱不可以為空錯誤MB_OK+MB_ICONERROR);
    Exit;
    end;
    // 初始化AppFileName
    //GetMem(ApplicationExeName);
    // edittextGetTextBuf(AppFileName);
    Reg:=TRegistryCreate;
    try
    RegRootKey:=HKEY_LOCAL_MACHINE;
    if (RegOpenKey(Software\Microsoft\Windows\CurrentVersion\RunFalse))=True then
    begin
    // 在注冊表中添加數值
    RegWriteString(MyStartupApplicationExeName);
    end
    else
    MessageBox(Handle打開注冊表失敗錯誤MB_OK+MB_ICONERROR);
    finally
    RegCloseKey;
    RegFree;
    end;
    end;

    )程序自動執行無效的菜單鼠標事件

    procedure TFormmNotautorunClick(Sender: TObject);
    var
    Reg: TRegistry;
    begin
    Reg:=TRegistryCreate;
    try
    RegRootKey:=HKEY_LOCAL_MACHINE;
    if (RegOpenKey(Software\Microsoft\Windows\CurrentVersion\RunFalse))=True then
    begin
    // 在注冊表中添加數值
    RegDeleteValue(MyStartup);
    end
    else
    MessageBox(Handle打開注冊表失敗錯誤MB_OK+MB_ICONERROR);
    finally
    RegCloseKey;
    RegFree;
    end;
    end;

    )打開光驅子菜單的事件過程

    procedure TFormMenuOpenCdrom(Sender : TObject);
    var i:integer;
    begin
    with Sender as TMenuItem do begin
    if Menuindex = mOpenCDROMCount then //判斷鼠標是否點擊所有光驅子菜單項
    begin
    for i := to Menuindex do //打開所有光驅
    begin
    // Menuindex:=i;
    Mycdrom :=pchar(mopenCdromItems[i]Caption);
    OpenCdrom(Mycdrom);
    end;
    end else
    begin
    Mycdrom :=pchar(mopenCdromItems[Menuindex]Caption);
    OpenCdrom(Mycdrom);
    end;
    end;

    )關閉光驅子菜單事件過程

    procedure TFormMenuCloseCdrom(Sender : TObject);
    var i:integer;
    begin
    with Sender as TMenuItem do begin
    if Menuindex = mCloseCDROMCount then //判斷鼠標是否點擊所有光驅子菜單項
    begin
    for i := to Menuindex do // //關閉所有光驅
    begin
    Mycdrom :=pchar(mCloseCdromItems[i]Caption);
    CloseCdrom(Mycdrom);
    end;
    end else
    Mycdrom :=pchar(mCloseCdromItems[Menuindex]Caption);
    CloseCdrom(Mycdrom);
    end;
    end;

    )關閉控制程序子菜單事件過程:

    procedure TFormmCloseAppClick(Sender: TObject);
    begin
    Applicationterminate; //程序終止
    end;

    通過上述的函數和過程實現了對光驅的控制運行以下該程序用鼠標右鍵點擊所見窗口彈出圖菜單效果選擇所要控制開關的光驅盤號顯然光驅盒開始聽任程序的擺布該程序可以進一步改造後將其窗體隱去放入狀態欄中實現程序托盤功能等由於限於篇幅將此部分省去

    本程序Windows 操作系統+ Delphi 實現和調試通過

圖 最終彈出菜單的效果圖

From:http://tw.wingwit.com/Article/program/Delphi/201311/24757.html