Manison Softworks

CD-ROM, CD-ROM...
Windows API

V článku se podíváme na některé možnosti, které Windows nabízejí pro práci s jednotkou CD-ROM.

Seznam jednotek

Pro získání seznamu nainstalovaných jednotek CD-ROM použijeme funkce GetLogicalDrives a GetDriveType. První z jmenovaných vrací bitovou masku diskových jednotek. Nejnižší bit vráceného dvojslova reprezentuje jednotku A:, druhý bit jednotku B: atd. Pokud je jednotka momentálně dostupná je příslušný bit nastaven. GetDriveType má jeden parametr specifikující kořenový adresář jednotky, jejíž typ chceme zjistit. Výsledkem je konstanta DRIVE_xxx, nás bude zajímat především hodnota DRIVE_CDROM. Pojďme se podívat na konkrétní příklad:

procedure ListCdDrives(List: TStrings);
var
  Drives: Cardinal;
  i: Integer;
  Root: string;
begin
  Drives := GetLogicalDrives;
  for i := 0 to Ord('Z')-Ord('A')-1 do begin
    if (Drives and 1) = 1 then begin
      Root := Chr(Ord('A')+i)+':\';
      if GetDriveType(PChar(Root)) = DRIVE_CDROM then List.Add(Root);
    end;
    Drives := Drives shr 1;
  end;
end;

Získanou bitovou masku procházíme bit po bitu (if (Drives and 1) = 1... a Drives := Drives shr 1), pokud je bit nastaven, zjistíme jemu odpovídající písmeno disku (Chr(Ord('A')+i)) a nakonec určíme, zda je disk CD-ROM mechanika (GetDriveType(...) = DRIVE_CDROM).

Test přítomnosti CD v jednotce

K zjištění, zda jednotka obsahuje disk nebo zda je prázdná můžeme v Delphi použít funkci DirectoryExists.

function MediumPresent(const Root: string): Boolean;
var
  SavedErrorMode: Cardinal;
begin
  SavedErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS)
  Result := DirectoryExists(Root);
  SetErrorMode(SavedErrorMode);
end;

Nejdříve voláním SetErrorMode(SEM_FAILCRITICALERRORS) řekneme Windows, že se o všechny případné chyby postaráme sami. Pokud bychom to neudělali a volali naši funkci MediumPresent v případě, že by v jednotce nebyl disk, Windows by zobrazily dialogové okno s požadavkem na vložení disku. Takto proběhne vše tichosti. Poté funkcí DirectoryExists zjistíme, zda existuje kořenový adresář na disku CD. Nakonec obnovíme původní chování Windows při výskytu chyby.

Jmenovka a sériové číslo

Funkce GetVolumeInformation vrací spoustu užitečných informací o jakékoliv diskové jednotce. My s pomocí této funkce získáme jmenovku a sériové číslo vloženého disku.

procedure GetMediumInfo(const Root: string; var Serial: Cardinal;
  var Name: string);
var
  szName: array [0..MAX_PATH-1] of Char;
  Dummy1, Dummy2: Cardinal;
begin
  if not GetVolumeInformation(
    PChar(Root),		// kořenový adresář jednotky o niž požadujeme info
    szName,		// buffer pro uložení jmenovky
    Length(szName),	// velikost bufferu
    @Serial,		// sériové číslo
    Dummy1,
    Dummy2,
    nil,
    0) then
      RaiseLastWin32Error
  else
    Name := szName;
end;

Ovládání dvířek

Nyní si ukažme, jak programově vysouvat a zasouvat dvířka CD-ROM jednotky. Jedním z možných a nejjednodušších postupů je využít služeb Media Control Interface (MCI).

uses Windows, SysUtils, Classes, MMSystem;
...
type
  TCdDoorOp = (cdOpen, cdClose);
...
procedure OpenCloseCd(const Root: string; Operation: TCdDoorOp);
var
  mciErr: MCIERROR;
  mciParms: TMCI_Open_Parms;
  mciFlags: Cardinal;
