DelphiFAQ Home Search:

Eject CD Tray code for VB

 

comments14 comments. Current rating: 5 stars (7 votes). Leave comments and/ or rate it.

Question:

I need like to have an eject CD tray option in the Menu. Can you show me some Visual Basic code for that?

Answer:

The fairly universal function mciSendString will do this for you.

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 Long

Private Sub cmdOpenCD_Click()
Dim lRet As Long
    lRet = mciSendString("set CDAudio door open", returnstring, 127, 0)
End Sub

Private Sub cmdCloseCD_Click()
Dim lRet As Long
    lRet = mciSendString("set CDAudio door closed", returnstring, 127, 0)
End Sub

Comments:

2006-01-09, 10:56:26
leet91@gmail.com from United States  
rating
Brilliant! just what i needed and just when i needed it!
2006-03-01, 10:41:27
anonymous from India  
rating
can you provide modified code if there are multiple cd roms
2006-04-28, 00:09:24
anonymous from Australia  
i cant get it to work it says theres a sytax error
2006-11-21, 19:18:46
anonymous from United States  
rating
Syntax needed to be modified slightly but it works great, to bad it cant handle more than one CD drive.
2007-01-09, 02:47:55
same anonymous as above this topic from Netherlands  
rating
2007-08-04, 16:22:44   (updated: 2007-08-04, 16:48:04)
longhaircook@neo.rr.com  
This works in Delphi should work in VB also

Private Sub cmdOpenCD_Click()
Dim lRet As Long
' replace 'D' after 'cdaudio!' to the drive letter of the CD/DVD Drive you want
lRet = mciSendString('open cdaudio!D: alias driveX', 0&, 0, 0)
lRet = mciSendString('set driveX door open wait', 0&, 0, 0)
lRet = mciSendString('close driveX', 0&, 0, 0)
End Sub

Private Sub cmdCloseCD_Click()
Dim lRet As Long
' replace 'D' after 'cdaudio!' to the drive letter of the CD/DVD Drive you want
lRet = mciSendString('open cdaudio!D: alias driveX'), 0&, 0, 0)
lRet = mciSendString('set driveX door closed wait', 0&, 0, 0)
lRet = mciSendString('close driveX', 0&, 0, 0)
End Sub
2007-08-20, 08:33:56
pi-kid  
rating
tyvm for this! i need it in so many of my programs. one thing: does this work on removable disk drives? aka flash drives? if u could answer that would be gr8
2007-09-28, 01:44:23
anonymous from India  
nice code
2007-12-01, 13:06:30
anonymous  
Here's some Delphi code to stop USB Flash drive (like clicking on the USB icon in the task tray) but by passing a drive...
eg.
StopUSBDevice('G:');

but it can also be used to eject a CD-ROM drive...

const
FILE_DEVICE_MASS_STORAGE = $2D;
METHOD_BUFFERED = $00;
FILE_READ_ACCESS = $01;

IOCTL_STORAGE_EJECT_MEDIA = (FILE_DEVICE_MASS_STORAGE shl 16) or (FILE_READ_ACCESS shl 14) or ($202 shl 2) or (METHOD_BUFFERED);

procedure StopUSBDevice(const sDrive: String);
var
hHandle: THandle;
nUnused: DWORD;
begin
hHandle:=CreateFile(PChar('\\.\'+sDrive), GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if (hHandle=INVALID_HANDLE_VALUE) then
RaiseLastOSError;
try
if not DeviceIoControl(hHandle, IOCTL_STORAGE_EJECT_MEDIA, nil, 0, nil, 0, nUnused, nil) then
RaiseLastOSError;
finally
CloseHandle(hHandle);
end;
end;

HTH,
AzzaAzza69
2008-02-02, 19:55:00
[hidden] from Cyprus  
rating
Here's the code for Visual basic 2005!I thing it works with the older version. . .



Option Explicit On
Public Class Form1
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 OpenCDDoor()
mciSendString('Set CDAudio Door Open Wait', 0&, 0&, 0&)
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
mciSendString('Set CDAudio Door Open Wait', 0&, 0&, 0&)
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
mciSendString('Set CDAudio Door Closed Wait', 0&, 0&, 0&)
End Sub
End Class
2008-06-30, 21:00:32
anonymous from United States  
This will eject the D drive or you can replace the 'D':
d.DriveLetter = 'D'
with the drive you want to eject. If you want them all, just remove that section of the if statement to look like:

If d.DriveType = CDROM Then


Cheers
'=============

'Add On Code To Eject CD ROM Drive
Const CDROM = 4
For Each d in CreateObject('Scripting.FileSystemObject').Drives
If d.DriveType = CDROM AND d.DriveLetter = 'D' Then
Eject d.DriveLetter & ':\'
End If
Next

Sub Eject(CDROM)
Dim ssfDrives
ssfDrives = 17
CreateObject('Shell.Application')_
.Namespace(ssfDrives).ParseName(CDROM).InvokeVerb('E&ject')
End Sub
2008-09-08, 06:00:52   (updated: 2008-09-08, 06:01:53)
anonymous  
how to eject cd rom tray using macromedia flash 8 plz send me the tutorial to han999000@gmail.com
2008-11-24, 11:38:19
anonymous  
rating
Thank u Longhaircook
2012-11-12, 05:09:07
coach001 from United States  

 

 

NEW: Optional: Register   Login
Email address (not necessary):

Rate as
Hide my email when showing my comment.
Please notify me once a day about new comments on this topic.
Please provide a valid email address if you select this option, or post under a registered account.
 

Show city and country
Show country only
Hide my location
You can mark text as 'quoted' by putting [quote] .. [/quote] around it.
Please type in the code:

Please do not post inappropriate pictures. Inappropriate pictures include pictures of minors and nudity.
The owner of this web site reserves the right to delete such material.

photo Add a picture: