Click here to Skip to main content
65,938 articles
CodeProject is changing. Read more.
Articles
(untagged)

Detect CD / DVD Insertion / Ejection

0.00/5 (No votes)
20 Sep 2008 1  
How to detect the media insertion / ejection in ROM in VB6

Introduction

Ever wondered how to detect the event when you insert a CD / DVD disk in your ROM or the event when you eject the ROM? Have you ever needed to get the type of the content in the CD / DVD that you inserted in the ROM upon insertion of the disk? If the case(s) above is(are) true, the following article is for you.

Background

Using Win32 API, you can track many messages of Windows. When you insert / eject a CD /DVD, a WM_DEVICECHANGE message occurs in Windows and you can track that in a subclassed application. Using the technique and some others, you can write a library that can fire events on arrival and removal of the CD / DVD content. As well, you can get the type of content in the media upon arrival.

Using the Code

I have created an ActiveX DLL project in VB6. There is one class named clsROMMonitor, the main class responsible for subclassing and event firing. A general module named modROMMonitor holds some useful methods for subclassing and the Win32 API required for the library. The library needs an external hWnd of a "Form" to work. and it has two events named OnMediaInsert and OnMediaEject, they will fire on arrival and removal of the media as the names imply. You'll also be able to know the type of the content of the media. I have implemented AudioCD detection and DVD Video detection logic. The IsMediaAudioCD and IsMediaDVDVideo properties of the class will help you in this matter. It can be extended to any specific type as you can think. Remember one thing, you might face problems to debug the code from the VB IDE since this is using subclassing. However, see the code of the main class clsROMMonitor below:

Option Explicit
  
' Original Window Proc Address
Private mlngWinProcOld              As Long
  
' Subclassed hWnd
Private mlngHwnd                    As Long
Private mlngHandle                  As Long

Private mstrDriveLetter             As String
Private mblnMediaAudioCD            As Boolean
Private mblnMediaDVDVideo           As Boolean

'Events
Public Event OnMediaInsert(DriveLetter As String)
Public Event OnMediaEject(DriveLetter As String)

Public Property Get hwnd() As Long
    hwnd = mlngHandle
End Property

Public Property Let hwnd(lngHwnd As Long)
    mlngHandle = lngHwnd
    SubClass mlngHandle
End Property

Public Property Get IsMediaAudioCD() As Boolean
    IsMediaAudioCD = mblnMediaAudioCD
End Property

Public Property Get IsMediaDVDVideo() As Boolean
    IsMediaDVDVideo = mblnMediaDVDVideo
End Property

Private Sub SubClass(ByVal hwnd&)
    If IsWindow(hwnd) Then
        If GetProp(hwnd, "ROMMonitor") Then
            Exit Sub
        End If
        
        If SetProp(hwnd, ByVal "ROMMonitor", ObjPtr(Me)) Then
            mlngWinProcOld = SetWindowLong_
		(hwnd, GWL_WNDPROC, AddressOf modROMMonitor.WindProc)
            mlngHwnd = hwnd
        End If
    End If
End Sub

Private Sub UnSubClass()
    If IsWindow(mlngHwnd) Then
        If mlngWinProcOld Then
            SetWindowLong mlngHwnd, GWL_WNDPROC, mlngWinProcOld
            ' remove the added property
            RemoveProp mlngHwnd, "ROMMonitor"
            ' set the variables to zero to avoid any mishaps
            mlngWinProcOld = 0
            mlngHwnd = 0
        End If
    End If
End Sub

Private Sub Class_Terminate()
  UnSubClass
End Sub

Private Function GetDriveFromMask(unitmask As Integer) As String
'      Finds the first valid drive letter from a mask of drive letters. The
'      mask must be in the format 1 = A, 2 = B, 4 = C, 8 = D, 16 = E etc.
    GetDriveFromMask = Chr(65 + (Log(unitmask) / Log(2)))
End Function

