如何判断光驱有没有光盘及有没有指定文件(50分)

  • 主题发起人 主题发起人 hwj
  • 开始时间 开始时间
H

hwj

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;
 
//判断光驱中是否有盘
//如果你已经知道盘符为drive
function TForm1.diskindriv(Drive:char):boolean;
var
Errormode:word;
begin
{ make it upper case}
if Drive in ['a'..'z'] then
dec(drive,$20);
{make sure it is letter}
if not (drive in ['A'..'Z']) then
raise EconvertError.create('not a valid drive?');
{turn off critical error}
Errormode:=SetErrorMode(SEM_FailCriticalErrors);
try
{drive a=1,b=2,and so on}
if disksize(ord(Drive)-$40)=-1 then
result:=false
else
result:=true;
finally
seterrormode(errormode);
end
 
多人接受答案了。
 
后退
顶部