Открытие CD

[MICHEY]

Необходимо определить количество оптических приводов в системе (желательно чтоб можно было исключать всякие виртуальные) и открывать каждый из них. Помогите.

[xolod]

MICHEY
GetDriveType в цикле, если возвращает 5 (DRIVE_CDROM), то перед тобой соотв. сидюк. Но отличить виртуальный от настоящего вряд ли можно. Они же ничем не отличаются даже для самой системы.

[MICHEY]

Спасибо за информацию, но нельзя это немного поподробнее? И как потом открывать каждый сидюк?

[Jenizix]

Вот пример открытия/закрытия CD-ROM'а

Код: Выделить всё

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

'Теперь для открытия CD-ROM вызовите эту функцию с такими параметрами:
Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)

'а для ee закрытия:
Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)


[xolod]

Куда уж подробнее? Цикл делать умеешь? А сравнивать?
Помести на форму Listbox под именем List1

Код: Выделить всё


Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Const DRIVE_FIXED = 3
Private Const DRIVE_CDROM = 5

Private Sub Form_Load()
  Dim lngIndex As Integer, astrBuffer As String
 
  For lngIndex = 97 To 122
    astrBuffer = Chr(lngIndex) & ":"
    Select Case GetDriveType(astrBuffer)
      Case DRIVE_FIXED
        List1.AddItem "Найден жесткий диск: " & astrBuffer
      Case DRIVE_CDROM
        List1.AddItem "Найден CD-дисковод: " & astrBuffer
    End Select
  Next lngIndex
End Sub


Ну и конечно пример Jenizix'а будет открывать только первый сидюк в списке, а не тот который тебе надо

Пример из API-Guide для открывания CD-Rom'ов

Код: Выделить всё


'Example by Howard Henry Schlunder
' This example requires one command button (Command1)
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 = 2967560
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 Command1_Click()
Dim hDrive As Long, DummyReturnedBytes As Long
Dim EjectDrive As String, DriveLetterAndColon As String
Dim RawStuff As DIOC_REGISTERS
  EjectDrive = InputBox("Which drive shall we try to eject the media from?", "Eject Media")
  If Len(EjectDrive) Then 'Confirm the user didn't cancel
    DriveLetterAndColon = UCase(Left$(EjectDrive & ":", 2)) 'Make it all caps for easy interpretation
    If GetVersion >= 0 Then 'We are running Windows NT/2000
      hDrive = CreateFile("\\.\" & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
      If hDrive <> INVALID_HANDLE_VALUE Then
        'Eject media!
        Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0)
        Call CloseHandle(hDrive)  'Clean up after ourselves
      End If
    Else  'We are running Win9x/Me
      hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
      If hDrive <> INVALID_HANDLE_VALUE Then
        'Setup our raw registers to use Interrupt 21h Function 440Dh Minor Code 49h
        RawStuff.reg_EAX = &H440D   'The function to use
        RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1 'The drive to do it on
        RawStuff.reg_ECX = &H49 Or &H800     'The minor code of the function in the low byte of the low word and the device category of 8 in the high byte of the low word
        'Eject media!
        Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
        Call CloseHandle(hDrive)  'Clean up after ourselves
      End If
    End If
  End If
End Sub


[MICHEY]

Большое спасибо. Теперь думаю напишу открывалку сидюков (а то у меня их три и системник под столом стоит - раньше использовал функцию АПИ mciSendString Lib, но она как известно открывает только master CD-ROm..)
Циклы писать и сравнивать, это я вроде как умею, я просто функцию GetDriveType не знал, поэтому попросил поподробее. Еще раз благодарю за помощь.

[MICHEY]

xolod, открывать понятно, а как закрыть привод?

[Sur]

MICHEY
> mciSendString Lib, но она как известно открывает только master CD-ROm

Открывает и закрывает любой по букве
Вот узнать открыт/закрыт лоток - проблема...

[MICHEY]

Эту функцию я знаю. Вот, блин, охото как в какой-то программе, чтоб открывать и закрывать любой сидюк (а не только master). На первую задачу ест ответ (благодарю xolod-у). А вот с закрытием проблема...

[xolod]

MICHEY
Дык это.., есть IOCTL_STORAGE_EJECT_MEDIA, есть и IOCTL_STORAGE_LOAD_MEDIA

[Sur]

на форму 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


[MICHEY]

Сейчас попробую.. Завтра напишу о результатах.

[MICHEY]

ОК. Всё работает! Благодарю всех за помощь!

[Pantalone]

Подниму тему чтобы новые не плодить.
Если диск отформатирован для пакетной записи, например InCD4, то такой диск не эджектится!
Буду признателен за помощь в этой проблеме.