Hledáme nové posily do ITnetwork týmu. Podívej se na volné pozice a přidej se do nejagilnější firmy na trhu - Více informací.
Pouze tento týden sleva až 80 % na e-learning týkající se Swiftu. Zároveň využij výhodnou slevovou akci až 30 % zdarma při nákupu e-learningu - více informací.
discount 30 + hiring

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
Uživatelské hodnocení:
Ještě nikdo nehodnotil, buď první!
David je zakladatelem ITnetwork a programování se profesionálně věnuje 13 let. Má rád Nirvanu, sushi a svobodu podnikání.
Unicorn university David se informační technologie naučil na Unicorn University - prestižní soukromé vysoké škole IT a ekonomie.
Aktivity

 

 

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.