Drive - descobrindo a letra da unidade de cd-rom, abrindo e fechando a gaveta de cds

Descobrindo a letra da unidade de CD-Rom, abrindo e fechando a gaveta de CDs

Nesta dica veremos como descobrir a letra da unidade de CD e como abrir e fechar o drive de CD.

Para isso crie uma aplicação e adicione ao Form 3 componentes TButton. Faça a declaração CDROMDrive na área de declarações public como pode ser visto abaixo:

public

  { Public declarations }

  Function CDROMDrive: Char;

Declare uso da biblioteca MMSystem na área uses da Unit

Logo em seguida, copie a função na área implementation

Function TForm1.CDROMDrive: Char;

Var 

  drivemap, mask: DWORD; 

  i: Integer; 

  root: String; 

Begin 

  Result := #0; 

  root := 'A:\'; 

  drivemap := GetLogicalDrives; 

  mask := 1;

  For i:= 1 To 32 Do 

  Begin 

    If (mask and drivemap) <> 0 Then 

    If GetDriveType( PChar(root) ) = DRIVE_CDROM Then 

    Begin 

      Result := root[1]; 

      Break; 

    End; 

    mask := mask shl 1; 

    Inc( root[1] ); 

  End; 

End; 

Faça a chamada à função CDROMDrive no evento OnClick do Button1. A mensagem de retorno do ShowMessage nos mostra a letra da unidade de CD.

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage('CD-ROM Drive -> '+CDROMDrive );

end;

Agora veremos como abrir e fechar a gaveta de CDs. Para isso usaremos a função mciSendString.

O código abaixo é responsável pela abertura da gaveta do CD. Copie o código no evento OnClick do Button2.

procedure TForm1.Button2Click(Sender: TObject);

begin

  mciSendString('Set cdaudio door open wait', nil, 0, handle);

end;

O código abaixo é responsável pelo fechamento da gaveta do CD. Copie o código no evento OnClick do Button3.

procedure TForm1.Button3Click(Sender: TObject);

begin

  mciSendString('Set cdaudio door closed wait', nil, 0, handle);

end;