你要去钩那个消息。例子程序:
const
DBT_DEVICEARRIVAL = $8000;
// system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004;
// device is gone
DBT_DEVTYP_VOLUME = $00000002;
// logical volume
DBTF_MEDIA = $0001;
// media comings and goings
type
PDEV_BROADCAST_HDR = ^TDEV_BROADCAST_HDR;
TDEV_BROADCAST_HDR = packed record
dbch_size : DWORD;
dbch_devicetype : DWORD;
dbch_reserved : DWORD;
end;
PDEV_BROADCAST_VOLUME = ^TDEV_BROADCAST_VOLUME;
TDEV_BROADCAST_VOLUME = packed record
dbcv_size : DWORD;
dbcv_devicetype : DWORD;
dbcv_reserved : DWORD;
dbcv_unitmask : DWORD;
dbcv_flags : WORD;
end;
{设置一钩子可知光驱的当前状态。}
procedure TCDEvents.WMDeviceChange(var Msg : TWMDeviceChange);
var lpdb : PDEV_BROADCAST_HDR;
lpdbv : PDEV_BROADCAST_VOLUME;
begin
(* received a wm_devicechange message *)
lpdb := PDEV_BROADCAST_HDR(Msg.dwData);
(* look at the event send together with the wm_devicechange message *)
case Msg.Event of
DBT_DEVICEARRIVAL : begin
if lpdb^.dbch_devicetype = DBT_DEVTYP_VOLUME then
begin
lpdbv := PDEV_BROADCAST_VOLUME(Msg.dwData);
if (lpdbv^.dbcv_flags and DBTF_MEDIA) = 1 then
Application.MessageBox (' CDROM closed.',
'CDROM Information.',
MB_OK);
end;
end;
DBT_DEVICEREMOVECOMPLETE : begin
if lpdb^.dbch_devicetype = DBT_DEVTYP_VOLUME then
begin
lpdbv := PDEV_BROADCAST_VOLUME(Msg.dwData);
if (lpdbv^.dbcv_flags and DBTF_MEDIA) = 1 then
if Assigned(fAfterRemove) then
Application.MessageBox (' CDROM Open.',
'CDROM Information.',
MB_OK);
end;
end;
end;
end;
{ get Handle to a CD-player}
function TCDEvents.GetDevice : word;
var OpenParms : TMCI_Open_Parms;
FID : Word;
begin
if not (csDesigning in ComponentState) then
begin
if fID=0 then
begin
FFlags := 0;
FFlags := mci_notify or mci_open_type or mci_open_shareable;
OpenParms.lpstrDeviceType := 'CDAudio';
OpenParms.dwCallback := 0;
fErrCode := mciSendCommand(0, mci_open, FFlags, Longint(@OpenParms));
if FErrCode = 0 then
{device successfully opened}
begin
fID := OpenParms.wDeviceID;
end;
end;
Result := fID;
end;
end;
{ Eject CDROM}
procedure TCDEvents.OpenDoor;
var
SetParms: TMCI_Set_Parms;
begin
FFlags := 0;
FFlags := mci_notify or mci_set_door_open;
SetParms.dwCallback := 0;
fErrCode := mciSendCommand(GetDevice, mci_Set, FFlags, Longint(@SetParms));
end;
{Close CDROM}
procedure TCDEvents.CloseDoor;
var
SetParm: TMCI_Set_Parms;
begin
FFlags := 0;
FFlags := mci_notify or mci_set_door_closed;
SetParm.dwCallback := 0;
fErrCode := mciSendCommand( GetDevice, mci_Set, FFlags, Longint(@SetParm) );
end;