这是一段打开和关闭光驱门的程序,可以参照一下,也可以到 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
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
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货