这个问题好像以前有人提过,你试着搜索一下原来的贴子。

解决方案 »

  1.   

    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:r4c studio 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