How to lock a CD-ROM drive

Problem/Question/Abstract:

How can I prevent a CD from being ejected from a CD-ROM drive through code?

Answer:

The code below only works with Windows NT 4, 2000 and XP:

{NTStyle}

function CTL_Code(DeviceType, _Function, Method, Access: Integer): DWord;
begin
  Result := (DeviceType shl 16) or (Access shl 14) or (_Function shl 2) or Method;
end;

type
  TPreventMediaRemoval = packed record
    PreventMediaRemoval: Boolean;
  end;

const
  METHOD_BUFFERED = 0;
  FILE_READ_ACCESS = 1;
  IOCTL_STORAGE_BASE = $2D;
  IOCTL_STORAGE_MEDIA_REMOVAL_FUNCTION = $201;

procedure NTStyleTrayLock(Drive: Char; Lock: Boolean);
var
  Device: THandle;
  IOCTL_STORAGE_MEDIA_REMOVAL: DWord;
  BytesReturned: Cardinal;
  InBuffer: TPreventMediaRemoval;
begin
  IOCTL_STORAGE_MEDIA_REMOVAL := CTL_Code(IOCTL_STORAGE_BASE,
    IOCTL_STORAGE_MEDIA_REMOVAL_FUNCTION,
    METHOD_BUFFERED, FILE_READ_ACCESS);

  Device := CreateFile(PChar(Format('\\.\%s:', [UpCase(Drive)])), GENERIC_ALL,
    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if Device = INVALID_HANDLE_VALUE then
    RaiseLastWin32Error;
  try
    InBuffer.PreventMediaRemoval := Lock;
    Win32Check(DeviceIoControl(Device, IOCTL_STORAGE_MEDIA_REMOVAL, @InBuffer,
      sizeof(InBuffer), nil, 0, BytesReturned, nil));
  finally
    FileClose(Device);
  end;
end;

{UI (here: Drive W:)}

procedure TForm1.btnLockClick(Sender: TObject);
begin
  NTStyleTrayLock('W', True);
end;

procedure TForm1.btnUnLockClick(Sender: TObject);
begin
  NTStyleTrayLock('W', False);
end;