Ver Mensaje Individual
  #10  
Antiguo 04-03-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
radenf,

Cita:
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.

Última edición por nlsgarcia fecha: 04-03-2013 a las 02:30:35.
Responder Con Cita