Newsgroup: it.comp.lang.visual-basic
Titolo: Apertura cassetto CD

Qualcuno mi può indicare come fare ad aprire tramite
un programmino in Visual Basic il cassetto del masterizzatore?
Il CD con lettera "D" sono riuscito ad aprirlo con una funzione,
non mi viene quale funzione utilizzare per aprire il cassetto
del masterizzatore con lettera "E".
Saluti e grazie.

 ha scritto

il codice e' di vari anni fa, spero di non dimenticarmene dei pezzi. ora sul
desktop ho i cd scsi esterni spenti, quindi non posso provare, ma direi
andasse. in ogni modo ha di che partire.
-- 
hth, ciao, j.
http://www.sundaysw.com
'form
Option Explicit
Dim m_lDeviceID As Long
Public Function OpenCdDevice(Drive As String) As Boolean
' Open CD
On Error GoTo ErrHandler
    Dim lCode As Long
    Dim mciOpenParms As MCI_OPEN_PARMS
    Dim sBuffer As String * 128
    ' Setup the parameters used with mciSendCommand
    mciOpenParms.lpstrDeviceType = "cdaudio"
    mciOpenParms.lpstrElementName = Left(Drive, 2)
    ' Open the device
    lCode = mciSendCommand(0, MCI_OPEN, (MCI_OPEN_TYPE Or MCI_OPEN_ELEMENT
Or MCI_OPEN_SHAREABLE), mciOpenParms)
    If lCode <> MMSYSERR_NOERROR Then GoTo ErrHandler
    ' Ok, save the device id for future calls
    m_lDeviceID = mciOpenParms.wDeviceID
    ' Return true
    OpenCdDevice = True
    Exit Function
ErrHandler:
    ' This is to show how to read lCode for error messages
    mciGetErrorString lCode, sBuffer, 128
    Debug.Print sBuffer
    OpenCdDevice = False
End Function
Private Sub SetCdList()
' Set the CD Drive list
    Dim lRetVal As Long
    Dim AllDrives As String: AllDrives = Space(64)
    Dim JustOneDrive As String
    Dim DriveFound As Boolean
    Dim Counter As Integer
    ' Call the function to get the string containing all drives
    lRetVal = GetLogicalDriveStrings(Len(AllDrives), AllDrives)
    ' Trim off trailing chr(0)'s.  AllDrives now contains all the drive
letters.
    AllDrives = Left(AllDrives, lRetVal)
    cboCD.Clear
    Do
        lRetVal = InStr(AllDrives, Chr(0)) ' Find the first separating
chr(0)
        If lRetVal Then ' If there is one then
            JustOneDrive = Left(AllDrives, lRetVal) ' Extract the drive up
to the chr(0)
            AllDrives = Mid(AllDrives, lRetVal + 1, Len(AllDrives)) ' And
remove that from the Alldrives string, so it won't be checked again
            lRetVal = GetDriveType(JustOneDrive) ' Check what drive it is
            If lRetVal = DRIVE_CDROM Then ' If it is a CD-Rom drive then
                DriveFound = True
                cboCD.AddItem UCase(Left(JustOneDrive, 2)) ' Add the drive
letter to the list box
            End If
        End If
        DoEvents
    Loop Until AllDrives = ""
    If DriveFound Then
        'cboCD.Selected(0) = True
        'cboCD = cboCD.List(cboCD.ListIndex(0))
        cboCD = cboCD.List(0)
    Else
        'MsgBox "No CD Drives found!"
        cboCD.Enabled = False
        cmdCD.Enabled = False
        lblCD.Enabled = False
    End If
End Sub
Public Sub CloseCdDevice()
' Close the Audio device (not the door but the connection to the device)
    mciSendCommand m_lDeviceID, MCI_CLOSE, 0, 0
    m_lDeviceID = -1
End Sub
Private Sub cmdCD_Click()
    On Error GoTo errman
    Dim lCode As Long
    If cmdCD.Caption = "Close" Then
        lblCD.ForeColor = vbRed
        lblCD = "Closing CD Drive..."
        Me.Refresh
        ' Open selected device
        If OpenCdDevice(cboCD.Text) Then
            ' Close the drive, you can use lCode to debug if you get any
