How to lock a CD-ROM drive (Views: 707)
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; |