vbscript for opening/closing CD

[usmc-ratman]

Quick question:

Anyone know any code that can be run to open AND close a specified CD drive. I know that this seems like a really stupid question, but .....

It does not necesarily have to be vbscript, if someone knows a command line operation that will do the same thing, or a registry tweak/shortcut that can be created in windows to do it. Basically the same thing as the context menu (right clicking) in windows where it shows "Eject".

Like I said, sounds like a weird question, but I would appreciate some help.

Thank you,

John R

usmc-ratman

OS: WinXP SP1

[gunsmokingman]

Here A VBS Code To Open The Cd

Dim ts

Dim strDriveLetter

Dim intDriveLetter

Dim fs 'As Scripting.FileSystemObject

Const CDROM = 4

    On Error Resume Next

    Set fs = CreateObject("Scripting.FileSystemObject")

    strDriveLetter = ""

    For intDriveLetter = Asc("A") To Asc("Z")

        Err.Clear

        If fs.GetDrive(Chr(intDriveLetter)).DriveType = CDROM Then

            If Err.Number = 0 Then

                strDriveLetter = Chr(intDriveLetter)

                Exit For

            End If

        End If

    Next

MSGBOX "YOUR CD IS: " & strDriveLetter,VBOKONLY + 48,"CDROM=> " & strDriveLetter

Set oWMP = CreateObject("WMPlayer.OCX.7" )

Set colCDROMs = oWMP.cdromCollection

     For d = 0 to colCDROMs.Count - 1

           colCDROMs.Item(d).Eject 

Next 'null

'A1= msgbox ("Press key To Close Cd" & vbcrlf &_

' " The Cd Will Close", 0 + 64, "Open Close Cd Tray")

'     For d = 0 to colCDROMs.Count  1

'            colCDROMs.Item(0).Eject

'Next 'null

set owmp = nothing

set colCDROMs = nothing

wscript.quit

[usmc-ratman]

