Узнать состояние лотка CD-ROM(открыт/закрыт) можно с помощью функции DeviceIoControl (control code IOCTL_SCSI_PASS_THROUGH).
Для LangMF 9, cd_rom_9.mf:
'
' Переключатель лотка CDROM. Сценарий опрашивает состояние лотка CDROM(открыт/закрыт) с помощью DeviceIoControl.
' Если лоток закрыт, сценарий открывает его и наоборот.
'
' Lang LangMF9
' OC Win7
'
'
<#Module=CDROM>
'Private Type SCSI_PASS_THROUGH
'Length As Integer
'ScsiStatus As Byte
'PathId As Byte
'TargetId As Byte
'Lun As Byte
'CdbLength As Byte
'SenseInfoLength As Byte
'DataIn As Long
'DataTransferLength As Long
'TimeOutValue As Long
'DataBufferOffset As Long
'SenseInfoOffset As Long
'Cdb(16) As Byte
'End Type
'Private Type SCSI_PASS_THROUGH_BUFFER
'Header As SCSI_PASS_THROUGH
'SenseBuffer(32) As Byte
'DataBuffer(192) As Byte
'End Type
Private Const SCSI_IOCTL_DATA_IN = 1
Private Const SCSIOP_MECHANISM_STATUS = &HBD
Private Const IOCTL_SCSI_PASS_THROUGH = &H4D004
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_EXECUTE = &H20000000
Private Const GENERIC_ALL = &H10000000
Private Const FILE_SHARE_READ = 1
Private Const FILE_SHARE_WRITE = 2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_DEVICE = &H40
Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const OPEN_EXISTING = 3
Private Const IOCTL_DISK_EJECT_MEDIA = &H74808
Private Const IOCTL_DISK_LOAD_MEDIA = &H7480C
Private Const INVALID_HANDLE_VALUE = -1
Private Const SCSI_PASS_THROUGH_LEN = 44
Private Const SENSE_BUF_LEN = 32
Private Const DATA_BUF_LEN = 192
' ///Буква диска///
'---------------------------------------------------
Private Const sDiskLtr = "D"
Private Const CDROM_TYPE = 4
' Общие переменные
'---------------------------------------------------
Private BUF_LEN, b1, hDev, DATA_BUF, sDiskLetter
'---------------------------------------------------
Sub Load(cmdstr)
Dim oScr
Dim SENSE_BUF, p1
sDiskLetter = sDiskLtr
sDiskLetter = InputBox("Укажите букву диска:", "Буква диска", sDiskLetter)
If Len(sDiskLetter) = 0 Then EndMF: Exit Sub
sDiskLetter = Trim(sDiskLetter & ":")
' Проверить наличие и тип устройства
'--------------------------------------------
Set oScr = CreateObject("Scripting.FileSystemObject")
If Not oScr.DriveExists(sDiskLetter) Then
MsgBox "Диск [" & sDiskLetter & "] не существует.",vbSystemModal + vbExclamation, "Error"
EndMF: Exit Sub
End If
If oScr.GetDrive(sDiskLetter).DriveType<>CDROM_TYPE Then
MsgBox "Диск [" & sDiskLetter & "] не является CDROM.",vbSystemModal + vbExclamation, "Error"
EndMF: Exit Sub
End If
' Подготовить и заполнить структуру SCSI_PASS_THROUGH_BUFFER,
' которая содержит вложенную структуру SCSI_PASS_THROUGH.
' Использован Sys.DynAPI.CurBuf т.к. в таком случае
' легче осуществить выравнивание структуры.
'--------------------------------------------
BUF_LEN = SCSI_PASS_THROUGH_LEN + SENSE_BUF_LEN + DATA_BUF_LEN
Sys.DynAPI.CurBuf = 1
Sys.DynAPI.ReBuf(BUF_LEN)
p1 = Sys.DynAPI.PtrBuf(1)
b1 = p1
'--------------------------------------------
'/SCSI_PASS_THROUGH.Length
Sys.MemoryWord(p1)=SCSI_PASS_THROUGH_LEN
p1=p1+6
'/SCSI_PASS_THROUGH.CdbLength
Sys.MemoryByte(p1)=12
p1=p1+1
'/SCSI_PASS_THROUGH.SenseInfoLength
Sys.MemoryByte(p1)=SENSE_BUF_LEN
p1=p1+1
'/SCSI_PASS_THROUGH.DataIn
Sys.MemoryByte(p1)=SCSI_IOCTL_DATA_IN
p1=p1+4
'/SCSI_PASS_THROUGH.DataTransferLength
Sys.MemoryLong(p1)=DATA_BUF_LEN
p1=p1+4
'/SCSI_PASS_THROUGH.TimeOutValue
Sys.MemoryLong(p1)=10
p1=p1+4
'/SCSI_PASS_THROUGH.DataBufferOffset
Sys.MemoryLong(p1)=SCSI_PASS_THROUGH_LEN + SENSE_BUF_LEN
p1=p1+4
'/SCSI_PASS_THROUGH.SenseInfoOffset
Sys.MemoryLong(p1)=SCSI_PASS_THROUGH_LEN
p1=p1+4
'/SCSI_PASS_THROUGH.Cdb(0)
Sys.MemoryByte(p1)=SCSIOP_MECHANISM_STATUS
p1=p1+9
'/SCSI_PASS_THROUGH.Cdb(8)
Sys.MemoryByte(p1)=8
p1=p1+7
SENSE_BUF = p1
DATA_BUF = SENSE_BUF+32
' Открыть диск как файл
'--------------------------------------------
hDev = Sys.DynApi.CallFunction( _
"KERNEL32.DLL","CreateFileA", _
CStr("\\.\" & sDiskLetter), _
GENERIC_READ + GENERIC_WRITE, _
FILE_SHARE_READ + FILE_SHARE_WRITE, _
0, _
OPEN_EXISTING, _
0, _
0)
If hDev = INVALID_HANDLE_VALUE Then
MsgBox "Не удалось открыть устройство [" & sDiskLetter & "]" ,vbSystemModal + vbExclamation, "Error"
EndMF: Exit Sub
End If
' Опросить состояние устройства и переключить лоток CD-ROM
'--------------------------------------------
SwitchCDROM()
'--------------------------------------------
Sys.DynApi.CallFunction "KERNEL32.DLL","CloseHandle", hDev
EndMF
End Sub
'
' Опросить состояние устройства и переключить лоток CD-ROM
'
'---------------------------------------------------
Sub SwitchCDROM()
Dim val1, n1, x, OPERATION, sStr, hRes, iAnsw
' Опросить состояние устройства
'--------------------------------------------
val1 = CLng(0)
n1 = VarPtr(val1) + 8
hRes = Sys.DynApi.CallFunction( _
"KERNEL32.DLL","DeviceIoControl", _
hDev, _
IOCTL_SCSI_PASS_THROUGH, _
b1, _
BUF_LEN, _
b1, _
BUF_LEN, _
n1, _
0)
If hRes = 0 Then
MsgBox "Не удалось опросить устройство [" & sDiskLetter & "]", vbSystemModal + vbExclamation, "Error"
Exit Sub
End If
' Второй байт буфера данных содержит искомый флаг
' (000[1]0000-лоток открыт, 000[0]0000-лоток закрыт)
'--------------------------------------------
x = Sys.MemoryByte(DATA_BUF+1) And &H10
' Переключить лоток CD-ROM с помощью DeviceIoControl
'--------------------------------------------
If x = &H10 Then
sStr = "Лоток CDROM открыт. Закрыть лоток?"
OPERATION = IOCTL_DISK_LOAD_MEDIA
ElseIf x = 0 Then
sStr = "Лоток CDROM закрыт. Открыть лоток?"
OPERATION = IOCTL_DISK_EJECT_MEDIA
End If
'--------------------------------------------
iAnsw = MsgBox("Диск [" & sDiskLetter & "] " & sStr,vbSystemModal + vbExclamation + vbOKCancel, "Состояние")
If iAnsw = vbCancel Then Exit Sub
hRes = Sys.DynApi.CallFunction( _
"KERNEL32.DLL","DeviceIoControl", _
hDev, _
OPERATION, _
0, _
0, _
0, _
0, _
n1, _
0)
End Sub
<#Module>
Аналогично для LangMF 11, cd_rom_11.mf:
'
' Переключатель лотка CDROM. Сценарий опрашивает состояние лотка CDROM(открыт/закрыт) с помощью DeviceIoControl.
' Если лоток закрыт, сценарий открывает его и наоборот.
'
' Lang LangMF11
' OC Win7
'
'
<#Module=CDROM>
'Private Type SCSI_PASS_THROUGH
'Length As Integer
'ScsiStatus As Byte
'PathId As Byte
'TargetId As Byte
'Lun As Byte
'CdbLength As Byte
'SenseInfoLength As Byte
'DataIn As Long
'DataTransferLength As Long
'TimeOutValue As Long
'DataBufferOffset As Long
'SenseInfoOffset As Long
'Cdb(16) As Byte
'End Type
'Private Type SCSI_PASS_THROUGH_BUFFER
'Header As SCSI_PASS_THROUGH
'SenseBuffer(32) As Byte
'DataBuffer(192) As Byte
'End Type
Private Const SCSI_IOCTL_DATA_IN = 1
Private Const SCSIOP_MECHANISM_STATUS = &HBD
Private Const IOCTL_SCSI_PASS_THROUGH = &H4D004
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_EXECUTE = &H20000000
Private Const GENERIC_ALL = &H10000000
Private Const FILE_SHARE_READ = 1
Private Const FILE_SHARE_WRITE = 2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_DEVICE = &H40
Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const OPEN_EXISTING = 3
Private Const IOCTL_DISK_EJECT_MEDIA = &H74808
Private Const IOCTL_DISK_LOAD_MEDIA = &H7480C
Private Const INVALID_HANDLE_VALUE = -1
Private Const SCSI_PASS_THROUGH_LEN = 44
Private Const SENSE_BUF_LEN = 32
Private Const DATA_BUF_LEN = 192
' ///Буква диска///
'---------------------------------------------------
Private Const sDiskLtr = "D"
Private Const CDROM_TYPE = 4
' Общие переменные
'---------------------------------------------------
Private BUF_LEN, cBUF, hDev, DATA_BUF, sDiskLetter
'---------------------------------------------------
Sub Load(cmdstr)
Dim oScr
Dim offs, SENSE_BUF
Dim arr()
sDiskLetter = sDiskLtr
sDiskLetter = InputBox("Укажите букву диска:", "Буква диска", sDiskLetter)
If Len(sDiskLetter) = 0 Then EndMF: Exit Sub
sDiskLetter = Trim(sDiskLetter & ":")
' Проверить наличие и тип устройства
'--------------------------------------------
Set oScr = CreateObject("Scripting.FileSystemObject")
If Not oScr.DriveExists(sDiskLetter) Then
MsgBox "Диск [" & sDiskLetter & "] не существует.",vbSystemModal + vbExclamation, "Error"
EndMF: Exit Sub
End If
If oScr.GetDrive(sDiskLetter).DriveType<>CDROM_TYPE Then
MsgBox "Диск [" & sDiskLetter & "] не является CDROM.",vbSystemModal + vbExclamation, "Error"
EndMF: Exit Sub
End If
' Подготовить и заполнить структуру SCSI_PASS_THROUGH_BUFFER,
' которая содержит вложенную структуру SCSI_PASS_THROUGH.
' Использован Sys.NewBuf() т.к. в таком случае
' легче осуществить выравнивание структуры.
'--------------------------------------------
BUF_LEN = SCSI_PASS_THROUGH_LEN + SENSE_BUF_LEN + DATA_BUF_LEN
ReDim arr(BUF_LEN)
Set cBUF = Sys.NewBuf(arr)
offs=0
'/SCSI_PASS_THROUGH.Length
cBUF.PWord(offs)=SCSI_PASS_THROUGH_LEN
offs=offs+6
'/SCSI_PASS_THROUGH.CdbLength
cBUF.PByte(offs)=12
offs=offs+1
'/SCSI_PASS_THROUGH.SenseInfoLength
cBUF.PByte(offs)=SENSE_BUF_LEN
offs=offs+1
'/SCSI_PASS_THROUGH.DataIn
cBUF.PByte(offs)=SCSI_IOCTL_DATA_IN
offs=offs+4
'/SCSI_PASS_THROUGH.DataTransferLength
cBUF.PLong(offs)=DATA_BUF_LEN
offs=offs+4
'/SCSI_PASS_THROUGH.TimeOutValue
cBUF.PLong(offs)=10
offs=offs+4
'/SCSI_PASS_THROUGH.DataBufferOffset
cBUF.PLong(offs)=SCSI_PASS_THROUGH_LEN + SENSE_BUF_LEN
offs=offs+4
'/SCSI_PASS_THROUGH.SenseInfoOffset
cBUF.PLong(offs)=SCSI_PASS_THROUGH_LEN
offs=offs+4
'/SCSI_PASS_THROUGH.Cdb(0)
cBUF.PByte(offs)=SCSIOP_MECHANISM_STATUS
offs=offs+9
'/SCSI_PASS_THROUGH.Cdb(8)
cBUF.PByte(offs)=8
offs=offs+7
SENSE_BUF = offs
DATA_BUF = SENSE_BUF+32
' Открыть диск как файл
'--------------------------------------------
hDev = DllCall( "KERNEL32.DLL","CreateFileA", _
CStr("\\.\" & sDiskLetter), _
GENERIC_READ + GENERIC_WRITE, _
FILE_SHARE_READ + FILE_SHARE_WRITE, _
0, _
OPEN_EXISTING, _
0, _
0)
If hDev = INVALID_HANDLE_VALUE Then
MsgBox "Не удалось открыть устройство [" & sDiskLetter & "]", vbSystemModal + vbExclamation, "Error"
EndMF: Exit Sub
End If
' Опросить состояние устройства и переключить лоток CD-ROM
'--------------------------------------------
SwitchCDROM()
'--------------------------------------------
DllCall "KERNEL32.DLL","CloseHandle", hDev
EndMF
End Sub
'
' Опросить состояние устройства и переключить лоток CD-ROM
'
'---------------------------------------------------
Sub SwitchCDROM()
Dim b1, val1, n1, x, OPERATION, sStr, hRes, iAnsw
val1 = CLng(0)
n1 = VarPtr(val1) + 8
' Опросить состояние устройства
'--------------------------------------------
b1 = cBUF.Ptr
hRes = DllCall( "KERNEL32.DLL","DeviceIoControl", _
hDev, _
IOCTL_SCSI_PASS_THROUGH, _
b1, _
BUF_LEN, _
b1, _
BUF_LEN, _
n1, _
0)
If hRes = 0 Then
MsgBox "Не удалось опросить устройство [" & sDiskLetter & "]" ,vbSystemModal + vbExclamation, "Error"
Exit Sub
End If
' Второй байт буфера данных содержит искомый флаг
' (000[1]0000-лоток открыт, 000[0]0000-лоток закрыт)
'--------------------------------------------
x = cBUF.PByte(DATA_BUF+1) And &H10
' Переключить лоток CD-ROM с помощью DeviceIoControl
'--------------------------------------------
If x = &H10 Then
sStr = "Лоток CDROM открыт. Закрыть лоток?"
OPERATION = IOCTL_DISK_LOAD_MEDIA
ElseIf x = 0 Then
sStr = "Лоток CDROM закрыт. Открыть лоток?"
OPERATION = IOCTL_DISK_EJECT_MEDIA
End If
'--------------------------------------------
iAnsw = MsgBox("Диск [" & sDiskLetter & "] " & sStr,vbSystemModal + vbExclamation + vbOKCancel, "Состояние")
If iAnsw = vbCancel Then Exit Sub
hRes = DllCall( "KERNEL32.DLL","DeviceIoControl", _
hDev, _
OPERATION, _
0, _
0, _
0, _
0, _
n1, _
0)
End Sub
<#Module>