Beiträge von BugFix

BOOL PreventRemovalOfVolume(HANDLE hVolume, BOOL fPreventRemoval)
{
    DWORD dwBytesReturned;
    PREVENT_MEDIA_REMOVAL PMRBuffer;


    PMRBuffer.PreventMediaRemoval = fPreventRemoval;


    return DeviceIoControl( hVolume,
        IOCTL_STORAGE_MEDIA_REMOVAL,
        &PMRBuffer, sizeof(PREVENT_MEDIA_REMOVAL),
        NULL, 0,
        &dwBytesReturned,
        NULL);
}

The IOCTL_STORAGE_MEDIA_REMOVAL DeviceIoControl operation enables or disables the mechanism that ejects media, for those devices possessing that locking capability.


dwIoControlCode = IOCTL_STORAGE_MEDIA_REMOVAL;   // operation code 


lpInBuffer;         // address of input buffer 


nInBufferSize;      // size of input buffer 


lpOutBuffer = NULL; // address of output buffer; not used; must be NULL 


nOutBufferSize = 0; // size of output buffer; not used; must be zero 


lpBytesReturned;    // address of actual bytes of output

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmCDRomLock 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "CDRom-Lock"
   ClientHeight    =   2655
   ClientLeft      =   45
   ClientTop       =   780
   ClientWidth     =   2535
   Icon            =   "CDRom-Lock.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2655
   ScaleWidth      =   2535
   WhatsThisHelp   =   -1  'True
   Begin VB.CheckBox chkPWDSucceeded 
      Caption         =   "chkPasswordSucceeded"
      Height          =   255
      Left            =   4680
      TabIndex        =   9
      Top             =   1680
      Visible         =   0   'False
      Width           =   2535
   End
   Begin VB.CheckBox chkWait 
      Caption         =   "chkWait"
      Height          =   255
      Left            =   4680
      TabIndex        =   8
      Top             =   1440
      Visible         =   0   'False
      Width           =   2295
   End
   Begin MSComctlLib.ImageCombo imgCboDrives 
      Height          =   330
      Left            =   120
      TabIndex        =   7
      Top             =   120
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   582
      _Version        =   393216
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Locked          =   -1  'True
      Text            =   "imgCboDrives"
   End
   Begin MSComctlLib.ImageList imgList 
      Left            =   3120
      Top             =   960
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "CDRom-Lock.frx":0442
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "CDRom-Lock.frx":059C
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.TextBox txtPWRMessage 
      Height          =   615
      Left            =   2640
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   1800
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Timer TimerSuspend 
      Interval        =   5000
      Left            =   3720
      Top             =   1080
   End
   Begin VB.OptionButton optClose 
      Caption         =   "Close"
      Height          =   255
      Left            =   600
      TabIndex        =   5
      ToolTipText     =   "close CD/DVD drive (if supportet by the drive)"
      Top             =   1800
      Width           =   1335
   End
   Begin VB.OptionButton optOpen 
      Caption         =   "Open"
      Height          =   255
      Left            =   600
      TabIndex        =   4
      ToolTipText     =   "open CD/DVD drive"
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CheckBox chkAll 
      Caption         =   "all CD/DVD drives"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      ToolTipText     =   "enable to perform action at all devices"
      Top             =   600
      Width           =   1695
   End
   Begin VB.CommandButton cmdDo 
      BackColor       =   &H80000004&
      Caption         =   "OK"
      Height          =   375
      Left            =   600
      TabIndex        =   2
      Top             =   2160
      Width           =   1215
   End
   Begin VB.OptionButton optUnlock 
      Caption         =   "Unlock"
      Height          =   255
      Left            =   600
      TabIndex        =   1
      ToolTipText     =   "unlock the CD-Rom button"
      Top             =   1200
      Value           =   -1  'True
      Width           =   1335
   End
   Begin VB.OptionButton optLock 
      Caption         =   "Lock"
      Height          =   255
      Left            =   600
      TabIndex        =   0
      ToolTipText     =   "lock the CD-Rom button"
      Top             =   960
      Width           =   1335
   End
   Begin VB.Menu mnuPopup 
      Caption         =   "PopupMenu"
      Visible         =   0   'False
      Begin VB.Menu mnuLock 
         Caption         =   "Lock"
         Begin VB.Menu mnuLockSub 
            Caption         =   "mnuLockSub"
            Checked         =   -1  'True
            Index           =   0
            Visible         =   0   'False
         End
         Begin VB.Menu mnuLockAll 
            Caption         =   "Lock All Devices"
         End
      End
      Begin VB.Menu mnuUnlock 
         Caption         =   "Unlock"
         Begin VB.Menu mnuUnlockSub 
            Caption         =   "mnuUnlockSub"
            Checked         =   -1  'True
            Index           =   0
            Visible         =   0   'False
         End
         Begin VB.Menu mnuUnlockAll 
            Caption         =   "Unlock all devices"
         End
      End
      Begin VB.Menu mnuSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "Open"
         Begin VB.Menu mnuOpenSub 
            Caption         =   "mnuOpenSub"
            Index           =   0
            Visible         =   0   'False
         End
         Begin VB.Menu mnuOpenAll 
            Caption         =   "Open All Devices"
         End
      End
      Begin VB.Menu mnuClose 
         Caption         =   "Close"
         Begin VB.Menu mnuCloseSub 
            Caption         =   "mnuCloseSub"
            Index           =   0
            Visible         =   0   'False
         End
         Begin VB.Menu mnuCloseAll 
            Caption         =   "Close All Devices"
         End
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuShow 
         Caption         =   "Maximze"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuExit2 
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuPreferences 
         Caption         =   "Preferences"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "Help"
      Begin VB.Menu mnuAbout 
         Caption         =   "About"
      End
   End
