Eject/Close a cd?

[Neilbaker86]

Does anyone know how to Open And close a cd drive in VB??

Many Thanks!

[jjortiz]

Try this. I just grabbed it from some other code i had.

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLenght As Long, ByVal hwndCallback As Long) As Long
 
Public Sub doorOpen()
Dim lngResult As Long
lngResult = mciSendString("open cdaudio", "", 0, 0)
lngResult = mciSendString("set cdaudio door open", "", 0, 0)
lngResult = mciSendString("close cdaudio", "", 0, 0)
End Sub
Public Sub doorClose()
Dim lngResult As Long
lngResult = mciSendString("open cdaudio", "", 0, 0)
lngResult = mciSendString("set cdaudio door closed", "", 0, 0)
lngResult = mciSendString("close cdaudio", "", 0, 0)
End Sub

[Neilbaker86]

That dosnt do anything?

using this in my form

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLenght As Long, ByVal hwndCallback As Long) As Long

Public Sub doorOpen()
Dim lngResult As Long
lngResult = mciSendString("open cdaudio", "", 0, 0)
lngResult = mciSendString("set cdaudio door open", "", 0, 0)
lngResult = mciSendString("close cdaudio", "", 0, 0)
End Sub

Public Sub doorClose()
Dim lngResult As Long
lngResult = mciSendString("open cdaudio", "", 0, 0)
lngResult = mciSendString("set cdaudio door closed", "", 0, 0)
lngResult = mciSendString("close cdaudio", "", 0, 0)
End Sub

Private Sub Command1_Click()
doorOpen
End Sub

[jjortiz]

Put the code in a module and then access it in the following way.
module1.dooropen.

[Raptor_989]

you have to call it up using:

Call openDoor where you want it to happen, make sure that c0de is in general declerations too!

[Neilbaker86]

Hey cool!! i was just bout to try it in a module!, do you know anyway to make it open from other drives?? like your e:\ drive?

[jjortiz]

That's a very good question. I do not know. I will try to find out.

[beachbum]

Originally posted by Raptor_989
fool!you have to call it up using:

Call openDoor where you want it to happen, make sure that c0de is in general declerations too!

Aww,
Now that aint nice. And since u called the sub incorrectly, it looks a bit silly as well. You just need to have openDoor on a single line to call the routine or use Call (openDoor) with parentheses.
Regards
Stuart

[jjortiz]

Man i tell you, everyone is always fast to comment. Just too funny.

[Neilbaker86]

Thanks beachbum for sticking up for me! im a newbie!

[jjortiz]

You go beachbum.

[Kaverin]

This is a general door open/close thing. You just give it the drive letter. If you need those, use GetLogicalDriveStrings() to get the ones in the system, and then break it apart and give them to GetDriveType to determine if they're cd roms or not.

'in a module
Public Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal lpzCommand As String, ByVal lpzReturn As String, ByVal nReturnLength As Long, ByVal hWndCallback As Long) As Long
 
Public Sub DriveDoor(ByVal strDriveLetter As String, Optional ByVal blnOpenDoor As Boolean = True)
   'tells the MCI to ready the device and nickname it "dooralias"
   mciSendString "open " & strDriveLetter & ": type cdaudio alias dooralias", vbNullString, 0, 0
   'opens/closes the given drive door based on the boolean flag
   mciSendString "set dooralias door " & IIf(blnOpenDoor, "open", "closed"), vbNullString, 0, 0
   'tells MCI that we're done with the device
   mciSendString "close dooralias", vbNullString, 0, 0
End Sub
 
'to open the door of drive X
DriveDoor "x", True  'true is assumed, and may be left out
 
'to close the door of drive X
DriveDoor "x", False

[JamesM]

Kaverin, that code caused my system to lock up, I use NT4, any ideas why?

[scsa20]

here, try this...Nucleus give me this.

[Kaverin]

If the one I posted does cause a lock up, Nucleus's one might do it as well. They're both the same basic idea going through the MCI to do it. I have no clue what could be causing that though. I've got win98 myself. There may be something different that has to be done in NT, but I've never run across it. Thanks for mentioning it though, or I would have never known of anything like that happening.

[Neilbaker86]

i used Kaverin's code and changed it about a bit, i was just wondering if anyone can make the drives list only display Cd-Rom drvies? i think you might have to use a list box??
i attached my project so far

[Kaverin]

This will do it. You could change it just to accept either a listbox or combobox, but I made it do either.

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal cchBuffer As Long, ByVal lpzBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal lpzDrive As String) As Long
 
Public Const DRIVE_CDROM As Long = 5
 
Public Sub AddCDDrives(ByRef ctlListOrCombo As Control)
   Dim strBuffer As String
   Dim lngLength As Long
   Dim astrDrives As Variant
   Dim i As Long
   If (TypeOf ctlListOrCombo Is ComboBox) Or (TypeOf ctlListOrCombo Is ListBox) Then
      'make a buffer
      strBuffer = Space$(128)
      'get the drive letters
      lngLength = GetLogicalDriveStrings(Len(strBuffer), strBuffer)
      'trim off the last null char
      strBuffer = Left$(strBuffer, lngLength - 1)
      'break the return into separate drives
      astrDrives = Split(strBuffer, vbNullChar)
      ctlListOrCombo.Clear
      'go through each drive to see if it's a cdrom, and add it if so
      For i = 0 To UBound(astrDrives)
         If GetDriveType(astrDrives(i)) = DRIVE_CDROM Then ctlListOrCombo.AddItem astrDrives(i)
      Next i
   End If
End Sub
 
'usage
AddCDDrives drivelistbox
'or
AddCDDrives drivecombobox