对不起,没来得及改,我贴一下:
procedure TCDEvents.GetAllCDDrives;
var
Buffer : array[0..500] of char;
TmpPC : PChar;
begin
GetLogicalDriveStrings(SizeOf(Buffer),Buffer);
TmpPC := Buffer;
fCDDrives.Clear;
fCDDrives.begin
Update;
try
while TmpPC[0] <> #0do
begin
if GetDriveType(TmpPC) = Drive_CDROM then
fCDDrives.Add(TmpPC);
TmpPC := StrEnd(TmpPC)+1;
end;
finally
fCDDrives.EndUpdate;
end;
end;
function TCDEvents.GetXCDDriveLetter(vCDNumber: integer):Shortstring;
begin
Result := cNoCDDrive;
if (fCDDrives.Count > -1) and (fCDDrives.Count >= vCDNumber) then
begin
Result := fCDDrives[vCDNumber];
end;
end;
function TCDEvents.GetFirstCDDriveLetter: Shortstring;
begin
Result := GetXCDDriveLetter(0);
end;
constructor TCDEvents.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
fOptions := TCDOptions.Create;
fEnabled := True;
fNotifyMode := nmEvent;
fID := 0;
fCDDrives := TStringList.Create;
GetAllCDDrives;
end;
function TCDEvents.GetFirstDriveLetter(unitmask : longint):char;
var DriveLetter : shortint;
begin
DriveLetter := Ord('A');
while (unitmask and 1)=0 do
begin
unitmask := unitmask shr 1;
inc(DriveLetter);
end;
Result := Char(DriveLetter);
end;
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;
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;
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;
