怎么样判断光驱是否是准备就绪哪

Question

.

Answer 1

TForm1 = class(TForm)
label1:Tlabel;
.......
procedure WMDeviceChange(var Msg : TWMDeviceChange);
procedure HasCdRom;
procedure HasNotCdRom;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);private
FWindowHandle: HWND;
procedure myWndProc(var Msg: TMessage);
{ Private declarations }
public
{ Public declarations }
end;procedure TForm1.myWndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then //如果是设备改变消息的话
try
WMDeviceChange(TWMDeviceChange(Msg)); 
except
Application.HandleException(Self);
end
else 
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
//如果不是设备改变消息，则交给FORM缺省的消息处理系统完成
end;
procedure TForm1.WMDeviceChange(var Msg : TWMDeviceChange);
var
lpdb : PDEV_BROADCAST_HDR; //
lpdbv : PDEV_BROADCAST_VOLUME;
begin
(* 接受 a wm_devicechange message *)
lpdb := PDEV_BROADCAST_HDR(Msg.dwData);
(* 查看 wm_devicechange 消息中EVENT 是何事件 *)
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
begin
//CheckCdRomVolume;我的程序里要检查光盘卷标
//HasCdRom; CDRom被加载
showmessage('有光盘加入进来');
end;
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
//HasNotCdRom; CD Rom被取出
showmessage('CD被取出');
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FWindowHandle:=AllocateHWnd(mywndproc);
//截取WINDOWS交给每个窗口的消息，交给MYWNDPROC处理，用来判断CD驱动器改变
//在WIN95里，每个设备的改变，系统都要发一个消息给所有当前窗口
//所以这里要用自定义的消息循环代替DELPHI 程序默认的窗口消息循环
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(FWindowHandle);
//释放句柄 
end;

Answer 2

function IsDriveReady(DriveLetter : char) : bool;
 var
   OldErrorMode : Word;
   OldDirectory : string;
 begin
   OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
   GetDir(0, OldDirectory);
   {$I-}
     ChDir(DriveLetter + ':\');
   {$I+}
    if IoResult <> 0 then
     Result := False 
    else
     Result := True;   ChDir(OldDirectory);
   SetErrorMode(OldErrorMode);
 end; procedure TForm1.Button1Click(Sender: TObject);
 begin
   if not IsDriveReady('E') then
     ShowMessage('Drive Not Ready') else
     ShowMessage('Drive is Ready');
 end;

Answer 3

user MMSystem;
在implementation中加以下声明
function WaveOutGetNumDevs:longint;stdcall;external'winmm.dll'name'diverOutGetNumDevs';
然后加入一个按钮事件
if diveroutGetNumDevs=0 then
shoemessage('无光驱')
else
showmessage('有光驱')