如何知道 CD-ROM 的托盘状态（打开/关闭）？

Question

http://msdn.microsoft.com/code/default.asp?url=/msdn-files/026/001/835/Source%20Files/CDPlayer_java.asp

Answer 1

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/jscolDrives.asp

Answer 2

No，这样仍然达不到目的：我需要知道的不是 CD-ROM 驱动器中是否有盘，而是它的托盘是否处在弹出的状态。

Answer 3

retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)
执行这句话后cd-rom肯定是关着的想些什么播放软件马？
有知道cd-rom状态的必要吗?

Answer 4

retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)
执行这句话后cd-rom肯定是关着的想些什么播放软件马？
有知道cd-rom状态的必要吗?

Answer 5

参考这里，也许会有帮助
利用MCI的方法可以方便的实现光驱门的开关。
请看下例：
>>步骤1----建立新工程,在窗体上放置一个CommandButton按钮.设置其Caption = "打开"
>>步骤2----编写如下代码: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 LongPrivate Sub Command1_Click()
    Static bOpen As Boolean
    Dim strStr As String    If Not bOpen Then
        Screen.MousePointer = vbHourglass
        strStr = "set CDAudio door open"
    Command1.Caption = "关闭"
    Else
        Screen.MousePointer = vbHourglass
        strStr = "set CDAudio door closed"
     Command1.Caption = "打开"
    End If    Call mciSendString(strStr, vbNull, 127, 0)
    Screen.MousePointer = vbDefault
    DoEvents
    bOpen = Not bOpen
End Sub>>步骤3----编译运行,点击"打开",光驱弹出;点击"关闭",光驱关上.

Answer 6

一般不必判断是否关门，只需判断光驱是否准备好Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
     
     
Private Function TestCDROMDrive() As String
  Dim lType As Long, i As Integer, tmpDrive As String, found As Boolean
  On Error GoTo errL
  For i = 0 To 25
    tmpDrive = Chr(65 + i) & ":"
    lType = GetDriveType(tmpDrive) '注释：Win32 API 函数
    If (lType = 5) Then '注释：Win32 API 常数
      found = True
      Exit For
    End If
  Next
  If Not found Then TestCDROMDrive = "无光驱": Exit Function
  On Error Resume Next
  tmpValue = Dir(tmpDrive)
  If Err.Number <> 0 Or tmpValue = "" Then
    TestCDROMDrive = "光驱未准备好": Exit Function
  Else
    TestCDROMDrive = "光驱准备好": Exit Function
  End If
  Exit Function
errL:        MsgBox Error$
End Function
     
     Private Sub Command1_Click()
    MsgBox TestCDROMDrive()
End Sub

Answer 7

http://www.dapha.net/VB/list.asp?id=652
http://www.dapha.net/VB/list.asp?id=495

Answer 8

RE： DevilXellossNo，这样仍然达不到目的：我需要知道的不是 CD-ROM 驱动器中是否有盘，而是它的托盘是否处在弹出的状态。
   你为什么非要知道托盘是否处在弹出的状态呢？没盘就弹出来，还是没盘再弹
出来，这样就是弹出状态吧！

Answer 9

7~~~~~~要是这么容易，我会撒 200 分出来吗？不会就请不要用 mciSendString 和 GetDriveType 之类的函数来骗分。要是检查有没有盘，我告诉你们一个更好的办法：　　Public Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal lpszPath As String) As Long　　Debug.Print PathIsDirectory("G:\")　　这里“G:\”是光驱的根目录，返回 0 说明根目录不存在，就是没有有效的盘，否则就是光驱准备好了。只要一行代码即可，用得着 Dir、On Error GoTo 吗？呵呵，该你给我分了。
　　我就是要实现通过一个按钮来开/关光驱托盘。比如 Windows 2000 的 CD 唱机，只有一个“Eject”按钮，按下后，它可以判断托盘的状态，打开着就关上，关着就打开。我就是要知道这是怎么做到的。
　　现在我用了一个不准确的方法：先用 mciSendString 关闭光驱，加 wait 关键词。如果光驱本身已经关闭，函数将立即返回；如果光驱本来是打开的，那么从关闭到判断是否有盘，必然要一定时间函数才能返回。我就通过判断第一条指令的消耗时间，来决定是否执行下一条指令：如果时间很短，就说明光驱本来是关闭的，就用 mciSendString 打开光驱；如果时间超过 1 秒，就不执行第二条打开光驱的指令。
　　我觉得这种方法虽然可行，却不完美，所以才悬赏 200 分，希望明确获得光驱托盘状态。能够解决的话还可以加分。Come On！

Answer 10

我以下的代码是监视光驱动作的，不知能否帮你！在窗体中的代码：
Option ExplicitPrivate Sub Form_Load()
    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End SubPrivate Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub建立一模块，代码如下：Option Explicit
Public Const WM_DEVICECHANGE& = 537&
Public Const DBT_DEVICEREMOVECOMPLETE& = 32772
Public Const DBT_DEVICEARRIVAL& = 32768Public Const GWL_WNDPROC = (-4)Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic prevWndProc As LongFunction WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_DEVICECHANGE Then MsgBox "OK"　'这个是光驱状态发生变化是产生的
If wParam = DBT_DEVICEREMOVECOMPLETE Then MsgBox "1"　'这个是光驱弹开时产生的
If wParam = DBT_DEVICEARRIVAL Then MsgBox "2"　　'这个是光驱关上时产生的
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function在窗体中的代码：
Option ExplicitPrivate Sub Form_Load()
    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
End SubPrivate Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End Sub建立一模块，代码如下：Option Explicit
Public Const WM_DEVICECHANGE& = 537&
Public Const DBT_DEVICEREMOVECOMPLETE& = 32772
Public Const DBT_DEVICEARRIVAL& = 32768Public Const GWL_WNDPROC = (-4)Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic prevWndProc As LongFunction WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_DEVICECHANGE Then MsgBox "OK"　'这个是光驱状态发生变化是产生的
If wParam = DBT_DEVICEREMOVECOMPLETE Then MsgBox "1"　'这个是光驱弹开时产生的
If wParam = DBT_DEVICEARRIVAL Then MsgBox "2"　　'这个是光驱关上时产生的
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function

Answer 11

请斑竹把这个帖子删除吧，讨论已经放在高手区了。请保留高手区的帖子：http://www.csdn.net/expert/topic/526/526093.xml