Startseite / Tipps / VB 5/6-Tipp 0620: CD-ROM Schublade sperren und entsperren

VB 5/6-Tipp 0620: CD-ROM Schublade sperren und entsperren

 von Konrad Doblander

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Optionsfeld-Steuerelement "Option2"
' Steuerelement: Optionsfeld-Steuerelement "Option1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"


' Die Labels 2 und 3 werden als Anzeige f. die Anzahl d. durchgeführten Lock- bzw. Unlock-
' Vorgänge genutzt und sind nicht unbedingt notwendig *g*
'
' Auf eine Überprüfung ob es sich tatsächlich um ein CD-Laufwerk handelt habe ich verzichtet.
'
' Auch konnte ich nicht testen, ob das Tool bei einem Slot-In Laufwerk funktioniert.
'
' Da ich hier Fragmente bzw. Informationen von anderen Web-Seiten verwendet habe, kann und
' will ich kein Copyright beanspruchen, obwohl der Code in dieser Form meines Wissens bis heute
' auf keiner öffentlich zugänglichen Seite zu finden ist.
'
' Viel Spass
' Konrad Doblander

Option Explicit

Private Const INVALID_HANDLE_VALUE  As Long = -1&
Private Const OPEN_EXISTING  As Long = 3&
Private Const FILE_FLAG_DELETE_ON_CLOSE As Long = 67108864
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA = 2967560
Private Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804
Private Const VWIN32_DIOC_DOS_IOCTL As Long = 1&

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type


Private Type DIOC_REGISTERS
    reg_EBX As Long
    reg_EDX As Long
    reg_ECX As Long
    reg_EAX As Long
    reg_EDI As Long
    reg_ESI As Long
    reg_Flags As Long
End Type

Private Type PREVENT_MEDIA_REMOVAL
    P1 As Byte
End Type

Private Type PREVENT_MEDIA_REMOVAL1
    P1 As Byte
    P2 As Byte
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
        Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) 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 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 CloseHandle Lib "kernel32" _
        (ByVal hObject As Long) As Long

Private Sub Form_Load()
    Label1.Caption = "Laufwerk"
    Label2.Caption = "00"
    Label3.Caption = "00"
    Text1.Text = ""
End Sub

Private Sub Command1_Click()
    Dim OSV As OSVERSIONINFO
    Dim hLwStatus As Long
    Dim retDummy As Long
    Dim xLockDrive As String
    Dim hDriveX As String
    Dim RawStuff As DIOC_REGISTERS
    Dim PMR32 As PREVENT_MEDIA_REMOVAL
    Dim PMR9x As PREVENT_MEDIA_REMOVAL1
    
    If Option1.Value = True Then
        ' lock  Parameter für Win NT/2K/XP
        PMR32.P1 = 1
        
        ' lock  Parameter für Win 9x
        PMR9x.P1 = 0
        Label2.Caption = CStr(CInt(Label2.Caption) + 1)
    Else
        ' unlock Parameter für Win NT/2K/XP
        PMR32.P1 = 0
        
        ' unlock Parameter für Win 9x
        PMR9x.P1 = 1
        Label3.Caption = CStr(CInt(Label3.Caption) + 1)
    End If
    
    PMR9x.P2 = 0
    
    ' Betriebssystem-Plattform bestimmen
    OSV.dwOSVersionInfoSize = 148
    OSV.szCSDVersion = Space$(128)
    retDummy = GetVersionEx(OSV)
    
    ' Laufwerk
    xLockDrive = Left$(UCase(Trim$(Text1.Text)), 1)
    If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", xLockDrive) = 0 Then Exit Sub
    hDriveX = xLockDrive & ":"
    
    ' je nach OS-Version eine andere Routine
    Debug.Print "OS-PId:" & OSV.dwPlatformId
    
    ' Windows NT/2000/XP
    If OSV.dwPlatformId >= 2 Then
        hLwStatus = CreateFile("\\.\" & hDriveX, _
            GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
        
        If hLwStatus <> INVALID_HANDLE_VALUE Then
            'Lock media
            Call DeviceIoControl(hLwStatus, IOCTL_STORAGE_MEDIA_REMOVAL, _
                PMR32, Len(PMR32), ByVal 0, 0, retDummy, ByVal 0)
            
            Call CloseHandle(hLwStatus)
       End If
    
    ' Win9x/Me
    Else
        hLwStatus = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
        If hLwStatus <> INVALID_HANDLE_VALUE Then
        
            ' Laufwerk
            RawStuff.reg_EBX = Asc(hDriveX) - Asc("A") + 1
            
            ' Int21h Funktion 440Dh
            RawStuff.reg_EAX = &H440D
            
            ' Unterfunktion 48h
            RawStuff.reg_ECX = &H48 Or &H800
            
            ' Parameter
            RawStuff.reg_EDX = VarPtr(PMR9x)
            
            'Lock media
            Call DeviceIoControl(hLwStatus, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), _
                RawStuff, LenB(RawStuff), retDummy, ByVal 0)
            
            Call CloseHandle(hLwStatus)
       End If
    End If
End Sub

'-------------------------------------------------------------------------------------------------
' Nachtrag f. Assembler-Freaks
'-------------------------------------------------------------------------------------------------
'
' LOCK/UNLOCK
' mov bx, DriveNum  ; drive number 0=default, 1=A, 2=B ...
' mov ch, 8         ; device category must be 8
' mov cl, 48h       ; LOCK/UNLOCK minor number
' mov ax, 440D      ; generic IOCTL function number
' mov dx, seg ParamBlock
' mov DS, dx
' mov dx, offset ParamBlock
' int 21h
' jnc success
' mov [ErrorValue], ax
'
' Locks or unlocks the drive.
'
' On error sets the Carry flag and the AX register to one of these error values:
' 01h  Function not supported
' B0h  Volume not locked in drive
' B2h  Not volume
' B4h  Lock count exceeded
'
'
' DriveNum   (BX)    Specifies the drive for the operation.
'                    Can be zero through for the default drive, 1 for A, 2 for B, and so on.
' ParamBlock (DS:DX) Address of the parameter block for the function.
'                    The block has two byte fields.
'                    The first is LOCK_UNLOCK_OP, which has one of the following values:
'                    0  Lock volume in drive
'                    1  UnLock volume in drive
'                    02  Return lock/unlock status
'                    The values 03h through 0FFh are reserved.
'
'                    The second byte field is filled on return from the call as the lock status
'                    of the drive.
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 14 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

'Lock media
Call DeviceIoControl(hLwStatus, VWIN32_DIOC_DOS_IOCTL, _
   RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), _
   retDummy, ByVal 0)
Debug.Print "(lock=1/unlock=0) =" & PMR9x.P2