End
Attribute VB_Name = "frmCDRomLock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'CDRom-Lock - tool to lock/unlock the tray of CD/DVD drives
'Copyright (c) 2005 Nils Wiese
'
'This program is free software; you can redistribute it and/or modify it under the terms of
'the GNU General Public License as published by the Free Software Foundation; either version 2
'of the License, or (at your option) any later version.
'
'This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
'without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
'See the GNU General Public License for more details.


'You should have received a copy of the GNU General Public License along with this program;
'if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
'
'author contact:
'Nils Wiese
'email: info@cdrom-lock.de
'Internet: www.cdrom-lock.de
'


Option Explicit


'global variables
Dim PMR32 As PREVENT_MEDIA_REMOVAL
Dim blnAll As Boolean
Dim intCountDevicesCD As Integer
Dim blnLocked() As Boolean
Dim blnWriteIni As Boolean
Dim blnResume As Boolean
Dim intSelect As Integer
Dim intPress As Integer 'für Fehlermeldungen


'globale Variabel für das INI-File
Dim strIniFile$












'########################################################
' Deklarationen
' zum CD-Laufwerk sperren/freigeben
'########################################################
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 Drv As Drive, Drvs As Drives
Private Fs As New Scripting.FileSystemObject


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


'FIXIT: As Any is not supported in Visual Basic .NET. Use a specific type.                 FixIT90210ae-R5608-H1984
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

'FIXIT: As Any is not supported in Visual Basic .NET. Use a specific type.                 FixIT90210ae-R5608-H1984
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


