Lock/Disable ejection of CD-Drive

[Megatron]

This example uses the DeviceIoControl API function to lock and unlock the CD drive.

The generic code is:

Option Explicit
 
Private Type PREVENT_MEDIA_REMOVAL
   PreventMediaRemoval As Byte
End Type
  
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const INVALID_HANDLE_VALUE As Long = -1&
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const ERROR_ACCESS_DENIED As Long = 5&
Private Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804
Private hDevice As Long
 
'--------------------------------------------------------------------------
'ToggleDrive()
'sDrive = Drive letter we want to prevent from ejecting
'bLock = lock mode. TRUE = locked, FALSE = unlocked
'--------------------------------------------------------------------------
Private Sub ToggleDrive(ByVal sDrive As String, bLock As Boolean)
    Dim dwRetval As Long
    Dim pmr As PREVENT_MEDIA_REMOVAL
    Dim hDevice As Long
    
    pmr.PreventMediaRemoval = bLock
    hDevice = 0
    dwRetval = 0
    
    'Get a handle to the drive
    hDevice = CreateFile("\\.\" & sDrive & ":", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, OPEN_EXISTING, 0, 0)
    If hDevice = INVALID_HANDLE_VALUE Then
        MsgBox "Unable to find drive"
        Exit Sub
    End If
    
    'Lock the drive
    If DeviceIoControl(hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, pmr, Len(pmr), 0, 0, dwRetval, 0) = 0 Then
        MsgBox "Error accessing drive"
    End If
    
    CloseHandle hDevice
End Sub

Call the ToggleDrive routine to lock/unlock the drive.

'Lock the D drive
ToggleDrive "D", True
 
MsgBox "Drive is locked. Press OK to unlock"
 
'Unlock the D drive
ToggleDrive "D", False