Detectar CD no Driver via Delphi

[Jimmy Sofwatres]

Olá!, estou fazendo um aplicativo para a empresa onde trabalho e precisaria que o mesmo detectasse se foi iserido alguma midia de CD ou DVD no driver, andei pesquisando e consegui o codigo abaixo, mas não estou conseguindo usa-lo.

Código:

Function MidiaPresente(MediaPlayer: TMediaPlayer): Boolean;

var

Params: MCI_STATUS_PARMS;

S: array [0..255] of char;

r: Integer;

begin

//verifica se existe um cd inserido

Params.dwItem:= MCI_STATUS_MEDIA_PRESENT;

r:= MCISendCommand(MediaPlayer.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Integer(Addr(Params)));

if r <> 0 then

begin

MCIGetErrorString(r, S, SizeOf(S));

ShowMessage('Erro: ' + StrPas(S));

end

else

Result:= Params.dwReturn = 1;

end;

Inseri o componente MediaPlayer1 e declarei na USES MMSystem e fiz a compilação ele compila normalmente, mas ainda não estou conseguindo utiliza-lo.

alguém sabe como utilizar esta função???

[Jhonas]

veja esse código

http://www.swissdelphicenter.ch/torry/showcode.php?id=663

abraço

[Jimmy Sofwatres]

Valeu Muito obrigado Jhonas, mas aqui eu fiz o teste e só aparece a mensagem que o cd não esta no driver, mesmo com o cd dentro deste, estou tentando implementar aqui se conseguir eu posto ai beleza.

[Jhonas]

Valeu Muito obrigado Jhonas, mas aqui eu fiz o teste e só aparece a mensagem que o cd não esta no driver

faça essa correção:

USES MMSystem;

function IsAudioCD(Drive: Char): Boolean;
var
  DrivePath: string;
  MaximumComponentLength: DWORD;
  FileSystemFlags: DWORD;
  VolumeName: string;
  OldErrorMode: UINT;
  DriveType: UINT;
begin
  Result := False;
  DrivePath := Drive + ':';  // alteração nessa linha
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    DriveType := GetDriveType(PChar(DrivePath));
  finally
    SetErrorMode(OldErrorMode);
  end;
  if DriveType <> DRIVE_CDROM then
    Exit;
  SetLength(VolumeName, 64);
  GetVolumeInformation(PChar(DrivePath),
    PChar(VolumeName),
    Length(VolumeName),
    nil,
    MaximumComponentLength,
    FileSystemFlags,
    nil,
    0);
  if lStrCmp(PChar(VolumeName), 'Audio CD') = 0 then Result := True; // alteração nessa linha
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  // coloque a letra do drive onde está o CD de audio

  if IsAudioCD('E') then
    ShowMessage('Audio-CD encontrado no drive E.')
  else
    ShowMessage('Audio-CD não encontrado no drive E.');
end;

abraço

[Jimmy Sofwatres]

Valeu Jhonas, ainda aparece a mensagem que o cd não foi encontrado mesmo com o cd dentro, mas creio eu que é porque eu não esteja utilizando um cd de audio, é que eu preciso saber se qualquer tipo de cd for inserido... Estou implementando umas funçoes aqui para identificar as unidades depois saber qual são as de cd-rom e verificar se estas estao prontas e ejeta-las... assim que terminar eu posto aqui, é uma forma mais longa de se fazer, mas é a minah opção no momento, mas faleu pela força, graças a você se eu precisar de uma função para um programa de cadastro de musicas ou cds eu já tenho valeu obrigado...

[Jhonas]

é que eu preciso saber se qualquer tipo de cd for inserido

Neste caso fica assim:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    num : integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

USES MMSystem;

function IsAudioCD(Drive: Char): Boolean;
var
  DrivePath: string;
  MaximumComponentLength: DWORD;
  FileSystemFlags: DWORD;
  VolumeName: string;
  OldErrorMode: UINT;
  DriveType: UINT;
begin
  Result := False;
  DrivePath := Drive + ':';  // alteração nessa linha
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    DriveType := GetDriveType(PChar(DrivePath));
  finally
    SetErrorMode(OldErrorMode);
  end;
  if DriveType <> DRIVE_CDROM then
    Exit;
  SetLength(VolumeName, 64);
  GetVolumeInformation(PChar(DrivePath),
    PChar(VolumeName),
    Length(VolumeName),
    nil,
    MaximumComponentLength,
    FileSystemFlags,
    nil,
    0);
  if lStrCmp(PChar(VolumeName), 'Audio CD') = 0 then
     begin
       Result := True;
       Form1.num := 0;
     end;
  if lStrCmp(PChar(VolumeName), 'Audio CD') > 0 then
     begin
       Result := true;
       Form1.num := 1;
     end;
  if lStrCmp(PChar(VolumeName), 'Audio CD') <> 0 then
     begin
       Result := false;
       Form1.num := -1;
     end;

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  // coloque a letra do drive onde está o CD

  if IsAudioCD('E') and (num = 0) then begin
     ShowMessage('Audio-CD encontrado no drive E.'); exit; end else
  if IsAudioCD('E') and (num > 0) then begin
    ShowMessage('CD encontrado no drive E.'); exit; end else
  if (num < 0) then
    ShowMessage('Nenhum CD encontrado no drive E.');
end;


end.

abraço