Meinst Du das Signal, welches gesendet wird, wenn man auf die "Laufwerk öffnen"-taste am Laufwerk drückt?
Ich denke, dass das Signal direkt im Laufwerk verarbeitet wird. Das heißt, Du müsstest auf die Software auf den Laufwerksplatinen zugreifen, was wohl schwierig bis unmöglich werden dürfte.
Also als Lsg. gibt es dann nur noch einmal.
Ein Laptop, zumindest meines von Siemens, hat vier dünne und zwei breite Seiten. Dann leg es doch einfach auf die langen Seiten.
Alternativ gibt es die Möglichkeit einen Rucksack zu kaufen, wo du das Laptop reinstellen kannst.
NUN ABER mal im ernst. Glaube nicht, das Du eine Möglichkeit hast das zu steuern. Ober CD-LW nach unten und rechts und links was unter legen.
LG Lina
Also so sieht das ganze mit VB aus. Hier der Code aus "CDRom-Lock.frm" des gleichnamigen Tools.
Den kpl. Sourcecode kannst du hier laden:
SourceForge.net
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 SubSo, ich hab schon mal 'nen Anfang gemacht.
Im MS-Support habe ich ein Beispiel gefunden. Natürlich unter Verwendung von Routinen, die in AutoIt nicht verfügbar sind.
Notwendig sind:
- CreateFile (habe ich schon nachgebaut und scheint zu funktionieren)
- PREVENT_MEDIA_REMOVAL (da fehlt mir noch jeder Ansatz, bzw. ich weiß nicht, wie ich das in AutoIt umsetzen soll: )
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);
}- DeviceIoControl (Dazu habe ich das Folgende, komme aber auch nicht weiter: )
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
Und hier gefundener Mustercode und meine Anfänge der Umsetzung in AutoIt:
; Lock / UnLock CD-ROM Drive Link: http://support.microsoft.com/kb/138434/de
#cs
#include <windows.h>
#include <winioctl.h> // From the Win32 SDK \Mstools\Include
#include "ntddcdrm.h" // From the Windows NT DDK \Ddk\Src\Storage\Inc
/*
This code reads sectors 16 and 17 from a compact disc and writes
the contents to a disk file named Sector.dat
*/
{
HANDLE hCD, hFile;
DWORD dwNotUsed;
// Disk file that will hold the CD-ROM sector data.
hFile = CreateFile ("sector.dat",
GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL, NULL);
// For the purposes of this sample, drive F: is the CD-ROM
// drive.
hCD = CreateFile ("\\\\.\\F:", GENERIC_READ,
FILE_SHARE_READ|FILE_SHARE_WRITE,
NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,
NULL);
// If the CD-ROM drive was successfully opened, read sectors 16
// and 17 from it and write their contents out to a disk file.
if (hCD != INVALID_HANDLE_VALUE)
{
DISK_GEOMETRY dgCDROM;
PREVENT_MEDIA_REMOVAL pmrLockCDROM;
// Lock the compact disc in the CD-ROM drive to prevent accidental
// removal while reading from it.
pmrLockCDROM.PreventMediaRemoval = TRUE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);
// Get sector size of compact disc
if (DeviceIoControl (hCD, IOCTL_CDROM_GET_DRIVE_GEOMETRY,
NULL, 0, &dgCDROM, sizeof(dgCDROM),
&dwNotUsed, NULL))
{
LPBYTE lpSector;
DWORD dwSize = 2 * dgCDROM.BytesPerSector; // 2 sectors
// Allocate buffer to hold sectors from compact disc. Note that
// the buffer will be allocated on a sector boundary because the
// allocation granularity is larger than the size of a sector on a
// compact disk.
lpSector = VirtualAlloc (NULL, dwSize,
MEM_COMMIT|MEM_RESERVE,
PAGE_READWRITE);
// Move to 16th sector for something interesting to read.
SetFilePointer (hCD, dgCDROM.BytesPerSector * 16,
NULL, FILE_BEGIN);
// Read sectors from the compact disc and write them to a file.
if (ReadFile (hCD, lpSector, dwSize, &dwNotUsed, NULL))
WriteFile (hFile, lpSector, dwSize, &dwNotUsed, NULL);
VirtualFree (lpSector, 0, MEM_RELEASE);
}
// Unlock the disc in the CD-ROM drive.
pmrLockCDROM.PreventMediaRemoval = FALSE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);
CloseHandle (hCD);
CloseHandle (hFile);
}
}
#ce
#cs Link: http://www.vbarchiv.net/vbapi/CreateFile.php
Private Declare Function CreateFile Lib "kernel32.dll" 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
#ce
Const $GENERIC_READ = 0x80000000 ; Nur Lesen
Const $GENERIC_WRITE = 0x40000000 ; Nur Schreiben
Const $FILE_SHARE_READ = 0x1
Const $FILE_SHARE_WRITE = 0x2
Const $OPEN_EXISTING = 3
Const $FILE_ATTRIBUTE_NORMAL = 0x80
Dim $Lw = 'F:' ; CD-Laufwerksbuchstabe
Dim $hCD = CreateFile("\\\\.\\" & $Lw, $GENERIC_READ, BitOR($FILE_SHARE_READ, $FILE_SHARE_WRITE), _
'NULL', $OPEN_EXISTING, $FILE_ATTRIBUTE_NORMAL, 'NULL')
If $hCD = -1 Then
MsgBox(0, 'Fehler', 'CD-Laufwerk nicht gefunden')
Exit
Else
MsgBox(0, '', "funzt")
EndIf
#cs
PREVENT_MEDIA_REMOVAL pmrLockCDROM;
// Lock the compact disc in the CD-ROM drive to prevent accidental
// removal while reading from it.
pmrLockCDROM.PreventMediaRemoval = TRUE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);
#ce
#cs
// Unlock the disc in the CD-ROM drive.
pmrLockCDROM.PreventMediaRemoval = FALSE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);
#ce
Func CreateFile($lpFileName,$dwDesiredAccess,$dwShareMode,$lpSecurityAttributes, _
$dwCreationDisposition,$dwFlagsAndAttributes,$hTemplateFile)
Return DllCall("kernel32.dll", "long", "CreateFileA", "str", $lpFileName, "long", $dwDesiredAccess, _
"long", $dwShareMode, "str", $lpSecurityAttributes, "long", $dwCreationDisposition, _
"long", $dwFlagsAndAttributes, "long", $hTemplateFile)
EndFunc
Func DeviceIoControl($hDevice,$dwIoControlCode,$lpInBuffer,$nInBufferSize, _
$lpOutBuffer,$nOutBufferSize,$lpBytesReturned,$lpOverlapped)
Return DllCall("kernel32.dll", "long", "DeviceIoControl", "long", $hDevice, "long", $dwIoControlCode, _
"str", $lpInBuffer, "long", $nInBufferSize, "str", $lpOutBuffer, "long", $nOutBufferSize, _
"long", $lpBytesReturned, "str", $lpOverlapped)
EndFunc
Edit: Die Funktion DeviceIoControl habe ich jetzt auch nachgebaut. (s. Code)
Nun muß also noch 'ne Lösung für PREVENT_MEDIA_REMOVAL her...
Die unteren beiden auskommentierten Blöcke müssen noch erledigt werden.
Vielleicht hat ja jemand 'ne Eingebung 
.
Original von sc4ry
nur wollte ich ein kleines script schreiben, dass das öffnen verhindert. doch wie fange ich das öffnen des cd-lws ab ?
Falls das mit AutoIt nicht klappt, dann sieh doch mal hier nach:
MfG. Oscar
HI,
;Purpose - Query optical drive(s) directly via SCSI or SCSI-emulation (ATAPI,USB,Firewire) to find out if their tray/door is open or closed instead of the standard methods which really query whether or not media is loaded (all of the microsoft API calls do)
;TODO - parse returned sense info from 0xBD before assuming data is OK
;TODO - support for non-drive-letter optical drives
;TODO - support for changers (both one LUN and multi-lun ones)
;TODO - add support for reading the tray lock status
;-----------------------------------------------------
; Setup Globals Environment
;-----------------------------------------------------
Global Const $INVALID_HANDLE_VALUE = 0xFFFFFFFF
Global Const $GENERIC_READ = 0x80000000
Global Const $GENERIC_WRITE = 0x40000000
Global Const $FILE_SHARE_READ = 0x00000001
Global Const $FILE_SHARE_WRITE = 0x00000002
Global Const $OPEN_EXISTING = 3
Global Const $IOCTL_SCSI_PASS_THROUGH = 0x0004D004 ; (0x00000004 << 16) | ((0x0001 | 0x0002) << 14) | (0x0401 << 2) | 0 [from CTL_CODE macro]
Global Const $SCSI_IOCTL_DATA_IN = 0x01
Global Const $SCSI_IOCTL_DATA_OUT = 0x00
Global Const $SCSI_IOCTL_DATA_UNSPECIFIED = 0x02
Global Const $SPTCDBSIZE = 0x10 ; always sixteen, IOCTL_SCSI_PASS_THROUGH requires this - windows checks to make sure the size of $spt = 44.
Global Const $REALCDBSIZE = 0x0c ; twelve - more compatible than sixteen for ATAPI drives
Global Const $SENSEBUFFERSIZE = 0xF0 ;240 is max (was 32, then 255, which was stupid for byte alignment reasons)
Global Const $DATABUFFERSIZE = 0x0400 ;1024 should handle most calls, except IO, firmware and large changers. Increase? (was 512)
;Global Const $FSCTL_LOCK_VOLUME = 0x00090018
;Global Const $FSCTL_UNLOCK_VOLUME = 0x00090022
;Global Const $IOCTL_STORAGE_EJECT_MEDIA = 0x002D0808
Global $cdb
Global $spt
Global $sptwb
;-----------------------------------------------------
; Main Routine
;-----------------------------------------------------
;Call routine to create structures to use with DLLs
CreateDLLStructures()
;Call routine to iterate through all of the Optical drives in the system allowing lock/unlock, mount/dismount and a report on the tray status.
TrayStuffForAllOpticals()
Exit (0)
[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit];-----------------------------------------------------
; Top-level Function Definitions
;-----------------------------------------------------
Func CreateDLLStructures()
$CDB_STRUCT = ("ubyte[" & String($SPTCDBSIZE) & "]")
$SCSI_PASS_THROUGH = "ushort;ubyte;ubyte;ubyte;ubyte;ubyte;ubyte;ubyte;ubyte[3];uint;uint;uint;uint;ubyte[" & String($SPTCDBSIZE) & "]"
$SCSI_PASS_THROUGH_WITH_BUFFERS = $SCSI_PASS_THROUGH & ";ubyte[" & String($SENSEBUFFERSIZE) & "];ubyte[" & String($DATABUFFERSIZE) & "]"
$cdb = DllStructCreate($CDB_STRUCT)
$spt = DllStructCreate($SCSI_PASS_THROUGH);used only for length calculations
$sptwb = DllStructCreate($SCSI_PASS_THROUGH_WITH_BUFFERS)
EndFunc ;==>CreateDLLStructures
Func PopulateCDB_TrayStatus()
$CDBCOMMAND = 0xBD ;Mechanism Status in hex
DllStructSetData($cdb, 1, $CDBCOMMAND, 1)
DllStructSetData($cdb, 1, 0x00, 2)
DllStructSetData($cdb, 1, 0x00, 3)
DllStructSetData($cdb, 1, 0x00, 4)
DllStructSetData($cdb, 1, 0x00, 5)
DllStructSetData($cdb, 1, 0x00, 6)
DllStructSetData($cdb, 1, 0x00, 7)
DllStructSetData($cdb, 1, 0x00, 
DllStructSetData($cdb, 1, 0x00, 9)
DllStructSetData($cdb, 1, 0x08, 10) ;Request that the device returns only 08 bytes into our databuffer, which is the defined size of the header We could do more if we had a changer, which would want to give more info, but by setting 8 here, we tell the device not to send more than the header anyway.
DllStructSetData($cdb, 1, 0x00, 11)
DllStructSetData($cdb, 1, 0x00, 12)
;The next four are not used for ATAPI compatibility, but should be set to zero anyway.
DllStructSetData($cdb, 1, 0x00, 13)
DllStructSetData($cdb, 1, 0x00, 14)
DllStructSetData($cdb, 1, 0x00, 15)
DllStructSetData($cdb, 1, 0x00, 16)
EndFunc ;==>PopulateCDB_TrayStatus
Func PopulateCDB_LockTray()
$CDBCOMMAND = 0x1E ;Prevent/Allow Medium Removal
DllStructSetData($cdb, 1, $CDBCOMMAND, 1)
DllStructSetData($cdb, 1, 0x00, 2)
DllStructSetData($cdb, 1, 0x00, 3)
DllStructSetData($cdb, 1, 0x00, 4)
DllStructSetData($cdb, 1, 0x01, 5); Set bit 0 to 1
DllStructSetData($cdb, 1, 0x00, 6)
DllStructSetData($cdb, 1, 0x00, 7)
DllStructSetData($cdb, 1, 0x00,
DllStructSetData($cdb, 1, 0x00, 9)
DllStructSetData($cdb, 1, 0x00, 10)
DllStructSetData($cdb, 1, 0x00, 11)
DllStructSetData($cdb, 1, 0x00, 12)
;The next four are not used for ATAPI compatibility, but should be set to zero anyway.
DllStructSetData($cdb, 1, 0x00, 13)
DllStructSetData($cdb, 1, 0x00, 14)
DllStructSetData($cdb, 1, 0x00, 15)
DllStructSetData($cdb, 1, 0x00, 16)
EndFunc ;==>PopulateCDB_LockTray
Func PopulateCDB_UnLockTray()
$CDBCOMMAND = 0x1E ;Prevent/Allow Medium Removal
DllStructSetData($cdb, 1, $CDBCOMMAND, 1)
DllStructSetData($cdb, 1, 0x00, 2)
DllStructSetData($cdb, 1, 0x00, 3)
DllStructSetData($cdb, 1, 0x00, 4)
DllStructSetData($cdb, 1, 0x00, 5); Set bit 0 to 0
DllStructSetData($cdb, 1, 0x00, 6)
DllStructSetData($cdb, 1, 0x00, 7)
DllStructSetData($cdb, 1, 0x00,
DllStructSetData($cdb, 1, 0x00, 9)
DllStructSetData($cdb, 1, 0x00, 10)
DllStructSetData($cdb, 1, 0x00, 11)
DllStructSetData($cdb, 1, 0x00, 12)
;The next four are not used for ATAPI compatibility, but should be set to zero anyway.
DllStructSetData($cdb, 1, 0x00, 13)
DllStructSetData($cdb, 1, 0x00, 14)
DllStructSetData($cdb, 1, 0x00, 15)
DllStructSetData($cdb, 1, 0x00, 16)
EndFunc ;==>PopulateCDB_UnLockTray
Func PopulateCDB_LoadDisc()
$CDBCOMMAND = 0x1B ;Start/Stop Unit
DllStructSetData($cdb, 1, $CDBCOMMAND, 1)
DllStructSetData($cdb, 1, 0x00, 2)
DllStructSetData($cdb, 1, 0x00, 3)
DllStructSetData($cdb, 1, 0x00, 4)
DllStructSetData($cdb, 1, 0x03, 5) ;00000011 = Load Disc and Spin Up
DllStructSetData($cdb, 1, 0x00, 6)
DllStructSetData($cdb, 1, 0x00, 7)
DllStructSetData($cdb, 1, 0x00,
DllStructSetData($cdb, 1, 0x00, 9)
DllStructSetData($cdb, 1, 0x00, 10)
DllStructSetData($cdb, 1, 0x00, 11)
DllStructSetData($cdb, 1, 0x00, 12)
;The next four are not used for ATAPI compatibility, but should be set to zero anyway.
DllStructSetData($cdb, 1, 0x00, 13)
DllStructSetData($cdb, 1, 0x00, 14)
DllStructSetData($cdb, 1, 0x00, 15)
DllStructSetData($cdb, 1, 0x00, 16)
EndFunc ;==>PopulateCDB_LoadDisc
Func PopulateCDB_UnLoadDisc()
$CDBCOMMAND = 0x1B ;Start/Stop Unit
DllStructSetData($cdb, 1, $CDBCOMMAND, 1)
DllStructSetData($cdb, 1, 0x00, 2)
DllStructSetData($cdb, 1, 0x00, 3)
DllStructSetData($cdb, 1, 0x00, 4)
DllStructSetData($cdb, 1, 0x02, 5) ;00000010 = Spin Down and UnLoad Disc
DllStructSetData($cdb, 1, 0x00, 6)
DllStructSetData($cdb, 1, 0x00, 7)
DllStructSetData($cdb, 1, 0x00,
DllStructSetData($cdb, 1, 0x00, 9)
DllStructSetData($cdb, 1, 0x00, 10)
DllStructSetData($cdb, 1, 0x00, 11)
DllStructSetData($cdb, 1, 0x00, 12)
;The next four are not used for ATAPI compatibility, but should be set to zero anyway.
DllStructSetData($cdb, 1, 0x00, 13)
DllStructSetData($cdb, 1, 0x00, 14)
DllStructSetData($cdb, 1, 0x00, 15)
DllStructSetData($cdb, 1, 0x00, 16)
EndFunc ;==>PopulateCDB_UnLoadDisc
Func PopulateSPTWB()
$Len_spt = DllStructGetSize($spt)
;Are these necessary if the optical drive is at a drive letter and we pass the handle, right?
;docs seem to suggest that the port driver fills these in if we are using an enumerated device
$Bus = 0x00
$ID = 0x00
$Lun = 0x00
DllStructSetData($sptwb, 1, $Len_spt);Length of pre-filler to be set before making call
DllStructSetData($sptwb, 2, 0x00);Checked on return from call
DllStructSetData($sptwb, 3, $Bus);SCSI bus # - I believe the port driver fills this in
DllStructSetData($sptwb, 4, $ID);SCSI ID # - I believe the port driver fills this in
DllStructSetData($sptwb, 5, $Lun);SCSI Lun # -I believe the port driver fills this in
DllStructSetData($sptwb, 6, $REALCDBSIZE);Length of CDB to be set before making call (12 for ATAPI compatibility)?
DllStructSetData($sptwb, 7, $SENSEBUFFERSIZE);Length of Sense buffer to be set before making call - or always 32?
DllStructSetData($sptwb, 8, $SCSI_IOCTL_DATA_IN);Flag for Data Transfer direction to be set before making call
;item #9 is simple a placehold for byte alignment, so ignore it
DllStructSetData($sptwb, 10, $DATABUFFERSIZE);Length of Data buffer to be set before making call - or always 512
DllStructSetData($sptwb, 11, 0x05);Timeout for call - to be set before making call
DllStructSetData($sptwb, 12, $Len_spt + $SENSEBUFFERSIZE);Offset from first byte to beginning of data buffer
DllStructSetData($sptwb, 13, $Len_spt);Offset from first byte to beginning of sense buffer
For $i = 1 To $SPTCDBSIZE
DllStructSetData($sptwb, 14, DllStructGetData($cdb, 1, $i), $i);12 bytes of data representing the CDB
Next
DllStructSetData($sptwb, 15, 0x00, 1);Sense Buffer - leave alone before call
DllStructSetData($sptwb, 16, 0x00, 1);Data Buffer - leave alone before call
EndFunc ;==>PopulateSPTWB
Func TrayStuffForAllOpticals()
$var = DriveGetDrive( "cdrom")
If Not @error Then
For $j = 1 To $var[0]
$hVolume = OpenVolume($var[$j])
If $hVolume = $INVALID_HANDLE_VALUE Then
MsgBox(4096, $var[$j] & " is not a valid Optical drive", "There was no optical drive at that drive letter, or you do not have high enough access to talk to it directly.")
Else
MsgBox(1, "Drive #" & $j & " of " & $var[0] & " drive(s) found!", "Hey, drive " & $var[$j] & " (" & String($hVolume) & ") is a good optical drive.")
$button = MsgBox(4, "Lock the drive tray?", "Do you wish to lock the tray for drive " & $var[$j] & "?")
If $button = 6 Then
LockTray($hVolume)
EndIf
$button = MsgBox(4, "UnLock the drive tray?", "Do you wish to unlock the tray for drive " & $var[$j] & "?")
If $button = 6 Then
UnLockTray($hVolume)
EndIf
If IsTrayOpen($hVolume) Then
MsgBox(1, "Tray Status", "The Tray for drive " & $var[$j] & " is open.")
$button = MsgBox(4, "Close the drive tray?", "Do you wish to close the drive tray and, if applicable, load (mount) the disc in the tray for drive " & $var[$j] & "?")
If $button = 6 Then
LoadDisc($hVolume)
EndIf
Else
MsgBox(1, "Tray Status", "The Tray for drive " & $var[$j] & " is closed.")
$button = MsgBox(4, "Open the drive tray?", "Do you wish to eject the tray for drive " & $var[$j] & "?")
If $button = 6 Then
UnLoadDisc($hVolume)
EndIf
EndIf
EndIf
Next
Else
MsgBox(4096, "No optical drives", "There were no optical drives found in your system")
EndIf
EndFunc ;==>TrayStuffForAllOpticals
;-----------------------------------------------------
; Lower-level Function Definitions
;-----------------------------------------------------
Func DoSCSICall(ByRef $hVolume)
$returnvalue = DllStructCreate("ptr")
;!!! DeviceIOControl expects ptr;long;ptr;long;ptr;long;ptr;ptr !!!
$ret = DllCall( _
"kernel32.dll", "int", _
"DeviceIoControl", _
"hwnd", $hVolume, _
"int", $IOCTL_SCSI_PASS_THROUGH, _
"ptr", DllStructGetPtr($sptwb), _
"int", DllStructGetSize($spt), _
"ptr", DllStructGetPtr($sptwb), _
"int", DllStructGetSize($sptwb), _
"int_ptr", $returnvalue, _
"ptr", 0 _
)
If @error Then
MsgBox(1, "EXITING...", "DeviceIoControl DLLCall failed with error level: " & String(@error) & "!")
exit (1)
EndIf
If $ret[0] = 0 Then
_GetLastErrorMessage("Error in DeviceIoControl call to IOCTL_SCSI_PASS_THROUGH:")
exit (1)
EndIf
;check the sense buffer first, otherwise the data buffer is undefined?
;guess I should learn how to do that.
;For $i = 1 To $SENSEBUFFERSIZE
; $temp = DllStructGetData($sptwb, 15, $i)
; If $temp = 0x00 Then
; Else
; MsgBox(1, "Sense Buffer Data Found", "Non zero value found at sense buffer byte [" & $i & "]: [" & $temp & "]")
; EndIf
;Next
;For $i = 1 To $DATABUFFERSIZE
; $temp = DllStructGetData($sptwb, 16, $i)
; If $temp = 0x00 Then
; Else
; MsgBox(1, "Data Buffer Data Found", "Non zero value found at data buffer byte [" & $i & "]: [" & $temp & "]")
; EndIf
;Next
EndFunc ;==>DoSCSICall
Func IsTrayOpen(ByRef $hVolume)
;Call routine to set up the CDB of this SCSI transaction's SRB, in this case 0xBD
PopulateCDB_TrayStatus()
;Call routine to set up the SCSI_PASS_THROUGH_WITH_BUFFERS stucture - this is general purpose, though the sizes of globals might need to be adjusted for certain SRBs
PopulateSPTWB(); to ensure a fresh SRB each time
;Perform the SCSI transaction
DoSCSICall($hVolume)
$second_byte = DllStructGetData($sptwb, 16, 2) ;should be the second byte
;now we need the bit here 00010000
$traystatus = BitAND($second_byte, 0x10)
If $traystatus = 0x10 Then
Return (True)
Else
Return (False)
EndIf
EndFunc ;==>IsTrayOpen
Func LockTray(ByRef $hVolume)
;Call routine to set up the CDB of this SCSI transaction's SRB
PopulateCDB_LockTray()
;Call routine to set up the SCSI_PASS_THROUGH_WITH_BUFFERS stucture - this is general purpose, though the sizes of globals might need to be adjusted for certain SRBs
PopulateSPTWB(); to ensure a fresh SRB each time
;Perform the SCSI transaction
DoSCSICall($hVolume)
;TODO: Analyze sense data to verify this worked.
EndFunc ;==>LockTray
Func UnLockTray(ByRef $hVolume)
;Call routine to set up the CDB of this SCSI transaction's SRB
PopulateCDB_UnLockTray()
;Call routine to set up the SCSI_PASS_THROUGH_WITH_BUFFERS stucture - this is general purpose, though the sizes of globals might need to be adjusted for certain SRBs
PopulateSPTWB(); to ensure a fresh SRB each time
;Perform the SCSI transaction
DoSCSICall($hVolume)
;TODO: Analyze sense data to verify this worked.
EndFunc ;==>UnLockTray
Func LoadDisc(ByRef $hVolume)
;Call routine to set up the CDB of this SCSI transaction's SRB
PopulateCDB_LoadDisc()
;Call routine to set up the SCSI_PASS_THROUGH_WITH_BUFFERS stucture - this is general purpose, though the sizes of globals might need to be adjusted for certain SRBs
PopulateSPTWB(); to ensure a fresh SRB each time
;Perform the SCSI transaction
DoSCSICall($hVolume)
;TODO: Analyze sense data to verify this worked.
EndFunc ;==>LoadDisc
Func UnLoadDisc(ByRef $hVolume)
;Call routine to set up the CDB of this SCSI transaction's SRB
PopulateCDB_UnLoadDisc()
;Call routine to set up the SCSI_PASS_THROUGH_WITH_BUFFERS stucture - this is general purpose, though the sizes of globals might need to be adjusted for certain SRBs
PopulateSPTWB(); to ensure a fresh SRB each time
;Perform the SCSI transaction
DoSCSICall($hVolume)
;TODO: Analyze sense data to verify this worked.
EndFunc ;==>UnLoadDisc
Func OpenVolume($cDriveLetter)
; From AUTOIT forums
Local $hVolume, $uDriveType, $szVolumeName, $dwAccessFlags
If StringLen($cDriveLetter) = 1 Then
$cDriveLetter = $cDriveLetter & ":"
ElseIf StringLen($cDriveLetter) = 2 Then
;do nothing
ElseIf StringLen($cDriveLetter) = 3 Then
$cDriveLetter = StringLeft($cDriveLetter, 2)
Else
Return $INVALID_HANDLE_VALUE
EndIf
Local $szRootName = $cDriveLetter & "\"
$uDriveType = DriveGetType($szRootName)
Select
Case $uDriveType == "Removable"
$dwAccessFlags = BitOR($GENERIC_READ, $GENERIC_WRITE)
Case $uDriveType == "CDROM"
;We need write access in order to send scsi commands.
$dwAccessFlags = BitOR($GENERIC_READ, $GENERIC_WRITE)
;$dwAccessFlags = $GENERIC_READ
Case Else
Return $INVALID_HANDLE_VALUE
EndSelect
$szVolumeName = "\\.\" & $cDriveLetter & ""
;$szVolumeName = "\\.\CdRom0"
;in addition to getting the handle, the following also verifies write access, which is required to use the scsi pass through
$hVolume = DllCall( _
"kernel32.dll", "hwnd", _
"CreateFile", _
"str", $szVolumeName, _
"long", $dwAccessFlags, _
"long", BitOR($FILE_SHARE_READ, $FILE_SHARE_WRITE), _
"ptr", 0, _
"long", $OPEN_EXISTING, _
"long", 0, _
"long", 0 _
)
If @error Then
MsgBox(1, "EXITING...", "CreateFile DLLCall failed!")
exit (1)
EndIf
Return $hVolume[0]
EndFunc ;==>OpenVolume
;===============================================
; _GetLastErrorMessage($DisplayMsgBox="")
; Format the last windows error as a string and return it
; if $DisplayMsgBox <> "" Then it will display a message box w/ the error
; Return Window's error as a string
;===============================================
Func _GetLastErrorMessage($DisplayMsgBox = "")
Local $ret, $s
Local $p = DllStructCreate("char[4096]")
Local Const $FORMAT_MESSAGE_FROM_SYSTEM = 0x00001000
If @error Then Return ""
$ret = DllCall("Kernel32.dll", "int", "GetLastError")
$LastError = $ret[0]
$ret = DllCall("kernel32.dll", "int", "FormatMessage", _
"int", $FORMAT_MESSAGE_FROM_SYSTEM, _
"ptr", 0, _
"int", $LastError, _
"int", 0, _
"ptr", DllStructGetPtr($p), _
"int", 4096, _
"ptr", 0)
$s = DllStructGetData($p, 1)
If $DisplayMsgBox <> "" Then MsgBox(0, "_GetLastErrorMessage", $DisplayMsgBox & @CRLF & String($LastError) & "-" & $s)
Return $s
EndFunc ;==>_GetLastErrorMessage
So long,
Mega
Hi,
Problem gelöst? Liegt es an deinem Rechner?
So long,
Mega
also ich hätte eine lösung die so funktioniert das nachdem sich das laufwerk öffnet sofort wieder schließt und wenn man auf ESC drückt beendet sich das prog
Es funktioniert zumindestens bei meinem rechner so
#include<Misc.au3>
Do
CDTray("Dein Laufwerk", "close")
Until _IsPressed("1B")