unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListBox1: TListBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  protected
    procedure WMDevicechange(var Message: TMessage); message WM_DEVICECHANGE;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MMSystem;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//
//  システムに有効なドライブの内，CD-ROMドライブだけを列挙
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LogDrives : Cardinal;
  i         : Integer;
  DriveName : String;
begin
  ListBox1.Style      := lbOwnerDrawFixed;
  ListBox1.ItemHeight := 15;

  //現在使用可能なディスクドライブのビットマスクを取得
  LogDrives := GetLogicalDrives;

　//ドライブ名の列挙
  //ドライブの最大数は25(A-Z)
  for i := 0 to 25 do begin
　　if (LogDrives and(1 shl i)) <> 0 then begin
  　　DriveName := Char(Ord('A') + i) + ':\';

      //CD-ROMドライブだけをリスト
      if GetDriveType(PChar(DriveName)) = DRIVE_CDROM then begin
        ListBox1.Items.Add(DriveName);
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  mciSendString関数を使用したCD-ROMドライブの開閉用関数
//  Drive   : ドライブ名(C:\, D:\,..のように与える
//  flgOpen : True の時は開く．Falseの時は閉じる
//
//  usesにMMSystemが必要
//-----------------------------------------------------------------------------
procedure OpenCloseCDROMDrive(Drive: String; flgOpen: Boolean);
var
  CmdStr : String;
begin
  CmdStr := 'open ' + ExcludeTrailingPathDelimiter(Drive) +
            ' type cdaudio alias cdromdrive';

  mciSendString(PChar(CmdStr), nil, 0, 0);
  try
    if flgOpen then begin
      mciSendString('set cdromdrive door open', nil, 0, 0);
    end else begin
      mciSendString('set cdromdrive door Closed', nil, 0, 0);
    end;
  finally
    mciSendString('close cdromdrive', nil, 0, 0);
  end;
end;

//=============================================================================
//  CD-ROM ドライブのトレーを開く
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
   if ListBox1.ItemIndex < 0 then exit;
   OpenCloseCDROMDrive(ListBox1.Items[ListBox1.ItemIndex], True);
end;

//=============================================================================
//  CD-ROM ドライブのトレーを閉じる
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
   if ListBox1.ItemIndex < 0 then exit;
   OpenCloseCDROMDrive(ListBox1.Items[ListBox1.ItemIndex], False);
end;

//=============================================================================
//  WM_DEVICECHANGEメッセージの処理
//  エラーの場合の処理はなし
//
//  定数値はMSDNの記事による(Delphi XEに定義はない)
//=============================================================================
procedure TForm1.WMDevicechange(var Message: TMessage);
const
  DBT_CONFIGCHANGECANCELED    = $0019;
  DBT_CONFIGCHANGED           = $0018;
  DBT_CUSTOMEVENT             = $8006;
  DBT_DEVICEARRIVAL           = $8000;
  DBT_DEVICEQUERYREMOVE       = $8001;
  DBT_DEVICEQUERYREMOVEFAILED = $8002;
  DBT_DEVICEREMOVECOMPLETE    = $8004;
  DBT_DEVICEREMOVEPENDING     = $8003;
  DBT_DEVICETYPESPECIFIC      = $8005;
  DBT_DEVNODES_CHANGED        = $0007;
  DBT_QUERYCHANGECONFIG       = $0017;
  DBT_USERDEFINED             = $FFFF;

var
  StrText : String;
begin
  inherited;

  StrText := '';
  case Message.WParam of
    DBT_DEVICEARRIVAL:        StrText := 'ディスクがセットされました';
    DBT_DEVICEREMOVECOMPLETE: StrText := 'ディスクが取り出されました';
  end;
  if StrText <> '' then MessageDlg(StrText, mtInformation, [mbOK], 0);
end;

end.