Ovládání CD mechaniky

Tento výukový obsah pomáhají rozvíjet následující firmy, které dost možná hledají právě tebe!

Následující kód otevře CD mechaniku v Delphi. Vyžaduje knihovnu MMSystem.

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


function Uvnitr(Drive: Char): boolean;
var DrivePath: string;
    DriveResult: integer;
begin
 DrivePath := Drive + ':\';
 DriveResult := GetDriveType(PChar(DrivePath));
 Result := DriveResult = DRIVE_CDROM;
end;