Die Community zu .NET und Classic VB.
Menü

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

 von 

Beschreibung 

Eigentlich sagt der Titel alles. Dieser Tipp zeigt, wie verhindert werden kann, dass während eines Lesevorgangs die CD aus dem Laufwerk entfernt wird.
Als kleine Zugabe steht am Ende des Codes auch, wie sich das ganze in ASM lösen ließe.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CloseHandle, CreateFileA (CreateFile), DeviceIoControl, GetVersionExA (GetVersionEx)

Download:

Download des Beispielprojektes [3,98 KB]

'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-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

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.

Kommentar von Nico am 15.07.2009 um 18:00

Hallo Leute,

kann sich jemand mal bitte um die Konvertierung zu VB2008.Net kümmern (es gibt Probleme mit dem Typ "As Any").
Wäre echt genial, da ich CSharper bin und mit VB nicht wirklich arbeite...

Danke schon mal im Voraus,

MfG,

Nico

Kommentar von Volta am 25.06.2007 um 19:35

Ich habe das Programm auf FreeBASIC umgeschrieben.
Unter XP funktioniert es einwandfrei (auch ohne Admin - Rechte)
Unter ME gab es Probleme, bis ich diese Zeile auskommentierte:
'PMR9x.P2 = 0
Es stellte sich heraus, dass dies ein Rückgabewert ist, den man abfragen aber nicht setzen kann.

'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

Kommentar von Frank am 01.11.2006 um 19:32

Zum Problem von Burny:

Theoretisch sollte es funktionieren, wenn man zum Beispiel Nero BurnRight installiert und den entsprechenden Nutzern die Brennrechte verleiht.

Kommentar von Frank am 01.11.2006 um 19:23

Im Quelltext ist

' unlock Parameter für Win NT/2K/XP
PMR32.P1 = 0

angegeben. Ich habe mir den Quelltext in Delphi übersetzt und unter Win2000Prof getestet. Dabei hat das Unlock mit dem Wert 0 nicht funktioniert. Erst als ich ihn in 2 änderte, funktionierte es.

Kommentar von Burny am 02.07.2006 um 21:31

Das Programm funktioniert unter XP nur als Administrator. Weiß jemand, an welcher Einstellung man drehen muss, damit es auch als Hauptbenutzer oder gar eingeschränkter Benutzer funktioniert? Die "normalen Benutzerrechte" bei Eigenschaften und die Registry sind es meines erachtens nach nicht. Vielen Dank für eine Antwort.

Kommentar von Mighty Panther am 01.05.2005 um 15:59

1.) LOCK/UNLOCK funktioniert unter NT/2000/XP problemlos!
2.) LOCK klappt funktioniert unter 9x/ME auch problemlos!
3.) UNLOCK funktioniert unter 9x/ME gar nicht...
- lässt sich zwar mit mciSendString "Door Open" wieder entriegeln (ohne Neustart), nur öffnet sich das CD Laufwerk dabei und das ist ja eigentlich nicht gewollt!

Wenn jemand das gleiche Problem hat und vielleicht sogar ein Lösung... Bitte melden!

Thx & MfG

Kommentar von SantaClaus am 29.01.2005 um 11:18

gute idee so ein wichtiges programm zu schreiben. mein cd-laufwerk wird nie wieder aufgehen, danke. ich werde sie verklagen und bis an ihr lebensende verfolgen. ich werde sie in eine ecke drängen und dann ...

vielen dank für ihr programm

ihr santaclaus

Kommentar von jxc am 30.06.2004 um 17:52

Irgendwie hab ich das Gefühl als ob das Programm nur bein Win XP geht. Bei mienen Freunden die kein Xp habe gehts net

Kommentar von scharfersenf am 17.06.2004 um 23:50

Hat teilweise geklappt. Nur ein Laufwerk (von zweien) lässt sich nicht blockieren. Kann es sein, dass manche Laufwerke (ist schon älter) sich nicht durch software blockieren lassen??? Wäre nett, wenn mir jemand ne email schreiben könnte.

Kommentar von Felix Weiß am 26.09.2003 um 19:44

Diese weise ein CDROM-Laufwerk zu sperren arbeitet wie ein Zähler, wenn man es dreimal verschließt, muss man es wieder dreimal entriegeln, um es zu öffnen. Umgekehrt ist dies nicht möglich.

Kommentar von xx am 14.09.2003 um 17:26

ging nich, ich musste erst den treiber neu installieren

Kommentar von Philipp Stephani am 07.09.2003 um 18:58

Dann mach doch nen Neustart!

Kommentar von xx am 07.09.2003 um 12:46

euer scheiß ding hat mein laufwerk gesperrt, nun geht es nich mehr auf!!!

Kommentar von Philipp Stephani am 21.08.2003 um 19:24

So weit ich weiß, funktioniert die Assembler Variante nicht, da WIndows keinen direkten Zugriff auf das Dateisystem erlaubt. Es geht nur per IOCTL-Funktion.