begin
  FillChar(mciParms, SizeOf(mciParms), 0);
  with mciParms do begin
    lpstrDeviceType := PChar(MCI_DEVTYPE_CD_AUDIO);
    lpstrElementName := PChar(Root);
  end;
  mciErr := mciSendCommand(0, MCI_OPEN,
    MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID or MCI_OPEN_ELEMENT,
    Cardinal(@mciParms));
  if mciErr = 0 then begin
    if Operation = cdOpen then
      mciFlags := MCI_SET_DOOR_OPEN
    else
      mciFlags := MCI_SET_DOOR_CLOSED;
    mciSendCommand(mciParms.wDeviceID, MCI_SET, mciFlags, 0);
    mciSendCommand(mciParms.wDeviceID, MCI_CLOSE, 0,
      Cardinal(@mciParms));
  end;
end;

S každým zařízením se přes služby MCI komunikuje prostředníctvím množství příkazů, které jsou zasílány funkcí mciSendCommand. Pro další práci je třeba nejprve dané zařízení otevřít příkazem MCI_OPEN. Záznam TMCI_Open_Parms obsahuje dodatečné parametry (typ a specifikaci) zařízení, které se pokoušíme otevřít. Pokud se systému podaří otevřít námi požadované zařízení, obsahuje prvek záznamu wDeviceID identifikátor, který použijeme při další komunikaci s jednotkou. Příkazem MCI_SET s dodatečným parametrem MCI_SET_DOOR_OPEN nebo MCI_SET_DOOR_CLOSED vysuneme resp. zasuneme dvířka jednotky. Nakonec je třeba otevřené zařízení zavřít příkazem MCI_CLOSE.

Oznámení o otevření / zavření dvířek

Dvířka už umíme vysouvat a zasouvat, ale občas potřebujeme zjistit, kdy uživatel z jednotky vyjme CD nebo kdy vloží nový disk. Naštěstí Windows posílají oknům zprávu WM_DEVICECHANGE právě když se vyskytne tato událost.

TForm1 = class(TForm1)
...
private
  procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
...
end;
...
procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  PVolume: PDevBroadcastVolume;
  Drive: Char;
begin
  Msg.Result := 1;
  PVolume := PDevBroadcastVolume(Msg.LParam);
  if PVolume^.dbcv_devicetype <> DBT_DEVTYP_VOLUME then Exit;
  if PVolume^.dbcv_flags <> DBTF_MEDIA then Exit;
  Drive := DriveLetterFromMask(PVolume^.dbcv_unitmask);
  if Drive = #0 then Exit;
  case Msg.WParam of
    DBT_DEVICEARRIVAL:
      ShowMessage(Format('Do jednotky %s:\ byl vložen disk.', [Drive]));
  DBT_DEVICEREMOVECOMPLETE:
      ShowMessage(Format('Z jednotky %s:\ byl vyjmut disk.', [Drive]));
  end;
end;

V obsluze zprávy WM_DEVICECHANGE je LParam ukazatel na záznam typu TDevBroadcastVolume, který obsahuje podrobnosti o vzniklé události. Protože umíme obsloužit jen události typu DBT_DEVTYP_VOLUME, zkontrolujeme hlavičku záznamu a pokud se jedná známou událost bude nás zajímat prvek dbcv_unitmask. To je bitová maska jednotky, stejná jako v prvním příkladu, kdy jsme vytvářeli seznam jednotek. Funkcí DriveLetterFromMask (z unit CDTool.pas, ke stažení na konci článku) převedeme bitovou masku na písmeno jednotky. Pak už nás zajímá jen typ události: DBT_DEVICEARRIVAL při vložení nového disku a DBT_DEVICEREMOVECOMPLETE při vyjmutí CD z jednotky.

Automatické přehrání

Díky souboru autorun.inf uloženému v kořenovém adresáři disku CD můžeme přiřadit disku ikonku nebo po vložení do jednotky spustit libovolnou aplikaci.

