The Haunted CD Rom Drive

Greetings Programs!

This Instructable will show you how to write a VB (Visual Basic) Script that will open and close a persons CD/DVD Drive at random intervals.



Disclaimer:

1) This script runs best on Windows XP (Perfect for the office!), but Vista and 7 have the security checking software that will ask for permission for a script to run.
2) The script also works best on desktop computers, as the close command will not work on a drive without a motor in it.
3) There is no malicious code in the script, but I hold no responsibility for what could happen if it gets changed from the original code sample.

Choosing the people you wish to prank:

1) If you work for an IT Department this will be easy, as you can really just set anyone up to be pranked at your will, and wait for the calls to come in.
2) If you don't work in an IT Department, choose someone who would be unaware of tampering to their computer.
3) Try not to pick anyone with too much seniority as I cannot guarantee that they wont be angry about you messing with their computer.

Running the script on your 'Victim's computer is the hardest part of this entire prank.  I have named the script 'cdupdt' as it is easy to notice when I'm looking for it.  You could name it whatever you want, the sneakier the name the better.

If you can get access to their computer for even a few seconds, you can run the script once and then it will never happen again (Unless you change up the timing in the code).  The script will not run any windows, or anything in the task bar, the only item you can see is an entry in the Process Manager as 'wscript.exe'.

The ideal situation would be if you had a bit more time than someone getting up to go to the photocopier:

1) On most computers there is an icon for 'My Computer' on the desktop, Right Click and go to Explore.
2) If you navigate to C:\Documents and Settings\All Users\Start Menu\Programs\Startup then put the script in that folder, every time the computer is loaded into windows the script will run.

This step is probably the best part about this prank.

The script is currently set to go off at a random time between 20 minutes and 99 minutes. This allows for a good getaway, and able to set up camp to watch the reaction.

I will say that 99 minutes may seem like a long time, but the reasoning behind it is that you want the 'victim' to be taken by surprise as much as possible.  If the drive just opened and closed 3 times they would know something was up.

Now the moment everyone has been waiting for:

Make sure you save the script as whatever.vbs or else it wont work properly.

Option Explicit
Dim theRandom
Dim count
' Randomize a number then turn it into minutes
while (count < 3)
    theRandom = RandomValue()
    Pause (theRandom * 60)
    OpenCDRom
    count = count + 1
wend

' If you wish to change the timing of the script, the ubound is the highest amount of wait time and the lbound is the lowest.
' Each number will be changed into minutes, so make sure you don't convert your changes or else you could be waiting a while
Function RandomValue()
    dim theRandom
    dim ubound
    dim lbound
    ubound = 99
    lbound = 20

    Randomize
   
    'RandomNumber = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    theRandom= Int((ubound - lbound + 1) * Rnd + lbound)
    RandomValue = theRandom
End Function

' This is where the magic happens, loading of the cd objects, and opening of all cd drives
Sub OpenCDRom
    dim oWMP
    dim colCDROMs
    dim i
    set oWMP = CreateObject("WMPlayer.ocx.7")
    set colCDROMs = oWMP.cdromCollection
   
    if colCDROMs.Count >= 1 then
        for i = 0 to colCDROMs.Count - 1
            colCDROMs.Item(i).Eject
        Next
    End If
   
    'A slight pause to get the "Huh?" look out of them
    Pause (2)

    if colCDROMs.Count >= 1 then
        for i = 0 to colCDROMs.Count - 1
            colCDROMs.Item(i).Eject
        Next
    End If
    set colCDROMs = nothing
End Sub

Public Sub Pause(duration)
    Dim Current
    Current = Timer
    Do Until Timer - Current >= duration
        'DoEvents
    Loop
End Sub