Attribute VB_Name = "mCDROMDoorControl"
Option Explicit'//usage(用法):
'//Control_CDROM_Door("H:",True)    '//eject the "H:" door(弹开H:的门)
'//Control_CDROM_Door("H:",False)   '//close the "H:" door(关闭H:的门)
'//
'//Ref:MSDN_DDK
'//Auh:www.r4c.tt.uk 1999 yangvb'/* parameter block for MCI_OPEN command message */
Private Type MCI_OPEN_PARMS
    dwCallback          As Long
    wDeviceID           As Long
    lpstrDeviceType     As Long
    lpstrElementName    As String
    lpstrAlias          As String
End Type'/* parameter block for MCI_STATUS command message */
Private Type MCI_STATUS_PARMS
    dwCallback      As Long
    dwReturn        As Long
    dwItem          As Long
    dwTrack         As Long
End Type'/* flags for dwFlags parameter of MCI_OPEN command message */
Private Const MCI_OPEN_SHAREABLE = &H100
Private Const MCI_OPEN_ELEMENT = &H200
Private Const MCI_OPEN_ALIAS = &H400
Private Const MCI_OPEN_ELEMENT_ID = &H800
Private Const MCI_OPEN_TYPE_ID = &H1000
Private Const MCI_OPEN_TYPE = &H2000Private Const MCI_DEVTYPE_CD_AUDIO = 516Private Const MCI_OPEN = &H803
Private Const MCI_CLOSE = &H804Private Const MCI_SET = &H80D
Private Const MCI_WAIT = &H2'/* flags for dwFlags parameter of MCI_SET command message */
Private Const MCI_SET_DOOR_OPEN = &H100
Private Const MCI_SET_DOOR_CLOSED = &H200Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, dwParam2 As Any) 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 LongPublic Sub Control_CDROM_Door(ByVal sDriver As String, Optional ByVal bEjectOrClose As Boolean = True)
    
    Dim mop     As MCI_OPEN_PARMS
    '//Dim msp     As MCI_STATUS_PARMS
    Dim lRet    As Long
    Dim lFlags   As Long
    
    
    sDriver = Left$(sDriver, 1) & ":\"
    lFlags = MCI_OPEN_TYPE Or _
            MCI_OPEN_TYPE_ID Or _
            MCI_OPEN_ELEMENT Or _
            MCI_OPEN_SHAREABLE
            
    mop.lpstrDeviceType = MCI_DEVTYPE_CD_AUDIO
    mop.lpstrElementName = sDriver
    
    If Not (mciSendCommand(0, MCI_OPEN, lFlags, mop)) Then
        
        If bEjectOrClose Then
            lRet = mciSendCommand(mop.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, ByVal 0&)
        Else
            lRet = mciSendCommand(mop.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, ByVal 0&)
        End If
        
        lRet = mciSendCommand(mop.wDeviceID, MCI_CLOSE, MCI_WAIT, ByVal 0&)
    
    End If
    
End Sub