1 (изменено: Poltergeyst, 2019-09-29 22:02:02)

Тема: LangMF 9/11: Узнать состояние лотка CD-ROM

Без гарантий. Используете на свой страх и риск.

Узнать состояние лотка 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>