Раньше им пользовался очень активно.
- Код: Выделить всё
Attribute VB_Name = "mCD_msi"
Option Explicit
' -------------------------------------------------------------------
' VB6
' Наиболее простой способ работы с CD/DVD приводами,
' используя функцию "mciSendString",
' проще только открывать приводы кувалдой.
' Андрей Егоров "http://www.triapod.narod.ru/".
' -------------------------------------------------------------------
' Функции:
' EjectCD_msi - Открыть/Закрыть лоток CD/DVD
' GetInsertDiskCD_msi - Определить нахождение диска в приводе.
' -------------------------------------------------------------------
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hWndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Public Function EjectCD_msi(CharDriveCD As String, bEjectCD As Boolean) As Long
' Открыть/Закрыть лоток CD/DVD
' CharDriveCD = буква диска & ":"
' bEjectCD = True - Открыть лоток Привода
Dim sTemp As String
sTemp = "open cdaudio!" & CharDriveCD & " alias cdMahmud"
EjectCD_msi = mciSendString(sTemp, vbNullChar, 0&, 0&) ' Открываем устройство для работы
If EjectCD_msi = 0 Then
If bEjectCD = True Then ' Открыть лоток CD (CD Eject)
sTemp = "set cdMahmud DOOR OPEN"
Else ' Закрыть лоток CD (CD UnEject)
sTemp = "set cdMahmud DOOR CLOSED"
End If
EjectCD_msi = mciSendString(sTemp, vbNullChar, 0&, 0&) ' Выполняем ко-манду
End If
If EjectCD_msi <> 0 Then
Call MsgBoxError(EjectCD_msi) ' Обрабатываем ошибку
End If
Call mciSendString("close cdMahmud", vbNullString, 0&, 0&) ' Закрываем устройство
End Function
Public Function GetInsertDiskCD_msi(CharDriveCD As String) As Boolean
' Определить нахождение диска в приводе.
' Эта функция, НЕ ОПРЕДЕЛЯЕТ, закрыт ли лоток CD привода или открыт!
' CharDriveCD = буква диска & ":"
Dim sTemp As String, ErrorCD As Long, sBuff As String * 128
sTemp = "open cdaudio!" & CharDriveCD & " alias cdEgoSin"
ErrorCD = mciSendString(sTemp, vbNullChar, 0&, 0&) ' Открываем устройство для работы
If ErrorCD = 0 Then
sTemp = "status cdEgoSin mode"
ErrorCD = mciSendString(sTemp, sBuff, Len(sBuff), 0&) ' Получаем информацию
End If
If ErrorCD = 0 Then
sTemp = Trim$(Lsn1(sBuff))
If StrComp(sTemp, "open", vbTextCompare) <> 0 Then
GetInsertDiskCD_msi = True ' Диск находится в приводе!
End If
' MsgBox "Message: " & sTemp1
Else
Call MsgBoxError(ErrorCD) ' Обрабатываем ошибку
End If
Call mciSendString("close cdEgoSin", vbNullString, 0&, 0&)
End Function
Private Sub MsgBoxError(NumError As Long)
' Обрабатываем ошибку
Dim StrError As String * 256
Call mciGetErrorString(NumError, StrError, Len(StrError)) ' Получаем описание ошибки
MsgBox "Error Device: " & Lsn1(StrError), vbOKOnly + vbCritical ' Выводим окно с описанием ошибки
End Sub
Private Function Lsn1(Str1 As String) As String
' Обрезание строки по vbNullChar
Dim i As Integer
i = InStr(vbNull, Str1, vbNullChar) - 1
If i < 0 Then
Lsn1 = Str1
Else
Lsn1 = Left$(Str1, i)
End If
End Function
