Ver Mensaje Individual
  #4  
Antiguo 09-06-2005
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Reputación: 28
Lepe Va por buen camino
Código Delphi [-]
unit CdUtils;

interface

const
  DBT_DEVICEARRIVAL = $8000;
  DBT_DEVICEREMOVECOMPLETE = $8004;

  DBT_DEVTYP_VOLUME = $00000002;
  DBTF_MEDIA = $0001;

type
  PDevBroadcastHeader = ^TDevBroadcastHeader;
  TDevBroadcastHeader = record
    Size: Cardinal;
    DeviceType: Cardinal;
    Reserved: Cardinal;
  end;

  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = record
    Size: Cardinal;
    DeviceType: Cardinal;
    Reserved: Cardinal;
    UnitMask: Cardinal;
    Flags: Word;
  end;

  TWMDeviceChange = packed record
    Msg: Cardinal;
    Event: LongInt;
    Header: PDevBroadcastVolume;
    Result: LongInt;
  end;

function GetDriveFromMask(Mask: Cardinal): Char;

implementation

const
  MAX_DRIVES = 26;

function GetDriveFromMask(Mask: Cardinal): Char;
var
  I: Byte;

begin
  for I := 1 to MAX_DRIVES do
  begin
    if (Mask and $01 <> 0) then break;
    Mask := Mask shr 1;
  end;

  Result := Chr(Ord('A') + I);
end;

end.

Código Delphi [-]
unit CdChange;

interface

uses
  Windows, Messages, Classes, CdUtils;

type
  TCdChangeEvent = procedure(Sender: TObject; Drive: Char) of object;

  TCdChange = class(TComponent)
  private
    InternalWindow: HWnd;
    procedure WndProc(var Msg: TMessage); virtual;

  private
    FActive: Boolean;
    FOnCdInserted: TCdChangeEvent;
    FOnCdRemoved: TCdChangeEvent;

    procedure SetActive(Value: Boolean);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Active: Boolean read FActive write SetActive default false;
    property OnCdInserted: TCdChangeEvent read FOnCdInserted write FOnCdInserted;
    property OnCdRemoved: TCdChangeEvent read FOnCdRemoved write FOnCdRemoved;
  end;

procedure Register;

implementation

constructor TCdChange.Create(AOwner: TComponent);
begin
  inherited;
  FActive := false;
end;

destructor TCdChange.Destroy;
begin
  Active := false;
  inherited;
end;

procedure TCdChange.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;

    if not (csDesigning in ComponentState) then
      if Active
        then InternalWindow := AllocateHWnd(WndProc)
        else DeallocateHWnd(InternalWindow);
  end;
end;

procedure TCdChange.WndProc(var Msg: TMessage);
var
  Drive: Char;

begin
  if Msg.Msg = WM_DEVICECHANGE then
    with TWMDeviceChange(Msg) do
      if
        ((Event = DBT_DEVICEARRIVAL) or (Event = DBT_DEVICEREMOVECOMPLETE)) and
        (Header.DeviceType = DBT_DEVTYP_VOLUME) and
        (PDevBroadcastVolume(Header).Flags and DBTF_MEDIA <> 0)
      then
      begin
        Drive := GetDriveFromMask(PDevBroadcastVolume(Header).UnitMask);

        case Event of
          DBT_DEVICEARRIVAL:
            if Assigned(FOnCdInserted) then FOnCdInserted(Self, Drive);

          DBT_DEVICEREMOVECOMPLETE:
            if Assigned(FOnCdRemoved) then FOnCdRemoved(Self, Drive);
        end;
      end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TCdChange]);
end;

end.

Un saludo
__________________
Si usted entendió mi comentario, contácteme y gustosamente,
se lo volveré a explicar hasta que no lo entienda, Gracias.
Responder Con Cita