Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Opening and closing the CDROM

Posted on 2004-08-03
18
Medium Priority
?
2,243 Views
Last Modified: 2012-06-21
Hello every one i am new to Visual Basic 6 and I have a code for openiong and closing the cdrom from another program But I can not seem to get it to work the code as follows
Private Sub winoperations_Click(Index As Integer)
Select Case Index

Case 0

'To open the CD door, use this code:
lngReturn = mciSendString("set CDAudio door open", strReturn, 127, 0)


Case 1
'To close the CD door, use this code:
lngReturn = mciSendString("set CDAudio door closed", strReturn, 127, 0)
Now since I New to this program the error i get is mcisendString not defined but since i am new i really dont know what that means all your help is a preciated
0
Comment
Question by:Fwankyb
  • 9
  • 4
  • 2
  • +3
18 Comments
 
LVL 28

Expert Comment

by:vinnyd79
ID: 11710918
try this:

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 Command1_Click()
retvalue = mciSendString("set Cdaudio door open", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
retvalue = mciSendString("set Cdaudio door closed", returnstring, 127, 0)
End Sub
0
 
LVL 5

Expert Comment

by:brianb99999
ID: 11710921
Add this into the declarations section (above any functions/code)

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

Brian.
0
 

Author Comment

by:Fwankyb
ID: 11710958
well both of them did not work yet well i have other things in that case should i remove those things and just have this case with the cdrom or get rid of the case all together?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 28

Expert Comment

by:vinnyd79
ID: 11711034
Are the declarations at the top of your form? The case looks like its needed to determine what button was pushed in a command button array. What OS are you using?
0
 

Author Comment

by:Fwankyb
ID: 11711045
Ok in declerations i have one think I put the decleration in but it did not work and it is just a simple Click and im running Windows Xp Professiona and Visual Basic 6
0
 
LVL 28

Expert Comment

by:vinnyd79
ID: 11711049
Also try declaring lngReturn as a Long


Private Sub winoperations_Click(Index As Integer)
Dim lngReturn as Long
Select Case Index

Case 0

'To open the CD door, use this code:
lngReturn = mciSendString("set CDAudio door open", strReturn, 127, 0)


Case 1
'To close the CD door, use this code:
lngReturn = mciSendString("set CDAudio door closed", strReturn, 127, 0)
0
 

Author Comment

by:Fwankyb
ID: 11711089
Ok i did I dim lng return and still get the error now vinny where do i put this
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 Command1_Click()
retvalue = mciSendString("set Cdaudio door open", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
retvalue = mciSendString("set Cdaudio door closed", returnstring, 127, 0)
End Sub ?
0
 
LVL 28

Expert Comment

by:vinnyd79
ID: 11711122
This part has to be in the General/Declarations area at the top of the form you are using it on. If you want to use it from multiple forms you can replace "Private" with "Public" and put it into a .bas module:

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



This would on the form:

Private Sub Command1_Click()
Dim retvalue as Long
retvalue = mciSendString("set Cdaudio door open", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
Dim retvalue as Long
retvalue = mciSendString("set Cdaudio door closed", returnstring, 127, 0)
End Sub
0
 

Author Comment

by:Fwankyb
ID: 11711167
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 Command1_Click()
Dim retvalue As Long
retvalue = mciSendString("set Cdaudio door open", returnstring, 127, 0)
End Sub

Private Sub Command2_Click()
Dim retvalue As Long
retvalue = mciSendString("set Cdaudio door closed", returnstring, 127, 0)
End Sub
 Im getting the error
Constans,fixed-length strings, arrays, uder-defined types and Declare statements not allowed as Public membors object modules
0
 
LVL 9

Expert Comment

by:s_sansanwal
ID: 11711212
add private in declaration of function

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
0
 

Author Comment

by:Fwankyb
ID: 11711234
I have done that already  does not work like that
0
 
LVL 18

Expert Comment

by:JR2003
ID: 11711262
Have you got more than one CD drive?
Start a new project and place an EditBox and two buttons on the form.
Paste the following code into the form:




==============
*** IMPORTANT ***
==============

When you run the project enter the drive letter of the CD you want to open/close

Option Explicit

Private Type MCI_OPEN_PARMS
    dwCallback As Long
    wDeviceID As Long
    sDeviceType As String
    sElementName As String
    sAlias As String
End Type

Public Enum CDDoor_Call
    MCI_SET_DOOR_OPEN = &H100&
    MCI_SET_DOOR_CLOSED = &H200&
End Enum

Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByRef dwParam2 As Any) As Long
Private Const MCI_CLOSE = &H804
Private Const MCI_OPEN = &H803
Private Const MCI_OPEN_ELEMENT = &H200&
Private Const MCI_OPEN_TYPE = &H2000&
Private Const MCI_SET = &H80D


Private Sub Command1_Click()
    'Open Door
    CDDoor Text1.Text, MCI_SET_DOOR_OPEN

End Sub

Private Sub Command2_Click()
    'Close Door
    CDDoor Text1.Text, MCI_SET_DOOR_CLOSED

End Sub

Private Sub CDDoor(m_Drive As String, mCDDoor As CDDoor_Call, Optional Silent As Boolean, Optional ByRef EncounteredError As Boolean)

    Dim iRet As Long
    Dim OP As MCI_OPEN_PARMS
   
    OP.sDeviceType = "cdaudio"
    OP.sElementName = m_Drive
    iRet = mciSendCommand(0, MCI_OPEN, (MCI_OPEN_TYPE Or MCI_OPEN_ELEMENT), OP)
    If iRet = 0 Then
        mciSendCommand OP.wDeviceID, MCI_SET, mCDDoor, OP 'Open/Close the door
        mciSendCommand OP.wDeviceID, MCI_CLOSE, 0, 0      'Close the device handle
    Else
        EncounteredError = True
        If Not Silent Then
            MsgBox "Error loading drive", vbCritical, App.Title
        End If
    End If

End Sub
0
 

Author Comment

by:Fwankyb
ID: 11711273
no i dont but i want this program to do more then that so its not just going to be openand closing the cd drive
0
 
LVL 1

Expert Comment

by:burnttime
ID: 11711315
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrrtning As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long


Private Sub winoperations_Click(Index As Integer)
Select Case Index

Case 0
lngReturn = mciSendString("set CDAudio door open", strReturn, 127, 0)

Case 1
lngReturn = mciSendString("set CDAudio door closed", strReturn, 127, 0)

End Select
End Sub
0
 

Author Comment

by:Fwankyb
ID: 11711337
No errors for that ^ it just does not happen
0
 
LVL 1

Accepted Solution

by:
burnttime earned 375 total points
ID: 11711347
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrrtning As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long


Private Sub winoperations_Click(Index As Integer)
Dim SendStr As String, ReturnStr As String
Select Case Index

Case 0
SendStr = mciSendString("Set cdaudio door open", ReturnStr, 0, 0)

Case 1
SendStr = mciSendString("Set cdaudio door closed", ReturnStr, 0, 0)

End Select
End Sub
0
 

Author Comment

by:Fwankyb
ID: 11711375
since hessiatation but did nto open but seems to be getting there ^
0
 

Author Comment

by:Fwankyb
ID: 11712210
I mean well it hestated the first time i tired to open it but it stoped
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

824 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question