用Delphi7开发了一个实时检测光驱中有没有光盘的代码.
当光驱中没有光盘时,就一直弹出提示:  驱动器中没有磁盘,请在驱动器G中插入磁盘
怎么关也关不掉,只能把光盘重新放入光驱.代码如下:unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, StdCtrls;type  PTreeData = ^TreeData; //TreeView 我的光盘包含的不可视数据
  TreeData = packed record
    VolCode: DWORD;
    VolName: Char;
    VolTitle: string;
    IfHasCD: boolean;
    IsNewEdition: boolean; //是否是新的光盘
  end;  TForm1 = class(TForm)
    PM_OtherCdRom: TPopupMenu;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
    fMyCdData: PTreeData;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}function GetDiskVolSerialID(cDriveName: char): DWORD;
var
  dwTemp1, dwTemp2: DWORD;
begin
  GetVolumeInformation(PChar(cDriveName + ':\'), nil, 0, @Result, dwTemp1,
    dwTemp2, nil, 0);
end;procedure TForm1.Timer1Timer(Sender: TObject);
const
  CDFlagFile = 'information\Resource.inf';
var
  DriveChar: char;
  DStr, DStr1, SelCdName, CurCdName: string;
  i: smallint;  TVData: PTreeData;
  NotUsed, VolFlags: DWORD;
  Buf: array[0..MAX_PATH] of Char;  iItem: TMenuItem;
begin
 //检测光驱中当前的光盘,并添加到菜单.
  i := 0;
  PM_OtherCdRom.Items.Clear;
  try
    for DriveChar := 'A' to 'Z' do
    begin
      DStr := DriveChar + ':\';
      if GetDriveType(Pchar(DStr)) = DRIVE_CDROM then //DRIVE_FIXED, DRIVE_CDROM
      begin        Buf[0] := #$00;
        if GetVolumeInformation(PChar(DriveChar + ':\'), Buf,
          sizeof(Buf), nil, NotUsed, VolFlags, nil, 0) then
          SetString(DStr1, Buf, StrLen(Buf))
        else
          DStr1 := '';        CurCdName := DStr1 + '(' + DStr + ')';        if not Assigned(fMyCdData) then
          SelCdName := ''
        else
          SelCdName := fMyCdData.VolTitle + '(' + fMyCdData.VolName +
            ':\)';        if (not FileExists(DStr + CDFlagFile) or (CurCdName = SelCdName)) then
          Continue;        iItem := TMenuItem.Create(nil);
        iItem.Caption := DStr1 + '(' + DStr + ')';
        iItem.Name := 'MyCdRom_' + IntToStr(i);
        // iItem.OnClick := fMenuPopClick;
        PM_OtherCdRom.Items.Add(iItem);        //添加有关光盘的数据
        new(TVData);
        TVData^.VolCode := GetDiskVolSerialID(DriveChar);
        TVData^.VolName := DriveChar;
        TVData^.VolTitle := DStr1;
        if trim(DStr1) <> '' then
        begin
          TVData^.IfHasCD := true;
        end
        else
          TVData^.IfHasCD := false;        iItem.VCLComObject := TVData;        Inc(i);      end;
    end;
  except on e: exception do
      showMessage(e.Message);
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  New(fMyCdData);
end;procedure TForm1.Timer2Timer(Sender: TObject);
var
  Cunt: Integer;
  DriveChar: string;
  CapStr, Dstr, Dstr1, NewStr: string;
  NotUsed, VolFlags: DWORD;
  Buf: array[0..MAX_PATH] of Char;
begin
  //   实时检测光驱中有没有光盘。  //Application.ProcessMessages;
  sleep(100);  try
    Cunt := PM_OtherCdRom.Items.Count;
    if not Assigned(fMyCdData) then
    begin
      if Cunt > 0 then
      begin
        fMyCdData := PTreeData(PM_OtherCdRom.Items.Items[0].VCLComObject);
       // StartMyCd;
      end;
    end
    else
    begin      DriveChar := fMyCdData.VolName;      CapStr := fMyCdData.VolTitle + '(' + fMyCdData.VolName + ':\)';      DStr := DriveChar + ':';
      try
        if GetDriveType(Pchar(DStr)) = DRIVE_CDROM then
        begin
          Buf[0] := #$00;
          if GetVolumeInformation(PChar(DriveChar + ':\'), Buf,
            DWORD(sizeof(Buf)), nil, NotUsed, VolFlags, nil, 0) then
            SetString(DStr1, Buf, StrLen(Buf))
          else
            DStr1 := '';          NewStr := DStr1 + '(' + DStr + '\)';          if CapStr <> NewStr then
          begin
            Timer2.Enabled := false;
           showMessage('光盘退出!');
          end;
        end;      except on e: exception do
         showMessage(e.Message);
      end;
    end;  except on e: exception do
    showMessage(e.Message);
  end;
end;
end.

解决方案 »

  1.   

    1、Timer1的定时器处理有问题
    2、Timer2中不应该有Showmessage
      

  2.   

    你为什么不拦截消息来处理呢?unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;type
      TForm1 = class(TForm)
      private
        { Private declarations }
      public
        { Public declarations }
        procedure WMDEVICECHANGE(var Msg : TMessage); message WM_DEVICECHANGE;
      end;var
      Form1: TForm1;implementation{$R *.dfm}procedure Tform1.WMDEVICECHANGE(var msg :Tmessage);
    begin
     inherited;
     case msg.WParam of
      $8000:Caption :='有光盘';
      $8004:Caption :='没有光盘';
     end;
    end;end.