如何检测光驱中是否有CD.

Question

拦截消息WM_DEVICECHANGE即可！
//响应该消息
procedure Tform1.WMDEVICECHANGE(var msgx :Tmessage);
const
  DBT_DEVICEARRIVAL=$8000;
  DBT_DEVICEREMOVECOMPLETE=$8004;
begin
  inherited;
  case msgx.WParam of
    DBT_DEVICEARRIVAL:Caption :='有了！';
    DBT_DEVICEREMOVECOMPLETE:Caption :='取走了';
  end;
end;

Answer 1

Function TForm1.AudioCD(Drive : Char) : Boolean;
Var
  FSFlags, MaxLength: DWORD; 
  VolName, Path : String; 
 Begin
  Path := Drive + ':\'; 
  Result := FALSE; 
  if (GetDriveType(PChar(Path)) = DRIVE_CDROM) then 
 Begin 
  SetLength(VolName, 64);
  GetVolumeInformation(PChar(Path), PChar(VolName), Length (VolName), nil, MaxLength, FSFlags, nil,0);
  if (lStrCmp(PChar(VolName),'Audio CD') = 0) Then Result := TRUE; 
 End; 
end;

Answer 2

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 3

我说的是如果开始的时候如果光驱中没有光盘,启动程序,然后用户做一个操作需要所需要的光盘,这个时候怎么会有WM_DeviceChange这个消息呢?

Answer 4

uses Classes, Sysutils;
//////////////CDRom Utils//////////////////////
//获得CDRom 序列号
function GetdiskserilNum(ADrive: string): string;
//获得CDRom卷标，返回''表示驱动器中没有光盘
function GetCDRomLabel(ADrive: string): string;
//获得第一个CDRom,返回''表示驱动器中没有光盘
function GetFirstCDROM: ShortString;
//获得系统驱动器列表
procedure Getdisks(Strings: TStringList);
//打开光驱
procedure OpenCDRom;
//关闭光驱
procedure CloseCDRom;

Answer 5

procedure TForm1.Button1Click(Sender: TObject);
var
  CDType: UINT;
  Name: Char;
  DRVName: string;
  VolName, FileSysname: PChar;
  SNO, Maxl, FileFlag: DWORD;
begin
  GetMem(VolName, 255);
  GetMem(FileSysname, 100);
  for Name :='C' to 'Z' do  // 循环检测
  begin
    drvname := Name + ':';
    CDtype := GetDriveType(PChar(@DRVName[1])); // 获得磁盘类型
    if (CDType = DRIVE_CDROM) then
    begin
      VolName^ := Chr(0);
      FileSysname^ := Chr(0);
      if ( not (GetVolumeInformation(PChar(@DRVName[1]), VolName, 250, LPDWORD(@SNO), LPDWORD(@Maxl)^,
        LPDWORD(@FileFlag)^, FileSysname, 100))) then
        // 光驱没有光盘
      else
        // 光驱中有光盘
    end;
  end;
  FreeMem(FileSysname);
  FreeMem(VolName)
end;