umain.pas

可以控制多个光驱

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, Menus, ImgList, AppEvnts;

type
  TfrmMain = class(TForm)
    PopmenuCDctrl: TPopupMenu;
    mOpenCDROM: TMenuItem;
    mCloseCDROM: TMenuItem;
    mCloseApp: TMenuItem;
    N1: TMenuItem;
    il1: TImageList;
    ApplicationEvents1: TApplicationEvents;
    procedure PopmenuCDctrlPopup(Sender: TObject);
    procedure mCloseAppClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
  private
    { Private declarations }
    procedure MenuOpenCdrom(Sender: TObject);
    procedure MenuCloseCdrom(Sender: TObject);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  MYDRIVE: char;
  Mycdrom: pchar;
  tmppopmenu1, tmpPopmenu2: TMenuItem;

function OpenCDROM(Drive: pChar): Boolean; stdcall; external 'cdrom.dll';
function CloseCDROM(Drive: pChar): Boolean; stdcall; external 'cdrom.dll';

implementation

uses uCloseCD;

{$R *.dfm}

procedure TfrmMain.MenuOpenCdrom(Sender: TObject);
var i: byte;
begin
  try
    with Sender as TMenuItem do begin
      if (mOpenCDROM.Count > 1) and (Menuindex = mOpenCDROM.Count - 1) then //判断鼠标是否点击”所有光驱”子菜单项
        for i := 0 to Menuindex - 1 do //弹出所有光驱
        begin
          Mycdrom := pchar(mopenCdrom.Items[i].Caption);
          OpenCdrom(Mycdrom);
        end
      else //弹出单个光驱
      begin
        Mycdrom := pchar(mopenCdrom.Items[Menuindex].Caption);
        OpenCdrom(Mycdrom);
        frmCloseCD.ShowModal;
        //sleep(5500); //延时(毫秒)
        //CloseCdrom(Mycdrom);
      end;
    end;
  finally
    Application.terminate; //退出
  end;
end;

procedure TfrmMain.MenuCloseCdrom(Sender: TObject);
var i: byte;
begin
  try
    with Sender as TMenuItem do begin
      if (mCloseCDROM.Count > 1) and (Menuindex = mCloseCDROM.Count - 1) then //判断鼠标是否点击”所有光驱”子菜单项
        for i := 0 to Menuindex - 1 do //关闭所有光驱
        begin
          Mycdrom := pchar(mCloseCdrom.Items[i].Caption);
          CloseCdrom(Mycdrom);
        end
      else //关闭单个光驱
      begin
        Mycdrom := pchar(mCloseCdrom.Items[Menuindex].Caption);
        CloseCdrom(Mycdrom);
      end;
    end;
  finally
    Application.terminate; //退出
  end;
end;

procedure TfrmMain.PopmenuCDctrlPopup(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_RAMDISK:
        MyDrive := Drive;
      DRIVE_REMOTE:
        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;
    end;
  end;
  //当光驱多于1个生成"所有光驱"控制菜单项
  if mOpenCDROM.Count > 1 then
  begin
    tmppopmenu1 := TMenuItem.Create(Self);
    tmppopmenu1.Caption := '-';
    mOpenCDROM.Add(tmppopmenu1);
    tmppopmenu1 := TMenuItem.Create(Self);
    tmppopmenu1.Caption := '所有光驱(&A)';
    tmppopmenu1.ImageIndex := 3;
    tmppopmenu1.OnClick := menuOpenCdrom;
    mOpenCDROM.Add(tmppopmenu1);
    tmppopmenu2 := TMenuItem.Create(Self);
    tmppopmenu2.Caption := '-';
    mCloseCDROM.Add(tmppopmenu2);
    tmppopmenu2 := TMenuItem.Create(Self);
    tmppopmenu2.Caption := '所有光驱(&A)';
    tmppopmenu2.ImageIndex := 4;
    tmppopmenu2.OnClick := menuCloseCdrom;
    mCloseCDROM.Add(tmppopmenu2);
  end;
end;

procedure TfrmMain.mCloseAppClick(Sender: TObject);
begin
  Application.terminate; //退出
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var MousePos: TPoint;
begin
  Application.ShowMainForm := false; //不显示主窗口
  GetCursorPos(MousePos); //得到当前鼠标位置
  PopmenuCDctrl.Popup(MousePos.X, MousePos.Y); //菜单弹出位置
end;

procedure TfrmMain.ApplicationEvents1Deactivate(Sender: TObject);
begin //使所有窗体处在最顶端
  SetWindowPos(Application.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

end.