How do I detect if the CDROM drive is open?

How do I detect if the CDROM drive is open?

i believe that you have use api's to do this.

that's an ingenious answer Bill, really.

Code:

---

Public 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 Long

Sub CD_OpenDoorCD()
'Opens CD-Rom door
Call MciSendString("set cd door open", 0, 0, 0)
End Sub

---

Now it's opened :).

Here's how to detect if there is a CD in the CD-ROM:

Code:

---

Const DRIVE_CDROM = 5

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Command1_Click()
Dim tmp As Integer
Dim tmpStr As String
Dim Drives As String
Dim CDsCount As Integer
Dim CDsLetters As String

'init Drives to 255 spaces
Drives = Space(255)
'get drives, Drives var will look like
'  A:\<NULL>C:\<NULL>D:\<NULL>E:\<NULL><NULL>
'ret& is the new length of Drives
ret& = GetLogicalDriveStrings(Len(Drives), Drives)
For tmp = 1 To ret& Step 4
 'get a drive root directory (like "C:\")
 tmpStr = Mid(Drives, tmp, 3)
 'if drive is a CD
 If GetDriveType(tmpStr) = DRIVE_CDROM Then
  CDsCount = CDsCount + 1
  CDsLetters = CDsLetters & Left(tmpStr, 1) & " "
 End If
Next tmp
'display results
If CDsCount Then
 MsgBox "Number of CDs Available: " & CDsCount & " - CDs Letters: " & UCase(CDsLetters)
Else
 MsgBox "No CDs Available"
End If
End Sub

---

You should be more specific of what you know. Some people only want to be shown what area they need to look at, some want more then that. If you want code, ask for it. Another thing, learn to use the search tool, if you do you will find that this has been answered about 5 times before.

lol, this makes me laugh!

why do you want to see if it is open anyway?