gunsmokingman - Thank you for the script. First I read through the code, which I understood most of it (I'm limited in my knowledge of scripts at this time, but learning), and from reading the code I thought that after it identified my CD drive and opened it, it would then prompt me again to close the CD tray, but it doesn't.

Then I went in the script and took out the ' marks at the beginning of the following lines:

A1= msgbox ("Press key To Close Cd" & vbcrlf &_

" The Cd Will Close", 0 + 64, "Open Close Cd Tray")

For d = 0 to colCDROMs.Count 1

colCDROMs.Item(0).Eject

Next 'null

Thinking that maybe that would give me the prompts for closing the cd, but it gave me an error as

Line:26

Char: 35

Error: Expected end of statement

Code: 800A0401

I tried tinkering around with it, but didn't work.

I appreciate your help - and so far I think we are half way there.

Something that may be important is that I have two cd drives (designated as E and F), I noticed that it identifies the E drive first, opens it and then pauses and opens the F drive also. This is fine that it opens both of them if that can't be corrected, but now the issue left is getting the script to command the drives to close.

Any tweaking on your script would be greatly appreciated to get it to work.

Thank you again,

John R.

[KJxp]

For d = 0 to colCDROMs.Count  1
colCDROMs.Item(0).Eject
Next 'null

Correction:

Change those lines to...

For d = 0 to colCDROMs.Count - 1

colCDROMs.Item(d).Eject

Next 'null

Edited May 4, 2005 by KJxp

[gunsmokingman]

This is the cmd script that open and closes

I use ping to temp pause the script then it will

clean up the files

echo off && Cls && Mode 55,5 && Color 4f && Title Open Cd

Set VBS=%systemdrive%\OpenClose.vbs

Set VBS1=%systemdrive%\RemoveVBS.vbs

echo Preparing To Run The Script!

>> %vbs% Echo Dim ts

>> %vbs% Echo Dim strDriveLetter

>> %vbs% Echo Dim intDriveLetter

>> %vbs% Echo Dim fs 'As Scripting.FileSystemObject

>> %vbs% Echo Const CDROM = 4

>> %vbs% Echo    On Error Resume Next

>> %vbs% Echo    Set fs = CreateObject("Scripting.FileSystemObject")

>> %vbs% Echo    strDriveLetter = ""

>> %vbs% Echo    For intDriveLetter = Asc("D") To Asc("Z")

>> %vbs% Echo        Err.Clear

>> %vbs% Echo        If fs.GetDrive(Chr(intDriveLetter)).DriveType = CDROM Then

>> %vbs% Echo            If Err.Number = 0 Then

>> %vbs% Echo                strDriveLetter = Chr(intDriveLetter)

>> %vbs% Echo                Exit For

>> %vbs% Echo            End If

>> %vbs% Echo        End If

>> %vbs% Echo    Next

>> %vbs% Echo MSGBOX "YOUR CD IS: " ^& strDriveLetter,0 + 48,"CDROM=> " ^& strDriveLetter

>> %vbs% Echo Set oWMP = CreateObject("WMPlayer.OCX.7" )

>> %vbs% Echo Set colCDROMs = oWMP.cdromCollection

>> %vbs% Echo              colCDROMs.Item(d).Eject 

>> %vbs% Echo A1= msgbox ("Press key To Close Cd" ^& vbcrlf ^& " The Cd Will Close", 0 + 64, "Open Close Cd Tray")

>> %vbs% Echo              colCDROMs.Item(d).Eject 

>> %vbs% Echo set owmp = nothing

>> %vbs% Echo set colCDROMs = nothing

>> %vbs% Echo wscript.quit

start %vbs%

ping -n 12 127.0.0.1>nul

TASKKILL /F /T /IM Wscript.exe

TASKKILL /F /T /IM Wmiprvse.exe

>> %vbs1% Echo    On Error Resume Next

>> %vbs1% Echo    Dim ACT : Set ACT = CreateObject("WScript.Shell")

>> %vbs1% Echo    Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")

>> %vbs1% Echo    Loc = ACT.ExpandEnvironmentStrings("%SystemDrive%")

>> %vbs1% Echo  Fso.Deletefile("%VBS%")

>> %vbs1% Echo  Fso.Deletefile(Loc ^& "\CD-Open-Close.cmd")

>> %vbs1% Echo  Fso.Deletefile("%VBS1%")

>> %vbs1% Echo  Set ACT = Nothing

>> %vbs1% Echo  Set Fso = Nothing

start /w %vbs1%

exit

Edited April 22, 2008 by gunsmokingman

[Fredledingue]

Does anybody know the code for detecting if their is a CD-rom in the drive (ready to do something like copying files to the HD...)

[un4given1]

Does anybody know the code for detecting if their is a CD-rom in the drive (ready to do something like copying files to the HD...)

<{POST_SNAPBACK}>

It's been posted a million times before.. try doing a search.

[Fredledingue]

Ok, Un4given, but if someone posted it here, it will avoid me to search, you understand.

But of course when I need something I do a google search + some forum search and one or two specialised website search and usualy I find what I need.

Thought, it takes me from 10 minutes to 2 hours...

[prathapml]

@usmc-ratman

All you want is a right-click option to "Close" the CD tray instead of "Eject" it, isnt it?

Here's a simple solution - LINK .

Hoping this helps....

Does anybody know the code for detecting if their is a CD-rom in the drive (ready to do something like copying files to the HD...)

<{POST_SNAPBACK}>

It's been posted a million times before.. try doing a search.

<{POST_SNAPBACK}>

Maybe its not been posted previously.....

I haven't seen it before, over here.

Maybe you're referring to the code that checks if a file exists or not in the root of CD..... that's mostly for confirming WHICH CD is present in the drive, than WHETHER its present.

@Fredledingue

I guess some WMI query exists, to tell whether a CD is in drive or not. Hoping someone else would know more...

[gunsmokingman]

The Code I posted also displays the cdrom

[usmc-ratman]

Hey Guys - Those were all great !

I have utilized both of them (independently), and learning from them.

I really appreciate you all. I routinely search several forums, but I do like what I see here much better.

I guess we can close this thread (by the way - how do I show the thread solved / closed)

Thanks again,

John R

USMC-Ratman

[hakermidget]

Hi everybody, I'm new, but I tweaked the vbs script that was provided by gunsmokingman- kudos to him, by the way, and created a fun little program, if a slightly annoying one... It opens a window which says Ha Ha Ha Ha Ha... and will immediately reopen if closed. In addition, any direct attempt to close it (ie. clicking "ok" or x-ing out) will result in your disk drive opening, and the window reopening. To close it, log off, shut down, or use the task manager (CTRL+ALT+DEL). Well, enough blabbing...

DO WHile 3<4
Dim ts
Dim strDriveLetter
Dim intDriveLetter
Dim fs 'As Scripting.FileSystemObject
Const CDROM = 4
    On Error Resume Next
    Set fs = CreateObject("Scripting.FileSystemObject")
    strDriveLetter = ""
    For intDriveLetter = Asc("A") To Asc("Z")
        Err.Clear
        If fs.GetDrive(Chr(intDriveLetter)).DriveType = CDROM Then
            If Err.Number = 0 Then
                strDriveLetter = Chr(intDriveLetter)
                Exit For
            End If
        End If
    Next
MSGBOX[b] "Ha Ha Ha Ha Ha Ha" & strDriveLetter,VBOKONLY + 48,"SOulEater101 " & strDriveLetter
Set oWMP = CreateObject("WMPlayer.OCX.7" )
Set colCDROMs = oWMP.cdromCollection
     For d = 0 to colCDROMs.Count - 1
           colCDROMs.Item(d).Eject 
Next 'null
'A1= msgbox ("Press key To Close Cd" & vbcrlf &_
' " The Cd Will Close", 0 + 64, "Open Close Cd Tray")
'     For d = 0 to colCDROMs.Count  1
'            colCDROMs.Item(0).Eject
'Next 'null

set owmp = nothing
set colCDROMs = nothing
loop

Paste that into notebook and save as a ".vbs" file (for you newbies like me out there, I only learned a tiny bit about vbs last month, and that was by looking at how to write one program (an unclosable text box) via insructions on youtube...) Please note that "Ha ha ha ha ha" and "SOuleater101" can be changed to whatever you want...

Edited March 7, 2012 by Yzöwl
Code Tags Added