监测光驱.txt

大量Delphi开发资料

//是否为光驱

 Function FindFirstCDROMDrive: Char;

 Var

   drivemap, mask: DWORD;

   i: Integer;

   root: String;

 Begin

   Result := #0;

   root := 'A:\';

   drivemap := GetLogicalDrives;

   mask := 1;

   For i:= 1 To 32 Do Begin

     If (mask and drivemap) <> 0 Then

       If GetDriveType( PChar(root) ) = DRIVE_CDROM Then Begin

         Result := root[1];

         Break;

       End;

     mask := mask shl 1;

     Inc( root[1] );

   End;

 End;

//光驱内是否有盘
function IsAudioCD(Drive : char) : bool;

var

  DrivePath : string;

  MaximumComponentLength : DWORD;

  FileSystemFlags : DWORD;

  VolumeName : string;

  OldErrMode: UINT;

  DriveType: UINT;

begin

  Result := false;

  DrivePath := Drive + ':\';

  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  DriveType := GetDriveType(Pchar(DrivePath));

  SetErrorMode(OldErrMode);

  if DriveType <> DRIVE_CDROM then

     exit;

  SetLength(VolumeName, 64);

  GetVolumeInformation(PChar(DrivePath),

                       PChar(VolumeName),

                       Length(VolumeName),

                       nil,

                       MaximumComponentLength,

                       FileSystemFlags,

                       nil,

                       0);

  if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then result := true;

end;

//光盘是否弹出
interface

    TForm1 = class(TForm)

       ...

    public

       procedure WMDeviceChange(var Msg: TMsg); message WM_DEVICECHANGE;


implementation


procedure TForm1.WMDeviceChange(var Msg: TMsg);

begin

    if Msg.wParam = DBT_DEVICEREMOVEPENDING then

        // user has started to eject CD

        // Tell Windows it's OK.

        Msg.Result := True;

end;

//弹出关闭光驱
uses MMSystem;


open CD-ROM:

        mciSendString('Set cdaudio door open wait', nil, 0, handle);


close CD-ROM:

        mciSendString('Set cdaudio door closed wait', nil, 0, handle);