September discount week
Pouze tento týden sleva až 80 % na e-learning týkající se MS Office
50 % bodů zdarma na online výuku díky naší Slevové akci!

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;

 

Všechny články v sekci
Delphi
Článek pro vás napsal David Čápka
Avatar
Jak se ti líbí článek?
Ještě nikdo nehodnotil, buď první!
Autor pracuje jako softwarový architekt a pedagog na projektu ITnetwork.cz (a jeho zahraničních verzích). Velmi si váží svobody podnikání v naší zemi a věří, že když se člověk neštítí práce, tak dokáže úplně cokoli.
Unicorn university Autor sítě se informační technologie naučil na Unicorn College - prestižní soukromé vysoké škole IT a ekonomie.
Aktivity (1)

 

 

Komentáře

Avatar
Člen
Člen
Avatar
Člen:15.9.2014 17:08

Uzitocny kod :D

Odpovědět
15.9.2014 17:08
...
Děláme co je v našich silách, aby byly zdejší diskuze co nejkvalitnější. Proto do nich také mohou přispívat pouze registrovaní členové. Pro zapojení do diskuze se přihlas. Pokud ještě nemáš účet, zaregistruj se, je to zdarma.

Zobrazeno 1 zpráv z 1.