看看与光驱有关的函数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.

解决方案 »

  1.   

    2:屏蔽光驱
    procedure ShieldCDs;
      function IsCDROM(DriveChar: Char): Boolean;
      begin
        Result := GetDriveType(PChar(DriveChar + ':\')) = DRIVE_CDROM;
      end;
    const
      _PATH = '\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer';
    var
      I, T: Integer;
      Buffer, Mask: DWORD;
      R: TRegistry;
    begin
      Mask := 0;
      for I := 0 to 25 do
        if IsCDROM(Char(I + Ord('A'))) then Mask := Mask + 1 shl I;
      R := TRegistry.Create;
      R.Rootkey := HKEY_CURRENT_USER;
      R.CreateKey(_PATH);
      R.OpenKey(_PATH, False);
      if R.ReadBinaryData('NoDrives', Buffer, SizeOf(Buffer)) = 0 then Buffer := 0;
      Buffer := Buffer and not Mask or Mask; // 为了不破坏对其它驱动器的设置。
      R.WriteBinaryData('NoDrives', Buffer, SizeOf(Buffer));
      R.Free;
    end;