隐藏光驱
控制光驱开关
//打开光驱  
mciSendString('Set cdaudio door open wait', nil, 0, handle);  
//关闭光驱  
mciSendString('Set cdaudio door closed wait', nil, 0, handle)  

解决方案 »

  1.   

    监视光驱中是否有光盘拦截消息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; 
      

  2.   

    unit CXDiskFileUtils;interfaceuses 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;
    //切换光驱自动运行功能,设置在Windows重新启动后将生效
    procedure SetCDRomAutoRun(AutoRun:Boolean);implementationuses Windows, MMSystem;
    //////////////CDRom Utils////////////////////////////function GetdiskserilNum(ADrive: string): string;
    var
      VolumeName    : array[0..255] of char;
      FileSystemType   : array[0..255] of char;
      SerialNum    : DWORD;
      MaxFilenameLength   : DWORD;
      Flags     : DWORD;
    begin
      if (GetVolumeInformation(PChar(ADrive),
                               VolumeName,
                               256,
                               @SerialNum,
                               MaxFilenameLength,
                               Flags,
                               FileSystemType,
                               256)) then
      Result := (IntToHex(SerialNum shr 16, 3) +
                 IntToHex((SerialNum shl 16) shr 16, 4));
    end;function GetCDRomLabel(ADrive: string): string;
    var
      VolumeName    : array[0..255] of char;
      FileSystemType   : array[0..255] of char;
      SerialNum    : DWORD;
      MaxFilenameLength   : DWORD;
      Flags     : DWORD;
    begin
      //Result := '驱动器中没有CDRom';
      if (GetVolumeInformation(PChar(ADrive),
                               VolumeName,
                               256,
                               @SerialNum,
                               MaxFilenameLength,
                               Flags,
                               FileSystemType,
                               256)) then
      Result := VolumeName;
    end;function GetFirstCDROM: Shortstring;
    var
      AList                         : TStringList;
      Counter                       : integer;
    begin
      //Result := '驱动器里无CDRom';
      AList := TStringList.Create;
      Getdisks(AList);
      for Counter := 0 to AList.Count-1 do
        if GetDriveType(PChar(Alist.Strings[Counter])) = DRIVE_CDROM then
          Result := Alist.Strings[Counter]
    end;procedure Getdisks(Strings: TStringList);
    const BufSize = 256;
    var
      Buffer                    : PChar;
      P                            : PChar;
    begin
      GetMem(Buffer, BufSize);
      try
        Strings.BeginUpdate;
        try
          Strings.Clear;
          if GetLogicalDriveStrings(BufSize, Buffer) <> 0 then begin
            P := Buffer;
            while P^ <> #0 do begin
              Strings.Add(P);
              Inc(P, StrLen(P) + 1);
            end;
          end;
        finally
          Strings.EndUpdate;
        end;
      finally
        FreeMem(Buffer, BufSize);
      end;
    end;procedure OpenCDRom;
    begin
      mciSendString('Set cdaudio door open wait', nil, 0, 0);//handle);
    end;procedure CloseCDRom;
    begin
      mciSendString('Set cdaudio door closed wait', nil, 0, 0);//handle);
    end;procedure SetCDRomAutoRun(AutoRun:Boolean);
    const
      DoAutoRun : array[Boolean] of Integer = (0,1);
    var
      Reg:TRegistry;
    begin
      try
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.KeyExists('System\CurrentControlSet\Services\Class\CDROM') then
          if Reg.OpenKey('System\CurrentControlSet\Services\Class\CDROM',FALSE) then
            Reg.WriteBinaryData('AutoRun',DoAutoRun[AAutoRun],1);
      finally
        Reg.Free;
      end;
      //设置在Windows重新启动后将生效
    end;end.
      

  3.   

    和DELPHI无关,由于WINDOW的原因,不依靠VXD和汇编的情况下对硬件操作只能用API!