Laufwerke in Popupmenü auflisten

[XHelp]

Meinst du so was:

[edit] Du musst noch bei PopupMenu AutoHotkeys auf maManual setzen. [/edit]

Delphi-Quellcode:

uses
 [...],MMSystem;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure MenuClick(Sender: TObject);
  private
[...]

var
  Form1: TForm1;
  Driv: array [1..25] of string;

implementation

{$R *.dfm}

function OpenCD(Drive: string): Boolean;
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;

function CloseCD(Drive: string): Boolean;
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;

procedure TForm1.MenuClick(Sender: TObject);
begin
OpenCD((Sender as TMenuItem).Caption);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  w:dword;
  Root:string;
  I, K:integer;
  a:TMenuItem;
begin
  k:=0;
  w:=GetLogicalDrives;
  Root := '#:';
  for i := 0 to 25 do
  begin
    Root[1] := Char(Ord('A')+i);
    if (W and (1 shl i))>0 then
      if GetDriveType(Pchar(Root)) = DRIVE_CDROM then
      begin
        k:=k+1;
        Driv[k] := Root;
        a:=TMenuItem.Create(PopupMenu1);
        a.Caption:=(Driv[k]);
        a.OnClick:=MenuClick;
        PopupMenu1.Items.Add(a);
      end;
  end;

end;

end.

Allerdings öffnet das programm nur. Du musst noch gucken, ob cd laufwerk schon geöffnet ist, wenn ja, dann CloseCD((Sender as TMenuItem).Caption); ausführen.

Ist es das was du wolltest?