Laufwerke in Popupmenü auflisten

[CoRe.eXtreem]

Hi,
wusste keinen gescheiten Titel :oops:

zu meiner Frage:

Ich lasse mir alle CDRom Laufwerke in einem Popupmenü auflisten.
Wie kann ich jedes einzelne aufgelistete objekt belegen.

Ich wollte mit diesem code....

Delphi-Quellcode:

uses mmsystem;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if mciSendString('open G: type cdaudio alias cdlw',
                   nil,
                   0,
                   0) = 0 then
  begin
    mciSendString('set cdlw door open wait', nil, 0, 0);
    {oder closed wait zum schliessen}
    mciSendString('close cdlw', nil, 0, 0)
  end;

...die Laufwerke je nach Laufwerkstyp (d:\,e:\,f:\) ein/auswerfen!

Danke, CoRe.eXtreem

[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?

[CoRe.eXtreem]

Boahhhh genau das habe ich gesucht...

Vielen Dank XHElP :dp:

[CoRe.eXtreem]

Mit diesem Code versuche ich zu überprüfen ob das laufwerk geöffnet ist,
aber irgendwie bekomme ich nur den Status "Open"??

Delphi-Quellcode:

uses 
  mmsystem; 
  
procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: array[0..64] of Char; 
  error: Cardinal; 
  Text: array[0..255] of Char; 
begin 
  error := mciSendstring('open cdaudio alias geraet', nil, 0, Handle); 
  if error <> 0 then 
  begin 
    mciGetErrorstring(error, @Text, 255); 
    ShowMessage(Text); 
    mciSendstring('close geraet', nil, 0, Handle); 
    Exit; 
  end; 

  error := mciSendstring('status geraet mode', @s, SizeOf(s), Handle); 
  if error <> 0 then 
  begin 
    mciGetErrorstring(error, @Text, 255); 
    ShowMessage(Text); 
    mciSendstring('close geraet', nil, 0, Handle); 
    Exit; 
  end; 

  mciSendstring('close geraet', nil, 0, Handle); 
  ShowMessage('Message: ' + s); 
end;

Was mache ich falsch??