光驱(50分)

W

w.kzjl

Unregistered / Unconfirmed
GUEST, unregistred user!
请问怎么才能获取光驱的状态(打开的还是关闭的)
 
{ 贴 一 贴}
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;


 
接受答案了.
 
顶部