'########################################################
' Deklarationen
' zum Entfernen des Schließen-Symbols
'########################################################
Private Declare Function GetSystemMenu Lib "user32" _
  (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" _
  (ByVal hMenu As Long, ByVal nPosition As Long, _
  ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" _
  (ByVal hWnd As Long) As Long
Private Const SC_CLOSE = &HF060
Private Const MF_BYCOMMAND = &H0


'##############################################################################
' FORM / FORMLOAD
' hier kommt alles, was mit graphischen Interface zu tun hat
'##############################################################################


Private Sub Form_Load()
    On Error GoTo ErrHandler
'FIXIT: Declare 'i' with an early-bound data type                                          FixIT90210ae-R1672-R1B8ZE
    Dim i, j As Integer
    Dim lngTest As Long
    Dim error As Boolean
'FIXIT: Declare 's' with an early-bound data type                                          FixIT90210ae-R1672-R1B8ZE
    Dim s, n As String, sOS As String, temp As String
    Dim strDrive As String
    Dim intLock As Integer
    Dim intResume As Integer
    Dim intMinimizeToTray As Integer

    Dim intDeviceValue As Integer
    Dim intDeviceAll As Integer
    Dim intLastState As Integer
    Dim lngDelay As Long
    Dim sMsg As String
    Dim X%
    'Password related variables
    Dim strPWDFile$
    Dim blnPasswordOld As Boolean
    Dim strPasswordOld As String
    Dim strPasswordEncoded As String

    If App.PrevInstance Then
        End
    End If

    DisableCloseButton Me.hWnd

    'initialise local/global variables
    blnWriteIni = False
    'blnResumeSuspend = False
    error = False
    Set Drvs = Fs.Drives
    intDeviceAll = 0
    intDeviceValue = 0
    blnAll = True
    intCountDevicesCD = 0
    lngDelay = 0

    'initialise Path to INI-File
    strIniFile = App.Path & "\CDRom-Lock.ini"

    'initialise images in imgCbODrives
    imgCboDrives.ImageList = imgList

    Call SetLanguage(strIniFile)

    'Default-Werte aus INI-File auslesen
    intDeviceAll = CInt(INIGetValue(strIniFile, "Default", "DeviceAll"))
    intLastState = CInt(INIGetValue(strIniFile, "Default", "UseLastState"))
    intMinimizeToTray = CInt(INIGetValue(strIniFile, "Default", "Minimize"))
    intResume = CInt(INIGetValue(strIniFile, "Default", "Standby"))
    lngDelay = CLng(INIGetValue(strIniFile, "Default", "Delay"))
    frmPreferences.chkLockAll.Value = intDeviceAll
    frmPreferences.chkSaveState.Value = intLastState
    frmPreferences.chkMinimizeToTray.Value = intMinimizeToTray
    frmPreferences.chkResume = intResume

    'Check, if password protection is switched on
    strPWDFile = App.Path & "\password.txt"
    strPasswordEncoded = INIGetValue(strPWDFile, "Password", "Password")
    strPasswordOld = EncodeString(strPasswordEncoded, "9om1z25kOq33FCh2SossUFbnrtf3M000")

    If strPasswordOld <> "" Then
        blnPasswordOld = True
        frmPreferences.chkPassword = 1
    Else
        blnPasswordOld = False
        frmPreferences.chkPassword = 0
    End If

    'Auswerten der Default-Werte
    '1.) letzten Zustand oder alle Sperren?
    If intLastState = 1 Then
        frmPreferences.chkSaveState = 1
        frmPreferences.chkLockAll.Enabled = False
    Else
        frmPreferences.chkSaveState = 0
        frmPreferences.chkLockAll.Enabled = True
    End If

    '2.) ein wenig warten, (lngDelay)
    MsgWaitObj (lngDelay)

    'alle Laufwerke auf CD/DVD devices scannen und in Liste eintragen
    For Each Drv In Drvs
        n = ""
        s = ""
        s = Drv.DriveLetter & ":"
        If Drv.DriveType = 3 Then
            n = Drv.ShareName
        Else
            If Drv.DriveType = 4 Then
                temp = Drv.VolumeName
                If temp = "" Then
                    n = " CD/DVD"
                Else
                    n = " CD/DVD" & temp
                End If
                imgCboDrives.ComboItems.Add (intCountDevicesCD + 1), , s
                imgCboDrives.ComboItems(intCountDevicesCD + 1).Image = 1
                intCountDevicesCD = intCountDevicesCD + 1
                'Device in Popup-Menu eintragen
                Call AddMenuItem(s, "mnuLock")
                Call AddMenuItem(s, "mnuUnlock")
                Call AddMenuItem(s, "mnuOpen")
                Call AddMenuItem(s, "mnuClose")
            Else
                n = Drv.VolumeName
            End If
        End If
    Next
    imgCboDrives.ComboItems.Item(1).Selected = True

    ReDim blnLocked(0 To (intCountDevicesCD - 1))

    'erst einmal alle Laufwerke unlocken
    Call CDLock(intCountDevicesCD, blnAll)


    'ReDim blnLocked-Array und alle Einträge auf False setzen, da alle Laufwerke unlocked sind
    For i = 0 To (intCountDevicesCD - 1)
    'For i = 0 To 99
        blnLocked(i) = False
    Next


    'ab hier müssen immer alle Zustandsänderungen der Laufwerke ins INI-File geschrieben werden
    blnWriteIni = True

    If intDeviceAll = 1 Then
        If intLastState = 1 Then
            blnAll = False
            frmCDRomLock.chkAll = 0
            SetCurrentState
        Else
            blnAll = True
            frmCDRomLock.chkAll = 1
            frmCDRomLock.optLock_Click
        End If
    Else
        If intLastState = 1 Then
            blnAll = False
            frmCDRomLock.chkAll = 0
            SetCurrentState
        Else
            blnAll = True
            frmCDRomLock.chkAll = 0
            frmCDRomLock.optUnlock_Click
        End If
    End If

    'Wenn alle Laufwerke per Default gesperrt oder freigegeben werden sollen, dann jetzt durchführen
    If blnAll = True Then frmCDRomLock.cmdDo_Click


    'Uncheck All devices and set blnAll to False
    frmCDRomLock.chkAll = 0
    blnAll = False

    'minimize to tray
    If intMinimizeToTray = 1 Then
        AddToTray frmCDRomLock, mnuPopup
        SetTrayTip ("CDRom-Lock")
        'If WindowState <> vbMinimized Then WindowState = vbMinimized
        frmCDRomLock.Visible = False
'FIXIT: App.TaskVisible property has no Visual Basic .NET equivalent and will not be upgraded.     FixIT90210ae-R7593-R67265
        App.TaskVisible = False
    End If

    'Wenn nach Standby der Zustand zurückgesetzt werden soll...
    'If frmPreferences.chkResume = 1 Then
        frmCDRomLock.txtPWRMessage = "NA"
        oldProcAddress = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf VB_WindowProc)
    'End If

Exit_Sub:
    Exit Sub


ErrHandler:
    Select Case Err.Number
        Case 13:    Resume Exit_Sub ' wahrscheinlich INI-File nicht gefunden. Wird an anderer Stelle gemeldet.
        Case 71:    Resume Next   'drive A not ready (empty). Überspringen
        Case Else:  Call Undefined_Error(Err.Number, Err.Description, "frmCDRomLock.Form_Load()")
    End Select
    Resume Exit_Sub


End Sub






'###############################################################################
' CD LOCK / UNLOCK
' hier kommt alles, was mit dem Sperren und Freigeben vom CD-Laufwerk zu tun hat
'###############################################################################
Public Sub CDLock(intCountDevicesCD As Integer, blnAll As Boolean)
    'Dieses Sub lockt oder unlockt vorhandenen CD-Laufwerke,
    'abhängig vom momentanen Wert von P32.P1 (0=unlock, 1=lock)
    On Error GoTo ErrHandler
    Dim strMsg As String
    Dim OSV As OSVERSIONINFO
    Dim hLwStatus As Long
    Dim strDrive As String
    Dim retDummy As Long
    Dim blnWrongOS As Boolean
    Dim i As Integer
    Dim error As Boolean
    Dim strStatus As String
    Dim blnPWD As Boolean
    Dim intTemp As Integer, intDeviceCurrent As Integer

    'Parameter zum unlocken setzen
    blnWrongOS = False

    ' Betriebssystem-Plattform bestimmen
    OSV.dwOSVersionInfoSize = 148
    OSV.szCSDVersion = Space$(128)
    retDummy = GetVersionEx(OSV)

    strStatus = ""

    If blnAll = True Then
        'für alle Devices LockCD_WinNT aufrufen
        For i = 0 To intCountDevicesCD - 1
            imgCboDrives.ComboItems(i + 1).Selected = True

            strDrive = imgCboDrives.SelectedItem.Text

            Call Get_Driveletter(strDrive, error)

            intTemp = PMR32.P1
            If intTemp = 0 Then
                blnLocked(i) = False
                imgCboDrives.ComboItems(i + 1).Text = strDrive & " unlocked"
                imgCboDrives.ComboItems(i + 1).Image = 1
                mnuLockSub(i + 1).Checked = False
                mnuUnlockSub(i + 1).Checked = False
            End If

            ' Windows NT/2000/XP
            If OSV.dwPlatformId >= 2 Then
                If blnLocked(i) = False Then
                    Call LockCD_WinNT(hLwStatus, strDrive, retDummy)
                'Else
                'strMsg = "Device" & i & " is already locked"
                '    MsgBox strMsg
                End If

            If intTemp = 1 Then
                'blnTemp = True
                blnLocked(i) = True
                imgCboDrives.ComboItems(i + 1).Text = strDrive & " locked"
                imgCboDrives.ComboItems(i + 1).Image = 2
                mnuLockSub(i + 1).Checked = True
                mnuUnlockSub(i + 1).Checked = True
            End If
            imgCboDrives.ComboItems(1).Selected = True


            ' Win9x/Me, other
            Else
                blnWrongOS = True
            End If
        Next
    Else
        'nur für das ausgewählte Devices LockCD_WinNT aufrufen
        intDeviceCurrent = imgCboDrives.SelectedItem.Index - 1
        strDrive = imgCboDrives.SelectedItem.Text

        Call Get_Driveletter(strDrive, error)

        intTemp = PMR32.P1
        If intTemp = 0 Then
            blnLocked(intDeviceCurrent) = False
            imgCboDrives.ComboItems(intDeviceCurrent + 1).Text = strDrive & " unlocked"
            imgCboDrives.ComboItems(intDeviceCurrent + 1).Image = 1
            mnuLockSub(intDeviceCurrent + 1).Checked = False
            mnuUnlockSub(intDeviceCurrent + 1).Checked = False
        End If


        ' Windows NT/2000/XP
        If OSV.dwPlatformId >= 2 Then
            If blnLocked(intDeviceCurrent) = False Then
                Call LockCD_WinNT(hLwStatus, strDrive, retDummy)
            Else
                'strMsg = "Device" & intDeviceCurrent & " is already locked"
                'MsgBox strMsg
            End If

        If intTemp = 1 Then
            'blnTemp = True
            blnLocked(intDeviceCurrent) = True
            imgCboDrives.ComboItems(intDeviceCurrent + 1).Text = strDrive & " locked"
            imgCboDrives.ComboItems(intDeviceCurrent + 1).Image = 2
            mnuLockSub(intDeviceCurrent + 1).Checked = True
            mnuUnlockSub(intDeviceCurrent + 1).Checked = True
        End If

       ' Win9x/Me, other
        Else
            blnWrongOS = True
        End If
    End If

    If blnWrongOS = True Then
        strMsg = "This program only works on Windows NT/2000/XP"
        MsgBox strMsg
    End If


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "CDLock()")
    Resume Exit_Sub


