CD-ROM Tray Locking

Unfortunately, there is no door lock/unlock... however, instead of sending the MCISendString "Close" on a timer, you could try it with a windows hook... This doesn't take up the resources of a timer...

Here is some example code that will notify you when the CD is opened and closed via Windows hook.  Just modify it to send the MCISendString instead of issuing the CD open messagebox...

Hope this helps!


Cheers!


THE CODE:

This example creates a windows hook on form1 and notifies you when a CD is mounted and unmounted.

1) Create a new project.

2) Add two commandbuttons to the form.  Name them "cmdHook" and "cmdUnHook".

3) Add the following code to the DECLARATIONS SECTION of Form1:

    Private Sub cmdHook_Click()
        Hook
    End Sub
    Private Sub cmdUnHook_Click()
        UnHook
    End Sub
    Private Sub Form_Load()
        gHW = Me.hWnd
    End Sub

4) Add the following code to a MODULE:

    Global lpPrevWndProc As Long
    Global gHW As Long
    Public Const GWL_WNDPROC = -4
    Public Const WM_DEVICECHANGE = 537
    Public Const DBT_DEVICEARRIVAL = 32768
    Public Const DBT_DEVICEREMOVECOMPLETE = 32772
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
           (ByVal lpPrevWndFunc As Long, _
            ByVal hWnd As Long, _
            ByVal Msg As Long, _
            ByVal wParam As Long, _
            ByVal lParam As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
           (ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long
    Public Sub Hook()
        lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
    End Sub
    Public Sub UnHook()
        Dim lngReturnValue As Long
        lngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
    End Sub
    Function WindowProc(ByVal hw As Long, _
                        ByVal uMsg As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
        Select Case uMsg
            Case WM_DEVICECHANGE 'CHECK FOR THE DEVICE CHANGE MESSAGE
                Select Case wParam
                    Case DBT_DEVICEARRIVAL ' DISK MOUNTED
                        MsgBox "CD Inserted"
                    Case DBT_DEVICEREMOVECOMPLETE 'DISK UNMOUNTED
                        MsgBox "CD Removed"
                    Case Else
                        Debug.Print "wParam:", wParam
                End Select
            Case Else
                WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
        End Select
    End Function


5) Run the program and click the "cmdHook" Button.

6) Eject the CD.

7) Insert a CD.

8) Eject the CD.

9) Click the "cmdUnHook" button.

10) Stop the program.

YOU MUST UNHOOK THE WINDOWS HOOK BEFORE STOPPING THE PROGRAM, OTHERWISE IT WILL CRASH!


Cheers!