problems.
            ' See error handler in OpenCdDevice for lCode debugging.
            lCode = mciSendCommand(m_lDeviceID, MCI_SET,
MCI_SET_DOOR_CLOSED, 0)
            CloseCdDevice
            cmdCD.Caption = "Eject"
            lblCD.ForeColor = vbBlack
            lblCD = "CD door closed"
        End If
    ElseIf cmdCD.Caption = "Eject" Then
        lblCD.ForeColor = vbRed
        lblCD = "Ejecting CD Drive..."
        Me.Refresh
        ' Open selected device
        If OpenCdDevice(cboCD.Text) Then
            ' Eject the drive, you can use lCode to debug if you get any
problems.
            ' See error handler in OpenCdDevice for lCode debugging.
            lCode = mciSendCommand(m_lDeviceID, MCI_SET, MCI_SET_DOOR_OPEN,
0)
            CloseCdDevice
            cmdCD.Caption = "Close"
            lblCD.ForeColor = vbRed
            lblCD = "CD door opened"
        End If
    End If
    Exit Sub
errman: MsgBox Error: Exit Sub
End Sub
Private Sub Form_Load()
    SetCdList
'bas
Option Explicit
Public Const DRIVE_CDROM = 5
Public Const MCI_CLOSE = &H804
Public Const MCI_OPEN = &H803
Public Const MCI_OPEN_ELEMENT = &H200&
Public Const MCI_OPEN_SHAREABLE = &H100&
Public Const MCI_OPEN_TYPE = &H2000&
Public Const MCI_SET = &H80D
Public Const MCI_SET_DOOR_OPEN = &H100&
Public Const MCI_SET_DOOR_CLOSED = &H200&
Public Const MMSYSERR_NOERROR = 0
Public Type MCI_OPEN_PARMS
    dwCallback As Long
    wDeviceID As Long
    lpstrDeviceType As String
    lpstrElementName As String
    lpstrAlias As String
End Type
' Used to fill the CD Drive listbox
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
' Used to fill the CD Drive listbox
Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias
"GetLogicalDriveStringsA" _
    (ByVal nBufferLength As Long, _
     ByVal lpBuffer As String) As Long
' The actual API function used when accessing the CD drive
Public Declare Function mciSendCommand Lib "winmm.dll" Alias
"mciSendCommandA" _
    (ByVal wDeviceID As Long, _
    ByVal uMessage As Long, _
    ByVal dwParam1 As Long, _
    ByRef dwParam2 As Any) As Long
' The API funcion used to determine MCI errors
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias
"mciGetErrorStringA" _
    (ByVal dwError As Long, _
    ByVal lpstrBuffer As String, _
    ByVal uLength As Long) As Long
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

 ha scritto nel messaggio
news:c7bkc7$2578h$1...@ID-51318.news.uni-berlin.de...
[VARIE].
Visto che fai finta di niente
http://makeashorterlink.com/?P26B52938
rispondo ad uno dei tuoi messaggi.
Allora ci vieni al meeting o no?
Dai... ti prego!
-- 
Per diventare grandi non bisogna avere paura di essere piccoli
Per rispondere in privato elimina dall'indirizzo "togliquesto"
MasterDavidex - David Ruscelli

 Dai... ti prego!
:)
ho risposto ieri sera a lupo e gigio...
ciao, j.


In  che thread?
E a me non rispondi? Con me te la tiri? :-(


 E a me non rispondi? Con me te la tiri? :-(
Ho già trovato, anche se non ho capito bene perchè non vieni :-PPPP
Ma immagino saranno caxxi tuoi :-)


"Baldi"

*.vbs
Const ssfDRIVES = &H11
Set oSH = CreateObject("Shell.Application")
oSH.NameSpace(ssfDRIVES).ParseName("E:\").InvokeVerb "&Espelli"
--
Fosco

 E a me non rispondi? Con me te la tiri? :-(
no di certo. ma quando avete fatto quel threaddino ero via, e dopo speravo
di poter glissare...
ciao, j.

Grazie a te Fosco.
Saluti Baldi.
"Fosco" <fa...@fake.invalid> ha scritto nel messaggio
news:jsmmc.150130$hc5.6...@news3.tin.it...