End Sub








'##############################################################################
'hier kommt alles, was mit dem Öffnen und Schließen vom CD-Laufwerk zu tun hat
'##############################################################################


Private Sub OpenCD()
    On Error GoTo ErrHandler
    Dim strDrive As String
    Dim intDevice As Integer, i As Integer

    Dim error As Boolean

    If blnAll = True Then
        'von allen Laufwerken die Schublade öffnen
        For i = 0 To intCountDevicesCD - 1
            imgCboDrives.ComboItems(i + 1).Selected = True
            strDrive = imgCboDrives.SelectedItem.Text
            intDevice = imgCboDrives.SelectedItem.Index - 1

            Call Get_Driveletter(strDrive, error)
            If error = True Then Exit Sub

            If blnLocked(intDevice) = True Then
                'Auswurf muß erst freigegeben werden
                PMR32.P1 = 0
                Call CDLock(intDevice, False)

                'Laufwerk öffnen
                x_CDOpen strDrive

                'Auswurfknopf wieder sperren
                PMR32.P1 = 1
                Call CDLock(intDevice, False)

            Else: x_CDOpen strDrive
            End If
        Next
        imgCboDrives.ComboItems(1).Selected = True


    Else
        'nur von ausgewähltem Laufwerk die Schublade öffnen
        intDevice = imgCboDrives.SelectedItem.Index - 1
        strDrive = imgCboDrives.SelectedItem.Text

        Call Get_Driveletter(strDrive, error)
        If error = True Then Exit Sub

        If blnLocked(intDevice) = True Then
            'Auswurf muß erst freigegeben werden
            PMR32.P1 = 0
            Call CDLock(intDevice, False)

            'Laufwerk öffnen
            x_CDOpen strDrive

            'Auswurfknopf wieder sperren
            PMR32.P1 = 1
            Call CDLock(intDevice, False)
        Else: x_CDOpen strDrive
        End If
    End If


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "OpenCD()")
    Resume Exit_Sub


