project1.~dpr

delphi 控制光驱的探出与关闭 源代码

program Project2;

uses
  Windows,
  MMsystem;

{$R *.res}

var
  handle: THandle;
  ret: Longword;
  str: string;
  drivers: integer;
  driver: char;
  i, temp: integer;


  Res: MciError;
  OpenParm: TMCI_OPEN_Parms;
  MCIS: MCI_STATUS_PARMS;
  Flags: Dword;
  s: string;
  DeviceID: Word;
begin

  drivers := getlogicaldrives;
  temp := (1 and drivers);
  for i := 0 to 25 do //26个英文字母
  begin
    if temp = 1 then
    begin
      driver := char(i + integer('a'));
      str := driver + ':';
      if getdrivetype(pchar(str)) = DRIVE_CDROM then
      begin
        flags := mci_Open_Type or mci_Open_Element;
        with OpenParm do
        begin
          dwCallBack := 0;
          lpstrDeviceType := 'CDAudio';
          lpstrElementName := PChar(str);
        end;
        Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
        if Res <> 0 then exit;
        DeviceID := OpenParm.wDeviceID;
        try
          MCIS.dwItem := MCI_STATUS_READY;
          mciSendCommand(DeviceID, MCI_STATUS, MCI_STATUS_ITEM or MCI_WAIT, LongInt(@MCIS));
          if MCIS.dwReturn <> 0
           then mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0)
           else mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0)
        finally
          mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
        end;
      end;
    end;

    drivers := (drivers shr 1);
    temp := (1 and drivers);

  end; //for

end.