Skub CD-drev ind og ud

uses
  MMSystem;

procedure TForm2.Button1Click(Sender: TObject);
var
  OpenParm: TMCI_Open_Parms;
  SetParm: TMCI_Set_Parms;
  DeviceID: Word;
begin
  OpenParm.lpstrDeviceType := \'cdaudio\';
  MCISendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_WAIT, Longint(@OpenParm));
  DeviceID := OpenParm.wDeviceID;
  mciSendCommand(DeviceID, mci_Set, mci_Set_Door_Open, Longint(@SetParm) );
end;

weis: Du kan hente et komplet eksempel på nedenståede link:

http://home1.inet.tele.dk/j-cgeert/cdrom.zip

Bemærk at der går lidt tid inden teksten på knappen skifter da cd\'en først lige skal loades!

Komplet kode:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, MPlayer, MMSystem;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function IsDriveCD(Drive : char) : longbool;
var  DrivePath : string;
begin
  DrivePath := Drive + \':\\\';
  result := LongBool(GetDriveType(PChar(DrivePath)) and DRIVE_CDROM);
end;

function EjectCD(Drive : char) : bool;
var
  mp : TMediaPlayer;
begin
  result := false;
  Application.ProcessMessages;
  if not IsDriveCD(Drive) then exit;
  mp := TMediaPlayer.Create(nil);
  mp.Visible := false;
  mp.Parent := Application.MainForm;
  mp.Shareable := true;
  mp.DeviceType := dtCDAudio;
  mp.FileName := Drive + \':\';
  mp.Open;
  Application.ProcessMessages;
  mp.Eject;
  Application.ProcessMessages;
  mp.Close;
  Application.ProcessMessages;
  mp.free;
  result := true;
end;

procedure CloseCD(Drive : char);
var
  mp : TMediaPlayer;
begin
//  result := false;
  Application.ProcessMessages;
  mp := TMediaPlayer.Create(nil);
  mp.Visible := false;
  mp.Parent := Application.MainForm;
  mp.Shareable := true;
  mp.DeviceType := dtCDAudio;
  mp.FileName := Drive + \':\';
  mp.Open;
  Application.ProcessMessages;
  mciSendCommand(mp.DeviceID,
  MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  Application.ProcessMessages;
  mp.Close;
  Application.ProcessMessages;
  mp.free;
//  result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  If Button1.Caption = \'Eject\' then begin
    if not EjectCD(\'F\') then
      ShowMessage(\'Not A CD Drive\')
    else
      Button1.Caption := \'Close\';
  end
  else begin
    CloseCD(\'F\');
    Button1.Caption := \'Eject\';
  end;
end;

end.



Snowball

Da jeg har to drev (drev-F og drev-E) troede jeg at jeg kunne kopier teksten og kun ændre hvad der skulle stå på knappen og ændre \"EjectCD(\'F\')\" til \"EjectCD(\'E\')\", men det lykkedes ikke...
    Ved i hvorfor???

Andreas

OK! Brug nedenstående kode i stedet. Der kan du selv vælge hvilket drev det drejer sig om!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, MMSystem;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure OpenCloseCD(Drive: String; OpenCD: Boolean);
var
  OpenParm: TMCI_Open_Parms;
begin
  OpenParm.dwCallback := 0;
  OpenParm.lpstrDeviceType := \'CDAudio\';
  OpenParm.lpstrElementName := PChar(Drive);

  if OpenCD then
  begin
    mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longint(@OpenParm));
    mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
  end
  else
  begin
    mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longint(@OpenParm));
    mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
  end;
  mciSendCommand(OpenParm.wDeviceID, MCI_CLOSE, MCI_NOTIFY, Longint(@OpenParm));
  OpenCD := not OpenCD;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  If Button1.Caption = \'Eject\' then begin
    OpenCloseCD(\'j:\\\',True); //Åben drev
    Button1.Caption := \'Close\';
  end
  else begin
    OpenCloseCD(\'j:\\\',False); //Luk drev
    Button1.Caption := \'Eject\';
  end;
end;

end.


Snowball

>>Snowball

Nu hvor du ved så meget om Cd-drev kunne du så ikke lige tjekke dette spørgsmål...

http://www.eksperten.dk/spm/57454

Og se om du kan hjælpe....

Andreas