End Sub


Private Sub CloseCD()
    On Error GoTo ErrHandler
    Dim strDrive As String
    Dim error As Boolean
    Dim intDevice As Integer, i As Integer

    Call Get_Driveletter(strDrive, error)
    If error = True Then GoTo Exit_Sub

    x_CDClose strDrive
        If blnAll = True Then
        'von allen Laufwerken die Schublade schließen
        For i = 0 To intCountDevicesCD - 1
            imgCboDrives.ComboItems(i + 1).Selected = True
            strDrive = imgCboDrives.SelectedItem.Text
            intDevice = imgCboDrives.SelectedItem.Index - 1


            Call Get_Driveletter(strDrive, error)
            If error = True Then Exit Sub

            x_CDClose strDrive
        Next
        imgCboDrives.ComboItems(1).Selected = True


    Else
        'nur von ausgewähltem Laufwerk die Schublade schließen
        intDevice = imgCboDrives.SelectedItem.Index - 1
        strDrive = imgCboDrives.SelectedItem.Text

        Call Get_Driveletter(strDrive, error)
        If error = True Then Exit Sub

        x_CDClose strDrive
    End If


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "CloseCD()")
    Resume Exit_Sub


End Sub


Public Sub chkAll_Click()
    On Error GoTo ErrHandler
    If chkAll = 1 Then
        blnAll = True
    Else: blnAll = 0
    End If

Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "chkAll_Click()")
    Resume Exit_Sub

End Sub


Private Sub mnuAbout_Click()
    frmAbout.Visible = True
End Sub


Private Sub mnuCloseAll_Click()
    On Error GoTo ErrHandler
    frmCDRomLock.optClose.Value = True
    frmCDRomLock.chkAll.Value = 1
    frmCDRomLock.chkAll_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuCloseAll_Click()")
    Resume Exit_Sub


End Sub


Private Sub mnuOpenAll_Click()
    On Error GoTo ErrHandler
    frmCDRomLock.optOpen.Value = True
    frmCDRomLock.chkAll.Value = 1
    frmCDRomLock.chkAll_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuOpenAll_Click()")
    Resume Exit_Sub


End Sub


Public Sub optLock_Click()
    optLock.Value = True
    intSelect = 1
End Sub
 
Public Sub optUnlock_Click()
   optUnlock.Value = True
   intSelect = 2
End Sub


Public Sub optOpen_Click()
    optOpen.Value = True
    intSelect = 3
End Sub


Public Sub optClose_Click()
    optClose.Value = True
    intSelect = 4
End Sub




'##################################################################
' MENU
' ab hier kommen alle Teile, die mit den Menues zu tun haben
'##################################################################


