用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.
当光驱中没有光盘时,就一直弹出提示: 驱动器中没有磁盘,请在驱动器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.
解决方案 »
- delphi 读取文本内容
- 用VHDL做食堂饭卡系统
- 请问如何在EDIT中输入TAB符,而不是切换到别的控件
- 怎么判断一个字符串是不是数字?(在线等)
- 在dbgrid中用图标显示某个逻辑字段时,通过双击改变该字段内容,如何避免True或False被显示出来
- create(self);其中 self代表什么?还有其他参数吗?
- excel导入问题!!!!
- 如何取得ADOQuery返回的数据记录总数?
- 怎么把dbcheckbox的标题显示在Fastreport做的报表中呀?
- 有关ActiveForm的(在线等待)
- delphi 怎样在dbgrid表格里添加进度条呢?
- Delphi+sql+ DateTimePicker1查询
2、Timer2中不应该有Showmessage
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.