Ejemplos usando el Api de windows para Visual basic

228 - Bloquear la bandeja de cd

Recurso enviado por Helmuth Campos, que muestra como listar las unidades de cd y poder bloquearlas y desbloquearlas

El ejemplo utiliza las funciones GetLogicalDriveStrings y GetDriveType para enumerar las unidades extraibles incluyendo a la de los cd, dvd en un LisTbox , y para poder bloquerlas y desbloquearlas, utiliza la función DeviceIOControl del Kernel32.

Nota: hay una función de ajuste llamada DeviceLock. Esta función es la que bloquea y desbloquea la unidad, y tiene dos parámetros: la letra y un valor un boolean para relaizar la acción, por ejemplo esto bloquea la unidad e:

DeviceLock "E:\",True

Ejemplo

Formulario

Agregar en el formulario los siguientes controles :

1 - Un Command1 (0) para desbloquear
2 - Un Command2(1) para bloquear
3 - Un Label1
4 - Un ListBox
5 - Un módulo bas

Código fuente en el formulario

Private Sub LoadAvailableDrives(lst As ListBox) Dim lpBuffer As String Dim drvType As Long Dim currDrive As String lpBuffer = GetDriveString() Do Until lpBuffer = Chr(0) currDrive = StripNulls(lpBuffer) drvType = GetDriveType(currDrive) If (drvType = DRIVE_CDROM) Or _ (drvType = DRIVE_REMOVABLE) Then lst.AddItem currDrive End If Loop End Sub Private Function StripNulls(startstr As String) As String Dim pos As Long pos = InStr(startstr, Chr$(0)) If pos Then StripNulls = Mid$(startstr, 1, pos - 1) startstr = Mid$(startstr, pos + 1, Len(startstr)) End If End Function Private Function GetDriveString() As String Dim sBuffer As String sBuffer = Space$((26 * 4) + 1) If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then GetDriveString = Trim$(sBuffer) End If End Function Private Sub Command1_Click(Index As Integer) Dim fLock As Boolean Dim result As Boolean Dim sDrive As String If List1.ListIndex > -1 Then sDrive = List1.List(List1.ListIndex) fLock = CBool(Index) result = DeviceLock(sDrive, fLock) If result Then Select Case Index Case 0 Label1.Caption = "El dispositivo " & _ sDrive & " está desbloqueado." Case 1 Label1.Caption = "El dispositivo " & _ sDrive & " está bloqueado." End Select Else Label1.Caption = _ "Fallo en llamada - " & _ "Quizá no existe el dispositivo." End If End If End Sub Private Sub Form_Load() LoadAvailableDrives List1 Command1(0).Enabled = False Command1(1).Enabled = False MsgBox "(c)2007 Dj_Dexter Gato_cosmico16@hotmail.com", vbInformation Command1(0).caption = "Desbloquear" Command1(1).caption = "Bloquear" End Sub Private Sub Form_Resize() On Error Resume Next Move (Screen.Width - Width) \ 29, (Screen.Height - Height) \ 29 End Sub Private Sub List1_Click() Command1(0).Enabled = List1.ListIndex > -1 Command1(1).Enabled = List1.ListIndex > -1 End Sub

Código fuente en un módulo bas

Option Explicit Public Const DRIVE_REMOVABLE As Long = 2 Public Const DRIVE_CDROM As Long = 5 Public Const INVALID_HANDLE_VALUE As Long = -1& Public Const GENERIC_READ As Long = &H80000000 Public Const FILE_SHARE_READ As Long = &H1 Public Const FILE_SHARE_WRITE As Long = &H2 Public Const FILE_ANY_ACCESS As Long = &H0 Public Const FILE_READ_ACCESS As Long = &H1 Public Const FILE_WRITE_ACCESS As Long = &H2 Public Const OPEN_EXISTING As Long = 3 Public Const IOCTL_STORAGE_MEDIA_REMOVAL As _ Long = &H2D4804 Public Type PREVENT_MEDIA_REMOVAL PreventMediaRemoval As Byte End Type Public Declare Function GetLogicalDriveStrings _ Lib "kernel32" _ Alias "GetLogicalDriveStringsA" _ (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long Public Declare Function GetDriveType Lib "kernel32" _ Alias "GetDriveTypeA" _ (ByVal lpRootPathName As String) As Long Public 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 Public 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 Public Declare Function CloseHandle Lib "kernel32" _ (ByVal hObject As Long) As Long Public Function DeviceLock(sDrive As String, fLock As Boolean) As Boolean Dim hDevice As Long Dim PMR As PREVENT_MEDIA_REMOVAL Dim bytesReturned As Long Dim success As Long sDrive = UnQualifyPath(sDrive) hDevice = CreateFile("\\.\" & sDrive, _ GENERIC_READ, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, _ ByVal 0&, _ OPEN_EXISTING, _ 0&, 0&) If hDevice <> INVALID_HANDLE_VALUE Then PMR.PreventMediaRemoval = CByte(Abs(fLock)) success = DeviceIoControl(hDevice, _ IOCTL_STORAGE_MEDIA_REMOVAL, _ PMR, _ Len(PMR), _ ByVal 0&, _ 0&, _ bytesReturned, _ ByVal 0&) End If Call CloseHandle(hDevice) DeviceLock = success <> 0 End Function Public Function UnQualifyPath(ByVal sPath As String) As String sPath = Trim$(sPath) If Right$(sPath, 1) = "\" Then UnQualifyPath = Left$(sPath, Len(sPath) - 1) Else UnQualifyPath = sPath End If End Function

Relacionados

Buscar en Recursos vb