Public Sub mnuExit_Click()
Dim blnExit As Boolean
    Call Exit_CDLock(blnExit)
    If blnExit = True Then
        Unload Me
    End If
    'End
End Sub


Private Sub mnuExit2_Click()
Dim blnExit As Boolean
    Call Exit_CDLock(blnExit)
    If blnExit = True Then
        Unload Me
    End If
    'End
End Sub


Public Sub Exit_CDLock(ByRef bExit As Boolean)
Dim intPress1 As Integer
Dim intlang As Integer
On Error GoTo ErrHandler


    'Fragen ob Laufwerke wieder freigegeben werden sollen
    intlang = INIGetValue(strIniFile, "Language", "Language")

    Select Case intlang
    Case 0
        intPress1 = MsgBox("Exit CDRom-Lock?" & Chr(13) & Chr(10) & Chr(13) _
        & Chr(10) & "CDRom-Lock will unlock all CD/DVD drives at programme exit.", _
        vbQuestion + vbOKCancel, "Exit CDRom-Lock")
    Case 1
        intPress1 = MsgBox("CDRom-Lock beenden?" & Chr(13) & Chr(10) & Chr(13) _
        & Chr(10) & "CDRom-Lock wird alle Laufwerke nach Programmende wieder freigeben.", _
        vbQuestion + vbOKCancel, "CDRom-Lock beenden")
    Case Else
        intPress1 = MsgBox("Exit CDRom-Lock?" & Chr(13) & Chr(10) & Chr(13) _
        & Chr(10) & "CDRom-Lock will unlock all CD/DVD drives at programme exit.", _
        vbQuestion + vbOKCancel, "Exit CDRom-Lock")
    End Select


    If intPress1 = 1 Then
        blnWriteIni = False
        frmCDRomLock.chkAll = 1
        frmCDRomLock.optUnlock = True
        Call frmCDRomLock.cmdDo_Click


        If frmCDRomLock.chkPWDSucceeded.Value = 1 Or frmPreferences.chkPassword.Value = 0 Then
            frmCDRomLock.Show
            'RemoveFromTray
            'Call SetWindowLong(Me.hWnd, GWL_WNDPROC, oldProcAddress)
            'Unload frmAbout
            'Unload frmPreferences
            'Unload frmCDRomLock
            bExit = True
        Else
            'Password not correct
            'GoTo Exit_Sub
            bExit = False
        End If
    End If

Exit_Sub:
    Exit Sub

ErrHandler:
    Select Case Err.Number
        Case 13:    Resume Next ' wahrscheinlich INI-File nicht gefunden. Wird an anderer Stelle gemeldet.
        Case Else:  Call Undefined_Error(Err.Number, Err.Description, "mnuExit_Click()")
    End Select
    Resume Next
End Sub


Private Sub mnuShow_Click()
    WindowState = vbNormal
    frmCDRomLock.Visible = True

    'Form_MouseMove 0, 0, 7725, 0
End Sub


Private Sub mnuLockAll_Click()
    On Error GoTo ErrHandler
    frmCDRomLock.optLock.Value = True
    frmCDRomLock.chkAll.Value = 1
    frmCDRomLock.chkAll_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuLockAll_Click()")
    Resume Exit_Sub


End Sub


Private Sub mnuUnlockAll_Click()
    On Error GoTo ErrHandler
    frmCDRomLock.optUnlock.Value = True
    frmCDRomLock.chkAll.Value = 1
    frmCDRomLock.chkAll_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuUnlockAll_Click()")
    Resume Exit_Sub


End Sub


Private Sub mnuPreferences_Click()
    frmPreferences.Visible = True
End Sub




'#############################################################
' EXECUTION
' ab hier kommen alle Teile, die Aktionen Ausführen, und evtl.
' von mehreren Programteilen verwendet werden
'#############################################################


Private Sub SetCurrentState()
On Error GoTo ErrHandler
Dim strDrive As String
Dim i As Integer
Dim intLock As Integer


'sicherstellen, daß nicht alle Laufwerke gesperrt/freigegeben werden
frmCDRomLock.chkAll = 0
    For i = 0 To (intCountDevicesCD - 1)
        imgCboDrives.ComboItems(i + 1).Selected = True
        strDrive = imgCboDrives.SelectedItem.Text
        strDrive = Left$(strDrive, 1)


        ' in strDrive steht nun z.B. "D:"
'FIXIT: Replace 'Left' function with 'Left$' function                                      FixIT90210ae-R9757-R1B8ZE
        strDrive = "Device" & Left(strDrive, 1)
        intLock = INIGetValue(strIniFile, "Current", strDrive)

        imgCboDrives.ComboItems(i + 1).Selected = True
        If intLock = 1 Then
            frmCDRomLock.optLock_Click
        Else: frmCDRomLock.optUnlock_Click
        End If
        frmCDRomLock.cmdDo_Click
    Next i


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "SetCurrentState()")
    Resume Exit_Sub

