Search Tools Links Login

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

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 95 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.