Cola Joke (CD Tray opener)
I dont know if any1s seen the cola joke, It asks if u want a free dinks holder, u click ok and ir opens the cd tray/ Well heres the source code ;)
Original Author: Coding Genius
Inputs
Add a command button called cammand1 and a module
Returns
It opens the CD tray
API Declarations
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal
Code
'In a module
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal _
lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength _
As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal _
fdwError As Long, ByVal lpszErrorText As String, ByVal cchErrorText As Long) As Long
'In a form with a command buton named command1
Private Sub Form_Load()
SendMCIString "close all", False
If (App.PrevInstance = True) Then
End
End If
fCDLoaded = False
If (SendMCIString("open cdaudio alias cd wait shareable", True) = False) Then
End
End If
SendMCIString "set cd time format tmsf wait", True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Close all MCI devices opened by this program
SendMCIString "close all", False
End Sub
Private Function SendMCIString(cmd As String, fShowError As Boolean) As Boolean
Static rc As Long
Static errStr As String * 200
rc = mciSendString(cmd, 0, 0, hWnd)
If (fShowError And rc <> 0) Then
mciGetErrorString rc, errStr, Len(errStr)
MsgBox errStr
End If
SendMCIString = (rc = 0)
End Function
Private Sub Command1_Click()
MsgBox "Here is your drinks holder. Just press OK and it will be yours", , "COCA COLA"
SendMCIString "set cd door open", True
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.