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:

Solve 1:

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;


Solve 2:

{ ... }
type
TPREVENT_MEDIA_REMOVAL = packed record
PreventMediaRemoval: LongBool;
end;

const
IOCTL_STORAGE_MEDIA_REMOVAL = $002D4804;

procedure PreventEjection(Drive: char; Prevent: Boolean);
var
DeviceName: string;
Device: THandle;
b: Boolean;
BufIn: TPREVENT_MEDIA_REMOVAL;
BytesReturned: DWORD;
begin
DeviceName := '\\.\' + Drive + ':';
Device := CreateFile(PChar(DeviceName), GENERIC_READ, FILE_SHARE_READ or
FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if Device <> INVALID_HANDLE_VALUE then
begin
BufIn.PreventMediaRemoval := Prevent;
b := DeviceIOControl(Device, IOCTL_STORAGE_MEDIA_REMOVAL, @BufIn,
SizeOf(BufIn), nil, 0, BytesReturned, nil);
CloseHandle(Device);
if not b then
RaiseLastWin32Error;
end;
end;