[AutoRun]
icon=ikona.ico
label=Můj disk
shellexecute=ČtiMě.txt
shell=notepad
shell\notepad=Poznámkový blok
shell\notepad\command=c:\windows\notepad.exe

Struktura souboru autorun.inf je podobná struktuře ini souborům. V sekci AutoRun mohou být uvedeny následující položky:

icon
Přiřadí disku ikonu. Může být také ve formátu např. aplikace.exe,1 což znamená, že disku bude přiřazena druhá ikona ze souboru aplikace.exe.

label
Text, který bude zobrazen u ikony disku.

shellexecute
Jméno dokumentu nebo programu, který se spustí po vložení disku do jednotky. Pro počítače, kde není nainstalován Internet Explorer 5 nebo vyšší musíte použít místo shellexecute atribut open, který ale umožňuje spouštět jenom aplikace. Pokud po vložení CD chcete zobrazit např. textový soubor musíte vytvořit malý program, který pro otevření dokumentu použije funkci ShellExecute.

Soubor autorun.inf má několik dalších možností, můžete například rozšířit kontextové menu disku, jak je naznačeno na posledních třech řádcích ukázky. Pro Windows XP můžete specifikovat složky, kde bude probíhat vyhledávání ovladačů při instalaci nového zařízení.
Navíc soubor autorun.inf se nemusí používat výhradně na discích CD-ROM, ale můžete tak také velmi snadno změnit např. ikonu vašeho pevného disku.
Automatickému přehrání disku můžeme zabránit přidržením klávesy Shift při vkládání disku do jednotky. Jak ale zabránit této akci programově?

TForm1 = class(TForm1)
...
protected
  msgCancelAutoplay: Cardinal;
  procedure WndProc(var Msg: TMessage); override;
...
end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  msgCancelAutoplay := RegisterWindowMessage('QueryCancelAutoPlay');
end;

procedure TForm1.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = msgCancelAutoplay then
    Msg.Result := 1;
  else
    inherited;
end;

Při vytvoření formuláře zaregistrujeme zprávu 'QueryCancelAutoPlay'. Potom vždy, když je náš furmulář aktivní a má dojít k automatickému přehrání obdržíme zprávu, jejímž výsledkem bude nenulová hodnota pokud se má automatické přehrání zrušit.

Vypalovací jednotky

Nakonec si ukážeme, jaké nové možnosti poskytují Windows XP pro práci s vypalovacími mechanikami.

ICDBurn = interface(IUnknown)
  function GetRecorderDriveLetter(pszDrive: LPWSTR;
    cch: UINT): HResult; stdcall;
  function Burn(hwnd: HWND): HResult; stdcall;
  function HasRecordableDrive(out pfHasRecorder: BOOL): HResult; stdcall;
end;

Rozhraní ICDBurn má tři metody:
GetRecorderDriveLetter - vrací písmeno jednotky, která se používá k zápisu
Burn - spustí průvodce zápisem souborů na CD
HasRecordableDrive - informuje, zda je na počítači nainstalovaná nějaká jednotka, umožňující zápis na disk CD Rozhraní ICDBurn vytvoříme následovně:

var
  CDBurn: ICDBurn;
...
  CDBurn := CreateComObject(CLSID_CDBurn) as ICDBurn;
  // nyní již můžeme používat rozhraní ICDBurn, např.:
  CDBurn.Burn(Handle);

Adresář, kde jsou uloženy soubory před jejich vypálením na disk, zjistíme funkcí SHGetSpecialFolderPath:

function CdRwPath: string;
var
  path: array [0..MAX_PATH-1] of Char;
begin
  if SHGetSpecialFolderPath(Handle, path, CSIDL_CDBURN_AREA, False) then
    Result := path
  else
    Result := '';
end;

Download

V přiloženém projektu najdete kromě výše zmíněných funkcí také ukázku toho, jak jednotku CD-ROM zamknout a zabránit tak vysunutí disku.

Stáhnout projekt pro Delphi 5 (7 KB)
Stáhnout ukázkovou aplikaci (182 KB)