这是一段打开和关闭光驱门的程序,可以参照一下,也可以到 www.21code.com 找一找。
Option ExplicitPrivate Const MCI_OPEN = &H803
Private Const MCI_OPEN_TYPE = &H2000&
Private Const MCI_OPEN_SHAREABLE = &H100&
Private Const MCI_SET = &H80D
Private Const MCI_SET_DOOR_OPEN = &H100&
Private Const MCI_CLOSE = &H804'自定义类型   MCI_OPEN_PARMS
Private Type MCI_OPEN_PARMS
        dwCallback  As Long
        wDeviceID  As Long
        lpstrDeviceType  As String
        lpstrElementName  As String
        lpstrAlias  As String
End Type
Private 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
Private Declare Function mciGetErrorString Lib "winmm.dll" _
                                  Alias "mciGetErrorStringA" (ByVal dwError As Long, _
                                                              ByVal lpstrBuffer As String, _
                                                              ByVal uLength As Long) As Long'Private Declare Function GetmciErrorString Lib "winmm.dll" _
'                                  Alias "GetmciErrorStringA" (ByVal llRet As Long) As Long
Dim openParams   As MCI_OPEN_PARMSPrivate Sub Command1_Click()
        Dim lRet   As Long
        openParams.wDeviceID = 0
        openParams.lpstrDeviceType = "cdaudio"
        'get  the  device  ID
        lRet = mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE Or MCI_OPEN_SHAREABLE, openParams)
        'check  for  error
        If lRet <> 0 Then
                'show  error
                MsgBox GetmciErrorString(lRet), vbCritical
        Else
                'open  the  door  of  the  CD-ROM  drive
                lRet = mciSendCommand(openParams.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, ByVal 0&)
                'check  for  errors
                If lRet <> 0 Then MsgBox GetmciErrorString(lRet), vbCritical
        End If
        'clean  up
        mciSendCommand openParams.wDeviceID, MCI_CLOSE, 0, ByVal 0&
End Sub