Detectar la Unidad de CD

[radenf]

Empezado por roman

Pues lo de profesional lo dudo porque apenas estuve investgando de eso. Y desde luego no es que sea mejor que lo tuyo sino que es distinto. Con mi código lo que haces es que tu aplicación puede estar ya ejecutándose y si alguien inserta un cd tú recibiras un evento que te pasará el drive en donde se insertó.

Este código lo englobé en la componente TCdChange que puedes ver y bajar de mi página.

// Saludos

Estimado Roman :

Es posible obtener tu componente, pues quisiera utilizarlo en mi proyecto y el link no funciona.
Saludos y gracias.

[[nlsgarcia]]

radenf,

Empezado por radenf

...Es posible obtener tu componente...

No conozco el Componente TCDChange pero puedo sugerirte otra solución equivalente.

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
    { Private declarations }
  public
    { Public declarations }
  end;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

type
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

const
  DBT_DeviceArrival = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBTF_Media = $0001;
  DBT_DevTyp_Volume = $0002;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Obtiene la Letra de una Unidad de CDROM:
function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  begin
    Maske := pDBVol^.dbcv_unitmask;
    for i := 0 to 25 do
    begin
      if (Maske and 1) = 1 then
        Result := Char(i + Ord('A')) + ':';
      Maske := Maske shr 1;
    end;
  end;
end;

// Detecta Cambios en Unidades de CDROM:
procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Drive: string;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        If Drive <> '' then
           ShowMessage('CD inserted in Drive ' + Drive);
      end;
    DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        If Drive <> '' then
           ShowMessage('CD removed from Drive ' + Drive);
      end;
  end;
end;

// Abrir un CD-ROM:
procedure TForm1.Button1Click(Sender: TObject);
begin
   mciSendString('Set cdaudio door open wait', nil, 0, handle) ;
end;

// Cerrar un CD-ROM:
procedure TForm1.Button2Click(Sender: TObject);
begin
   mciSendString('Set cdaudio door closed wait', nil, 0, handle) ;
end;

// Lista las Unidades de CDROM:
procedure TForm1.Button3Click(Sender: TObject);
var
  N: Byte;
  Drv: string;
  Drives: set of 0..25;
begin
  ListBox1.Clear;
  Integer(Drives):=GetLogicalDrives;
  for N:=0 to 25 do
    if N in Drives then
    begin
      Drv:=Char(N+Ord('A'))+':';
      if(GetDriveType(PChar(Drv))=DRIVE_CDROM) then
        ListBox1.Items.Add('Device '+ Drv + ' is a CD-Rom Drive');
    end;
end;

end.

El código anterior realiza tres funciones orientadas a las unidades de CDROM:

1- Detecta cambios en las unidades de CDROM y obtiene la letra de la unidad.

2- Permite Abrir y Cerrar un CDROM por medio de código.

3- Lista las Unidades de CDROM.


El código esta disponible en el link: http://terawiki.clubdelphi.com/Delph...+Functions.rar

Quizás esta solución se pueda adaptar a tu proyecto.

Espero sea útil

Nelson.

[radenf]

Muchas gracias [nlsgarcia]

Lo probaré y te cuento
Saludos

[roman]

Empezado por radenf

Estimado Roman :

Es posible obtener tu componente, pues quisiera utilizarlo en mi proyecto y el link no funciona.
Saludos y gracias.

Aquí hay una copia.

// Saludos

[radenf]

Muchas gracias roman.
Saludos

[radenf]

Opté por utilizar parte del código propuesto por [nlsgarcia], que es muy similar al del componente tan gentilmente enviado por roman y funciona perfecto.
Muchas gracias a ambos.
Saludos