Ovládání CD mechaniky

Ostatní jazyky Delphi Ovládání CD mechaniky

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;

 

  Aktivity (1)

Článek pro vás napsal David Čápka
Avatar
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 College Autor se informační technologie naučil na Unicorn College - prestižní soukromé vysoké škole IT a ekonomie.

Jak se ti líbí článek?
Ještě nikdo nehodnotil, buď první!


 


Miniatura
Předchozí článek
Set Of Integer pro Delphi
Miniatura
Všechny články v sekci
Delphi
Miniatura
Následující článek
Vypnuti taskmanageru u Win XP a 2K

 

 

Komentáře

Avatar
Člen
Člen
Avatar
Člen:

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.