End Sub


'readout the chosen Driveletter
Private Sub Get_Driveletter(hDriveX As String, error As Boolean)
    On Error GoTo ErrHandler
    Dim txtDrive As String
    Dim xLockDrive As String

    txtDrive = imgCboDrives.SelectedItem.Text
'FIXIT: Replace 'UCase' function with 'UCase$' function                                    FixIT90210ae-R9757-R1B8ZE
    xLockDrive = Left$(UCase(Trim$(txtDrive)), 1)
    If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", xLockDrive) = 0 Then Exit Sub
    hDriveX = xLockDrive & ":"


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "Get_Driveletter()")
    Resume Exit_Sub


End Sub


Private Sub Form_Unload(Cancel As Integer)
    RemoveFromTray
    Unload frmAbout
    Unload frmCheckPWD
    Unload frmSetPWD
    Unload frmPreferences
    Call SetWindowLong(Me.hWnd, GWL_WNDPROC, oldProcAddress)
    'End


End Sub


Public Sub cmdDo_Click()
    On Error GoTo ErrHandler
    Dim strMsg As String
    Dim OSV As OSVERSIONINFO
    Dim retDummy As Long
    Dim txtMsg As String
    Dim blnPWD As Boolean
    Dim intlang As Integer

    ' Betriebssystem-Plattform bestimmen
    OSV.dwOSVersionInfoSize = 148
    OSV.szCSDVersion = Space$(128)
    retDummy = GetVersionEx(OSV)


    If optLock.Value = True Then
        ' lock  Parameter für Win NT/2K/XP
        PMR32.P1 = 1
    Else
        ' unlock Parameter für Win NT/2K/XP
        PMR32.P1 = 0
        If frmPreferences.chkPassword.Value = 1 Then
            If blnResume = True Then
                'System comes back from Standby/Hibernate
                blnPWD = True
            Else
                Call CheckPassword(blnPWD)
            End If
        Else
            'no password protection, therefore boolean has to be set to TRUE
            blnPWD = True
        End If

        If blnPWD = False Then
            'Message ausgeben und Aktion abbrechen
            intlang = INIGetValue(strIniFile, "Language", "Language")
            Select Case intlang
                Case 0: strMsg = "Sorry, a password is required for this action."
                Case 1: strMsg = "Sorry, für diese Aktion wird ein Password gebraucht."
                Case Else: strMsg = "Sorry, a password is required for this action."
            End Select
            MsgBox strMsg

            GoTo Exit_Sub
        End If
    End If



    Select Case intSelect
        Case 1  'Laufwerk(e) sperren
                Call CDLock(intCountDevicesCD, blnAll)


        Case 2  'Laufwerk(e) freigeben
                Call CDLock(intCountDevicesCD, blnAll)


        Case 3  'Laufwerks-Schublade öffnen
                OpenCD
        Case 4  'Laufwerks-Schublade schließen
                CloseCD
        Case Else
            txtMsg = "Action not defined."
            MsgBox txtMsg
    End Select

Exit_Sub:
    Exit Sub


   
ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "cmdDo_Click()")
    Resume Exit_Sub


End Sub


Private Sub LockCD_WinNT(hLwStatus As Long, hDriveX As String, retDummy As Long)
On Error GoTo ErrHandler
Dim strDrive As String
Dim intTemp As Integer


    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

    'den Parameter für das Laufwerk (lock/unlock) im INI-File unter [Current] setzen,
    'wenn blnWriteIni = True
    If blnWriteIni = True Then
        intTemp = PMR32.P1
'FIXIT: Replace 'Left' function with 'Left$' function                                      FixIT90210ae-R9757-R1B8ZE
        strDrive = "Device" & Left(hDriveX, 1)
        Call INISetValue(strIniFile, "Current", strDrive, intTemp)
    End If


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "LockCD_WinNT()")
    Resume Exit_Sub


End Sub








'###########################################################
' TIMER
' überprüft alle 5 sec. auf PBT_APMRESUMESUSPEND
'###########################################################


Private Sub TimerSuspend_Timer()
        On Error GoTo ErrHandler
        'Laufwerke neu setzen:
        'Dazu unterbinden, daß ins INIfile geschrieben wird
        'alle Laufwerke entsperren
        'dann Werte aus INI-File setzen
        If frmCDRomLock.txtPWRMessage = "PBT_APMRESUMESUSPEND" Then
            blnResume = True
            If frmPreferences.chkResume Then
                blnWriteIni = False
                optUnlock = True
                frmCDRomLock.chkAll = 1
                Call frmCDRomLock.chkAll_Click
                Call cmdDo_Click
                SetCurrentState
                blnWriteIni = True
                frmCDRomLock.txtPWRMessage = ""
            Else
                blnWriteIni = False
                optUnlock = True
                frmCDRomLock.chkAll = 1
                Call frmCDRomLock.chkAll_Click
                Call cmdDo_Click
                blnWriteIni = True
            End If
        End If
        blnResume = False

Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "TimerSuspend_Timer()")
    Resume Exit_Sub


