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