uses DBT !
TDeviceType = ( dtOEM,
dtDEVNODE,
dtVOLUME,
dtPORT,
dtNET,
dtDEVICEINTERFACE,
dtHANDLE);
TPortEvent =
procedure( Sender: TObject; Port:
String )
of object;
TDeviceChangeEvent =
procedure ( Sender: TObject;
FirstDriveLetter : Char)
of object;
T??? =
class(TComponent)
private
FWindowHandle : HWND;
FOnPortRemovePending : TPortEvent;
FOnPortRemoved : TPortEvent;
FOnPortArrival : TPortEvent;
procedure WndProc(
var Msg: TMessage);
protected
procedure WMDeviceChange(
var Msg : TWMDeviceChange);
dynamic;
published
property AfterArrival : TDeviceChangeEvent
read FAfterArrival
write FAfterArrival;
property AfterRemove : TDeviceChangeEvent
read FAfterRemove
write FAfterRemove;
property OnPortRemovePending : TPortEvent
read FOnPortRemovePending
write FOnPortRemovePending;
property OnPortRemoved : TPortEvent
read FOnPortRemoved
write FOnPortRemoved;
property OnPortArrival : TPortEvent
read FOnPortArrival
write FOnPortArrival;
end;
procedure Register;
implementation
function CDDevTypeToStr( Value: Longint ):
String;
begin
case Value
of
DBT_DEVTYP_OEM : Result := '
oem-defined device type';
DBT_DEVTYP_DEVNODE : Result := '
devnode number';
DBT_DEVTYP_VOLUME : Result := '
logical volume';
DBT_DEVTYP_PORT : Result := '
port serial or parallel';
DBT_DEVTYP_NET : Result := '
network resource';
DBT_DEVTYP_DEVICEINTERFACE : Result := '
device interface class';
DBT_DEVTYP_HANDLE : Result := '
file system handle';
end;
end;
constructor T???.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
end;
destructor T???.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
function T???.GetFirstDriveLetter(UnitMask : LongInt) : Char;
var
DriveLetter : ShortInt;
begin
DriveLetter := Ord('
A');
while (UnitMask
and 1) = 0
do
begin
UnitMask := UnitMask
shr 1;
inc(DriveLetter);
end;
Result := Char(DriveLetter);
end;
procedure T???.WndProc(
var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE)
then
begin
try
WMDeviceChange(TWMDeviceChange(Msg));
except
Application.HandleException(Self);
end;
end
else
Msg.Result := DefWindowProc( FWindowHandle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure T???.WMDeviceChange(
var Msg : TWMDeviceChange);
var
lpdb : PDevBroadcastHdr;
lpdbv : PDevBroadcastVolume;
lpdbp : PDevBroadCastPort;
Port : PChar;
begin
lpdb := PDevBroadcastHdr(Msg.dwData);
case Msg.Event
of
DBT_DEVICEARRIVAL :
begin
if lpdb^.dbch_devicetype = DBT_DEVTYP_VOLUME
then
begin
lpdbv := PDevBroadcastVolume(Msg.dwData);
if (lpdbv^.dbcv_flags
and DBTF_MEDIA) = 1
then
if Assigned(FAfterArrival)
then
FAfterArrival(Self, GetFirstDriveLetter(lpdbv^.dbcv_unitmask));
exit;
end;
if lpdb^.dbch_devicetype = DBT_DEVTYP_PORT
then
begin
lpdbp := PDevBroadCastPort(Msg.dwData);
if Assigned( FOnPortArrival )
and
( lpdbp^.dbcp_devicetype = DBT_DEVTYP_PORT )
then
FOnPortArrival( Self, PChar( @lpdbp^.dbcp_name ));
end;
end;
DBT_DEVICEQUERYREMOVE:
begin
end;
DBT_DEVICEQUERYREMOVEFAILED:
begin
end;
DBT_DEVICEREMOVEPENDING:
begin
if lpdb^.dbch_devicetype = DBT_DEVTYP_PORT
then
begin
lpdbp := PDevBroadCastPort(Msg.dwData);
if Assigned( FOnPortRemovePending )
and
( lpdbp^.dbcp_devicetype = DBT_DEVTYP_PORT )
then
FOnPortRemovePending( Self, PChar( @lpdbp^.dbcp_name ));
end;
end;
DBT_DEVICEREMOVECOMPLETE :
begin
if lpdb^.dbch_devicetype = DBT_DEVTYP_VOLUME
then
begin
lpdbv := PDevBroadcastVolume(Msg.dwData);
if (lpdbv^.dbcv_flags
and DBTF_MEDIA) = 1
then
if Assigned(FAfterArrival)
then
FAfterRemove(Self, GetFirstDriveLetter(lpdbv^.dbcv_unitmask));
end;
if lpdb^.dbch_devicetype = DBT_DEVTYP_PORT
then
begin
lpdbp := PDevBroadCastPort(Msg.dwData);
if Assigned( FOnPortRemoved )
and
( lpdbp^.dbcp_devicetype = DBT_DEVTYP_PORT )
then
FOnPortRemoved( Self, PChar( @lpdbp^.dbcp_name ));
end;
end;
DBT_DEVICETYPESPECIFIC:
begin
end;
DBT_CUSTOMEVENT:
begin
end;
end;
end;
procedure Register;
begin
RegisterComponents( xxx, [T???]);
end;