锁定光驱在Win2000上的实现

最近看到很多朋友在讨论如何锁住光驱的问题,但是没有一个结果。

趁着周末闲，写出代码和大家一起分享。

新建一个工程，在窗体上加入两个按钮，粘贴以下程序，看看效果怎么样？^_^

Option Explicit
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 IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804

Private Type PREVENT_MEDIA_REMOVAL
        PreventMediaRemoval As Byte
End Type

Private Declare Function DeviceIoControl Lib "kernel32" (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 CreateFile Lib "kernel32" 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function LockCDROM(szDrive As String, IsLock As Boolean) As Boolean
    On Error GoTo Err
    Dim hDevice As Long
    Dim PMR As PREVENT_MEDIA_REMOVAL
    Dim bytesReturned As Long
    Dim Success As Long
    hDevice = CreateFile("//./" & szDrive, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0&, 0&)
    PMR.PreventMediaRemoval = CByte(Abs(IsLock))
    Success = DeviceIoControl(hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, PMR, Len(PMR), ByVal 0&, 0&, bytesReturned, ByVal 0&)
    CloseHandle hDevice
    LockCDROM = True
    Exit Function
Err:
    LockCDROM = False
End Function

Private Sub Command1_Click()
   Dim ret As Boolean
   ret = LockCDROM("H:", True)  '我的光驱盘符是H:
   If ret Then
      MsgBox "锁定成功", vbInformation, "提示"
   Else
      MsgBox "锁定失败", vbInformation, "提示"
   End If
End Sub

Private Sub Command2_Click()
   Dim ret As Boolean
   ret = LockCDROM("H:", False)
   If ret Then
      MsgBox "解除锁定成功", vbInformation, "提示"
   Else
      MsgBox "解除锁定失败", vbInformation, "提示"
   End If
End Sub