Private Function pIsMediaAudioCD(ByVal strPath As String) As Boolean
    Dim strFileName     As String   ' Walking filename variable.
    
    On Error Resume Next
        
    strFileName = Dir(strPath & ":\" & "*.cda", _
		vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
    
    If Len(strFileName) <> 0 Then
        pIsMediaAudioCD = True
    Else
        pIsMediaAudioCD = False
    End If
End Function

Private Function pIsMediaDVDVideo(ByVal strPath As String) As Boolean
    Dim strFileName     As String   ' Walking filename variable.
    Dim lngFileCount    As Integer
    
    On Error Resume Next
    lngFileCount = 0
        
    strFileName = Dir(strPath & ":\" & "video_ts", _
		vbNormal Or vbHidden Or vbSystem Or vbReadOnly Or vbDirectory)
    
    If Len(strFileName) <> 0 Then
        strFileName = Dir(strPath & ":\video_ts\*.vob", _
		vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
        While Len(strFileName) <> 0
            lngFileCount = lngFileCount + 1
            DoEvents
            strFileName = Dir()  ' Get next file.
        Wend
        
        If lngFileCount > 0 Then
            pIsMediaDVDVideo = True
        Else
            pIsMediaDVDVideo = False
        End If
    Else
        pIsMediaDVDVideo = False
    End If
End Function

Friend Function WindowProc(ByVal hWindow&, ByVal uMsg&, _
		ByVal wParam&, ByVal lParam&) As Long
    ' this function is called from the modCDMonitor BAS module.  all messages are for
    ' the subclasses hWnd are passed here to be processed before passing them on to VB
    
    Select Case uMsg
        ' catch the device changed message
        Case WM_DEVICECHANGE
            Dim dbHdr As DEV_BROADCAST_HDR, dbVol As DEV_BROADCAST_VOLUME
            
            ' see if the wParam is what we are looking for
            Select Case wParam
                Case DBT_DEVICEARRIVAL, DBT_DEVICEREMOVECOMPLETE
                    ' if the wParam is one of the values we are looking for, copy the
                    ' data pointed to by the lParam into the local 
                    ' DEV_BROADCAST_HDR struct
                    CopyMemory ByVal VarPtr(dbHdr), ByVal lParam, Len(dbHdr)
                    
                    ' if the dbch_devicetype member of the DEV_BROADCAST_HDR 
                    ' struct is equal to DBT_DEVTYP_VOLUME, 
                    ' copy the data pointed to by the lParam into the local
                    ' DEV_BROADCAST_VOLUME struct
                    If dbHdr.dbch_devicetype = DBT_DEVTYP_VOLUME Then
                        CopyMemory ByVal VarPtr(dbVol), ByVal lParam, Len(dbVol)
                        'if the dbcv_flags member includes the DBTF_MEDIA value, 
                        'raise the correct event....
                        If dbVol.dbcv_flags And DBTF_MEDIA Then
                            mstrDriveLetter = GetDriveFromMask(CInt(dbVol.dbcv_unitmask))
                            Select Case wParam
                                Case DBT_DEVICEARRIVAL
                                    mblnMediaAudioCD = pIsMediaAudioCD(mstrDriveLetter)
                                    mblnMediaDVDVideo = pIsMediaDVDVideo(mstrDriveLetter)
                                    RaiseEvent OnMediaInsert(mstrDriveLetter)
                                Case DBT_DEVICEREMOVECOMPLETE
                                    RaiseEvent OnMediaEject(mstrDriveLetter)
                            End Select
                        End If
                    End If
                Case Else
                    ' do nothing
            End Select
        Case Else
            ' do nothing
    End Select
    
    ' pass the messages on to VB
    WindowProc = CallWindowProc(mlngWinProcOld, hWindow, uMsg, wParam, lParam)
End Function

See the code of the general module modROMMonitor below:

Option Explicit

Option Private Module

Public Type DEV_BROADCAST_HDR
    dbch_size As Long
    dbch_devicetype As Long
    dbch_reserved As Long
End Type

Public Type DEV_BROADCAST_VOLUME
    dbcv_size As Long
    dbcv_devicetype As Long
    dbcv_reserved As Long
    dbcv_unitmask As Long
    dbcv_flags As Long
End Type

Public Const DBTF_MEDIA  As Long = &H1&
Public Const DBTF_NET = &H2&
Public Const DBT_DEVTYP_VOLUME  As Long = &H2&
Public Const WM_DEVICECHANGE  As Long = &H219&
Public Const DBT_DEVICEARRIVAL  As Long = &H8000&
Public Const DBT_DEVICEREMOVECOMPLETE  As Long = &H8004&

Public Const GWL_WNDPROC As Long = (-4&)

Public Declare Function IsWindow Lib "user32" (ByVal hwnd&) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
	(lpDest As Any, lpSource As Any, ByVal cBytes&)

Public Declare Function SetProp Lib "user32" Alias "SetPropA" _
	(ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" _
	(ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _
	(ByVal hwnd&, ByVal lpString$) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
	(ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
  (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&) As Long

Public Function WindProc(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&) As Long
    WindProc = ROMMonitorFromHwnd(hwnd).WindowProc(hwnd, uMsg, wParam, lParam)
End Function

Private Function ROMMonitorFromHwnd(ByVal hwnd As Long) As clsROMMonitor
    ' resolve a dumb pointer into a referenced object....
    
    Dim ROMMonitorEx        As clsROMMonitor
    Dim lngptrObj           As Long
      
    ' retrieve the pointer from the property we set in the subclass routine
    lngptrObj = GetProp(hwnd, ByVal "ROMMonitor")
    
    ' copy the pointer into the local variable.  if you end your app during this
    ' process, VB will crash when it tries to destroy the extra object reference
    ' so don't end your app now.
    CopyMemory ROMMonitorEx, lngptrObj, 4&
    
    ' set a reference to the object
    Set ROMMonitorFromHwnd = ROMMonitorEx
    
    ' clear the object variable so VB won't try to
    ' decrement the reference count on the object
    CopyMemory ROMMonitorEx, 0&, 4&
End Function

Using the Library

You can use this library from any COM compatible language. I have used a sample VB6 Standard EXE application to use this. You have all you need to use the clsROMMonitor using WinthEvents in your code so that you can track the events. You'll have to pass the Form's hWnd to the class's hWnd property and then you track the events and get the content of your media. See the code of the sample application below:

'********************************************************
'* WARNING!!!!
'* THIS IS A CLIENT OF A SUBCLASSED LIBRARY PROJECT
'* DO NOT PRESS THE STOP BUTTON OF VB IDE WHILE THE APPLICATION
'* IS RUNNING, OR YOUR APPLICATION WILL CRASH. MAKE SURE YOU CLOSE
'* YOUR APPLICATION WHEN NEEDED BY CLICKING THE CROSS ICON OF THE
'* WINDOW.
'********************************************************

Option Explicit
' the subclass procedure is in the clsCDMonitor class module
Private WithEvents MyROMMonitor As clsROMMonitor

Private Sub Form_Load()
  ' create an instance of the clsCDMonitor object and call it's
  Set MyROMMonitor = New clsROMMonitor
  MyROMMonitor.hWnd = Me.hWnd
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ' destroy the object so we don't crash since the
  ' subclass is terminated in the Class_Terminate event
  Set MyROMMonitor = Nothing
End Sub

Private Sub MyROMMonitor_OnMediaEject(DriveLetter As String)
    MsgBox "Media Ejected"
End Sub

Private Sub MyROMMonitor_OnMediaInsert(DriveLetter As String)
    If MyROMMonitor.IsMediaAudioCD Then
        MsgBox "Media is Audio CD"
    ElseIf MyROMMonitor.IsMediaDVDVideo Then
        MsgBox "Media is DVD Video"
    Else
        MsgBox "Mixed media instered"
    End If
End Sub

'* ENJOY!!!

Conclusion

The library used Win32API and subclassing techniques. Be careful while debugging the library. Hope you'll enjoy this!

History

  • 20th September, 2008: Initial post

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here