End Sub






'####################################################
' EXPERIMENTELL
' ab hier experimenteller Code
'####################################################




Private Sub AddMenuItem(ByVal txtCaption As String, ByVal txtMenu As String)
Dim intNewIndex As Integer
On Error GoTo ErrHandler


    Select Case txtMenu
    Case "mnuLock":
        intNewIndex = mnuLockSub.UBound + 1
        Load mnuLockSub(intNewIndex)
        mnuLockSub(intNewIndex).Caption = txtCaption
        mnuLockSub(intNewIndex).Visible = True
    Case "mnuUnlock":
        intNewIndex = mnuUnlockSub.UBound + 1
        Load mnuUnlockSub(intNewIndex)
        mnuUnlockSub(intNewIndex).Caption = txtCaption
        mnuUnlockSub(intNewIndex).Visible = True
    Case "mnuOpen":
        intNewIndex = mnuOpenSub.UBound + 1
        Load mnuOpenSub(intNewIndex)
        mnuOpenSub(intNewIndex).Caption = txtCaption
        mnuOpenSub(intNewIndex).Visible = True
    Case "mnuClose":
        intNewIndex = mnuCloseSub.UBound + 1
        Load mnuCloseSub(intNewIndex)
        mnuCloseSub(intNewIndex).Caption = txtCaption
        mnuCloseSub(intNewIndex).Visible = True
    Case Else: Exit Sub
    End Select

Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "AddMenuItem()")
    Resume Exit_Sub


End Sub


Private Sub RemoveMenuItem(ByVal txt As String, ByVal txtMenu As String)
Dim ctl As Menu
On Error GoTo ErrHandler


    Select Case txtMenu
    Case "mnuLock":
        For Each ctl In mnuLockSub
            If ctl.Caption = txt Then Unload ctl
        Next ctl
    Case "mnuUnlock":
        For Each ctl In mnuUnlockSub
            If ctl.Caption = txt Then Unload ctl
        Next ctl
    Case Else: Exit Sub
    End Select


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "RemoveMenuItem()")
    Resume Exit_Sub




End Sub


Private Sub mnuLockSub_Click(Index As Integer)
    On Error GoTo ErrHandler
    imgCboDrives.ComboItems(Index).Selected = True

    If chkAll.Value = 1 Then
        chkAll.Value = 0
        frmCDRomLock.chkAll_Click
    End If
    frmCDRomLock.optLock_Click
    frmCDRomLock.cmdDo_Click

Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuLockSub_Click()")
    Resume Exit_Sub

End Sub


Private Sub mnuUnlockSub_Click(Index As Integer)
    On Error GoTo ErrHandler
    imgCboDrives.ComboItems(Index).Selected = True

    If chkAll.Value = 1 Then
        chkAll.Value = 0
        frmCDRomLock.chkAll_Click
    End If
    frmCDRomLock.optUnlock_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuUnlockAll_Click()")
    Resume Exit_Sub


End Sub


Private Sub mnuOpenSub_Click(Index As Integer)
    On Error GoTo ErrHandler
    imgCboDrives.ComboItems(Index).Selected = True


    If chkAll.Value = 1 Then
        chkAll.Value = 0
        frmCDRomLock.chkAll_Click
    End If
    frmCDRomLock.optOpen_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuOpenSub_Click()")
    Resume Exit_Sub

End Sub


Private Sub mnuCloseSub_Click(Index As Integer)
    On Error GoTo ErrHandler
    imgCboDrives.ComboItems(Index).Selected = True

    If chkAll.Value = 1 Then
        chkAll.Value = 0
        frmCDRomLock.chkAll_Click
    End If
    frmCDRomLock.optClose_Click
    frmCDRomLock.cmdDo_Click


Exit_Sub:
    Exit Sub


ErrHandler:
    Call Undefined_Error(Err.Number, Err.Description, "mnuCloseSub_Click()")
    Resume Exit_Sub

End Sub


'Entfernen des Schließen-Symbols
Public Sub DisableCloseButton(hWnd As Long)
  Dim hMenu As Long
  hMenu = GetSystemMenu(hWnd, 0&)
  If hMenu Then
    Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
    DrawMenuBar hWnd
  End If
End Sub


'Aktivieren des Schließen-Symbols
'Private Sub EnableCloseButton()
'    EnableCloseButton frmCDRomLock.hWnd, True
'End Sub