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
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
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货