Немного не в тему. Работает в 9х... Попробуй, может поможет...
Public 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
Public Function CDClose() As Long
CDC = mciSendString("set CDAudio door closed", returnstring, 127, 0)
End Function
Public Function CDOpen() As Long
CDO = mciSendString("set CDAudio door open", returnstring, 127, 0)
End Function
Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long
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
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
Private Const INVALID_HANDLE_VALUE = -1
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA = &H2D4808
Private Const IOCTL_STORAGE_LOAD_MEDIA = &H2D480C
Private Const VWIN32_DIOC_DOS_IOCTL = 1
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 Sub CD_Eject(ByVal Drive As String, Action As Long)
Dim hDrive As Long, DummyReturnedBytes As Long
Dim EjectDrive As String
Dim RawStuff As DIOC_REGISTERS
Drive = UCase(Left$(Drive & ":", 2))
If GetVersion >= 0 Then ' Запущена Windows NT/2000
hDrive = CreateFile("\\.\" & Drive, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
 eviceIoControl hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0
CloseHandle hDrive
End If
Else 'Запущена Windows 9x/Me
hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
'Использование прерывания 21h функция 440Dh код 49h
RawStuff.reg_EAX = &H440D
RawStuff.reg_EBX = Asc(Drive) - Asc("A" + 1 ' номер диска
RawStuff.reg_ECX = &H49 Or &H800
 eviceIoControl hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0
CloseHandle hDrive
End If
End If
End Sub
Private Sub Command1_Click()
CD_Eject "f", IOCTL_STORAGE_EJECT_MEDIA ' open drive F:
CD_Eject "g", IOCTL_STORAGE_EJECT_MEDIA ' Open drive G:
End Sub
Private Sub Command2_Click()
CD_Eject "f", IOCTL_STORAGE_LOAD_MEDIA ' close drive F:
CD_Eject "g", IOCTL_STORAGE_LOAD_MEDIA ' close drive G:
End Sub
И все таки с mciSendString закончим:
на форму list1 и кнопки ComAction (0), ComAction (1)
Option Explicit
Private Declare Function GetDriveType Lib _
"kernel32" Alias "GetDriveTypeA" (ByVal _
nDrive As String) As Long
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
Private Const DRIVE_CDROM = 5
Private Sub ComAction_Click(Index As Integer)
Dim str As String * 255
Dim sRet As String * 128
Dim eRet As String * 128
Dim ret As Long
Dim sAlias As String
sAlias = "cd" & List1.List(List1.ListIndex)
str = "open " & List1.List(List1.ListIndex) & ": alias " & sAlias & " type CDAudio"
ret = mciSendString(str, sRet, 255, 0)
If Not ret = 0 Then
mciGetErrorString ret, eRet, 128
Debug.Print "err device: " & eRet
mciSendString "close " & sAlias, vbNullString, 0&, 0
Exit Sub
Else
Debug.Print "device: " & sRet
End If
If Index = 1 Then
'close
str = "set " & sAlias & " door closed"
ret = mciSendString(str, sRet, 255, 0)
If Not ret = 0 Then
mciGetErrorString ret, eRet, 128
Debug.Print "err close: " & eRet
mciSendString "close " & sAlias, vbNullString, 0&, 0
Exit Sub
Else
Debug.Print "close: " & sRet
End If
ElseIf Index = 0 Then
'open
str = "set " & sAlias & " door open"
ret = mciSendString(str, sRet, 255, 0)
If Not ret = 0 Then
mciGetErrorString ret, eRet, 128
Debug.Print "err open: " & eRet
mciSendString "close " & sAlias, vbNullString, 0&, 0
Exit Sub
Else
Debug.Print "open: " & sRet
End If
End If
mciSendString "close all", vbNullString, 0&, 0
End Sub
Sub Form_Load()
Dim s As Long
For s = Asc("A" To Asc("Z"
If GetDriveType(Chr$(s) & ":" = DRIVE_CDROM Then
List1.AddItem Chr$(s)
End If
Next s
End Sub