Solved

How to eject and load any CD drive

Posted on 2000-05-09
7
213 Views
Last Modified: 2010-05-02
I've found this nice code to eject any CD in different drives. But how I must modify this code to reload the CD in the device ???

Could anybody help ???

Thanks

Michael



Private Type Registers
    RegBX As Long
    RegDX As Long
    RegCX As Long
    RegAX As Long
    RegDI As Long
    RegSI As Long
    RegFlags As Long
End Type

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Const VWin32_DIOC_DOS_IOCTL = 1

Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Function EjectMedia(Drive As String) As Boolean
    Dim SecAttr As SECURITY_ATTRIBUTES
    Dim ErrorResult
    Dim hDevice As Long, Regs As Registers, RB As Long
   
    EjectMedia = False
    hDevice = CreateFile("\\.\vwin32", 0, 0, SecAttr, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
    If hDevice = -1 Then Exit Function
    With Regs
        .RegAX = &H220D
        .RegBX = Asc(Left$(UCase$(Drive), 1)) - 64
        .RegCX = &H849
    End With
    DeviceIoControl hDevice, VWin32_DIOC_DOS_IOCTL, Regs, Len(Regs), Regs, Len(Regs), RB, 0
    CloseHandle hDevice
    If Regs.RegAX = 0 Then EjectMedia = True
End Function
0
Comment
Question by:Zocko2000
7 Comments
 

Expert Comment

by:visualfool
ID: 2794531
I think i saw something at http://616.org
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2794592
0
 
LVL 4

Expert Comment

by:dreamvb
ID: 2794618
Here is some code I have made for my new Tip for my new vb site shows you how to open and close cd door

'-------Code Starts Here--------------'

                                                        How to Open and close the CD door

Use with VB
Works with VB5, VB4, VB6

Copy and paste in to a new module named module1


--------------------------------------------------------------------------------

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

Enum OpenClose
 OpenDoor = 1
 CloseDoor = 2
End Enum

Function cdDoor(TCommand As OpenClose)
Select Case TCommand
Case 1
Call mciSendString("set cdaudio door open", 0, 0, 0)
Case 2
Call mciSendString("set cdaudio door closed", 0, 0, 0)
End Select

End Function

Place two command buttons a on new form and paste the code into the General Declarations selection and press F5

Private Sub Command1_Click()
Module1.cdDoor OpenDoor

End Sub

Private Sub Command2_Click()
Module1.cdDoor CloseDoor

End Sub

Private Sub Form_Load()
Command1.Caption = "Open Door"
Command2.Caption = "Close Door"

End Sub
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Expert Comment

by:scibberme
ID: 2794821
What would be alot easier is to use an MCI control. It needs to be added to a project in order to be used. It looks like the buttons on a VCR or tape player. This control has a method that will eject and retract the cd tray.
I think that the control can be loaded by checking the box for "Microsoft MCI Control" Components window. (Click on components in the menu.)
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2794986
Zocko2000,

That code looks *REALLY* familiar... Did you happen to get that code here: http://www1.experts-exchange.com/EQ.10288603

I wrote that code, and if you didn't get it there, I would be really curious to know where you got it...

Anyhow, back to the code.  It was written using the FAT32 File System functions originally for ejecting JAZ and ZIP Drive media, however the code will also eject CDs. Take a look at this microsoft URL: http://msdn.microsoft.com/library/psdk/win95/fat32ovr_8h6b.htm
Looking at this article, you will see that there is a "Eject Removable Media" function, but there is not a "Load Removable Media" function...


Cheers!®©
0
 

Accepted Solution

by:
cys050200 earned 50 total points
ID: 2795246
The global declaration is as below. cut the following code into a new module.


Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long


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


Function StartPlay()
    mciSendString "play cd", 0, 0, 0
End Function


Function SetTrack(Track%)
    mciSendString "seek cd To " & Str(Track), 0, 0, 0
End Function


Function StopPlay()
    mciSendString "stop cd wait", 0, 0, 0
End Function


Function PausePlay()
    mciSendString "pause cd", 0, 0, 0
End Function


Function EjectCD()
    mciSendString "set cd door open", 0, 0, 0
End Function


Function CloseCD()
    mciSendString "set cd door closed", 0, 0, 0
End Function


Function UnloadAll()
    mciSendString "close all", 0, 0, 0
End Function


Function SetCDPlayerReady()
    mciSendString "open cdaudio Alias cd wait shareable", 0, 0, 0
End Function


Function SetFormat_tmsf()
    mciSendString "set cd time format tmsf wait", 0, 0, 0
End Function


Function SetFormat_milliseconds()
    mciSendString "set cd time format milliseconds", 0, 0, 0
End Function


Function CheckCD%()
    Dim s As String * 30
    mciSendString "status cd media present", s, Len(s), 0
    CheckCD = s
End Function


Function GetNumTracks%()
    Dim s As String * 30
    mciSendString "status cd number of tracks wait", s, Len(s), 0
    GetNumTracks = CInt(Mid$(s, 1, 2))
End Function


Function GetCDLength$()
    Dim s As String * 30
    mciSendString "status cd length wait", s, Len(s), 0
    GetCDLength = s
End Function


Function GetTrackLength$(TrackNum%)
    Dim s As String * 30
    mciSendString "status cd length track " & TrackNum, s, Len(s), 0
    GetTrackLength = s
End Function


Sub GetCDPosition(Track%, Min%, Sec%)
    Dim s As String * 30
    mciSendString "status cd position", s, Len(s), 0
    Track = CInt(Mid$(s, 1, 2))
    Min = CInt(Mid$(s, 4, 2))
    Sec = CInt(Mid$(s, 7, 2))
End Sub


Function CheckIfPlaying%()
    CheckIfPlaying = 0
    Dim s As String * 30
    mciSendString "status cd mode", s, Len(s), 0
    If Mid$(s, 1, 7) = "playing" Then CheckIfPlaying = 1
End Function
'|---------------------|
'|---Automated Tasks---|
'V---------------------V


Function SeekCDtoX(Track%)
    StopPlay
    SetTrack Track
    StartPlay
End Function


Function ReadyDevice()
    UnloadAll
    SetCDPlayerReady
    SetFormat_tmsf
End Function


Function FastForward(Spd%)
    Dim s As String * 40
    SetFormat_milliseconds
    mciSendString "status cd position wait", s, Len(s), 0
    CheckIfPlaying%


    If CheckIfPlaying = 1 Then
        mciSendString "play cd from " & CStr(CLng(s) + Spd), 0, 0, 0
    Else
        mciSendString "seek cd To " & CStr(CLng(s) + Spd), 0, 0, 0
    End If
    SetFormat_tmsf
End Function


Function ReWind(Spd%)
    Dim s As String * 40
    SetFormat_milliseconds
    mciSendString "status cd position wait", s, Len(s), 0
    CheckIfPlaying%


    If CheckIfPlaying = 1 Then
        mciSendString "play cd from " & CStr(CLng(s) - Spd), 0, 0, 0
    Else
        mciSendString "seek cd To " & CStr(CLng(s) - Spd), 0, 0, 0
    End If
    SetFormat_tmsf
End Function





Before you Do anytihng, add a new Class Module To the project
1.)Make a TextBox and name it "Time" and make its text "5"
2.)Make a TextBox and name it "TrackNumber" and make its caption "1"
3.)Make a Label and name it "Seconds" and make its caption "Seconds"
4.)Make a Label and name it "Track" and make its caption "Track:"
5.)Make a CommandButton and name it "FastRVS" and make its caption "<<"
6.)Make a CommandButton and name it "FastFWD" and make its caption ">>"
7.)Make a CommandButton and name it "Play" and make its caption "Play"
8.)Make a CommandButton and name it "Stop" and make its caption "Stop"
9.)Make a CommandButton and name it "CloseTray" and make its caption "CloseTray"
10.)Make a CommandButton and name it "OpenTray" and make its caption "OpenTray"

Then, cut the following code to your created form.

Dim Snd As CDAudio


Private Sub Play_Click()
    Snd.SeekCDtoX Val(TrackNumber)
End Sub


Private Sub CloseTray_Click()
    Snd.CloseCD
End Sub


Private Sub OpenTray_Click()
    Snd.EjectCD
End Sub


Private Sub Stop_Click()
    Dim x As Integer


    For x = 1 To 10000
        Snd.StopPlay
    Next x
End Sub


Private Sub FastRVS_Click()
    Snd.ReWind Val(Time) * 1000
End Sub


Private Sub FastFWD_Click()
    Snd.FastForward Val(Time) * 1000
End Sub


Private Sub Form_Load()
   
    Set Snd = New CDAudio
    Snd.ReadyDevice
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Snd.StopPlay
    Snd.UnloadAll
End Sub





0
 

Author Comment

by:Zocko2000
ID: 2807015
Thank you for your help !

Zocko
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
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…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

746 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now