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("G:", True)
   If ret Then
      MsgBox "锁定成功", vbInformation, "提示"
   Else
      MsgBox "锁定失败", vbInformation, "提示"
   End If
End Sub

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

'===================================================================================================================================
'===================================================================================================================================
'===================================================================================================================================

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Any, ByVal cbData As Long) As Long
Private Const REG_DWORD = 4
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Sub Command3_Click()
Dim Gokey As Long
RegOpenKey HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Services\USBSTOR", Gokey
RegSetValueEx Gokey, "Start", 0, REG_DWORD, 4&, 4 '//dword值4禁用。应该是。
RegCloseKey Gokey
MsgBox "禁用成功", , "提示"
End Sub

Private Sub Command4_Click()
Dim Gokey As Long
RegOpenKey HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Services\USBSTOR", Gokey
RegSetValueEx Gokey, "Start", 0, REG_DWORD, 3&, 4 '//dword值3启用。。
RegCloseKey Gokey
MsgBox "启用成功", , "提示"
End Sub

Private Sub Form_Load()

End Sub