检测CD / DVD插入/弹出

下载源码- 15.05 KB 介绍 您是否想知道如何检测在您的ROM中插入CD / DVD磁盘时发生的事件，或在弹出ROM时发生的事件?在插入磁盘时，您是否曾经需要获取插入到ROM中的CD / DVD内容的类型?如果上述情况是真的，下面这篇文章是为你写的。 背景 使用Win32 API，您可以跟踪许多Windows消息。当你插入/弹出一个CD /DVD，一个WM_DEVICECHANGE消息发生在Windows，你可以跟踪在一个子类的应用程序。使用该技术和其他一些技术，您可以编写一个库，在CD / DVD内容到达时触发事件并删除。此外，您还可以在媒体到达时获得内容的类型。 使用的代码 我已经创建了一个ActiveX DLL项目在VB6。有一个名为clsROMMonitor的类，它是负责子类化和事件触发的主类。一个名为modROMMonitor的通用模块拥有一些用于子类化的有用方法和库所需的Win32 API。图书馆需要一个外部的“形式”才能工作。它有两个事件命名为OnMediaInsert和OnMediaEject，它们将在到达和删除媒体的名称暗示。您还可以了解媒体内容的类型。实现了音频ocd检测和DVD视频检测逻辑。类的IsMediaAudioCD和IsMediaDVDVideo属性将帮助您解决这个问题。它可以扩展到您所能想到的任何特定类型。记住一件事，从VB IDE调试代码可能会遇到问题，因为这使用的是子类化。但是，下面是主类clsROMMonitor的代码: 隐藏,收缩,复制Code

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

通用模块modROMMonitor的代码如下: 隐藏,收缩,复制Code

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

使用图书馆 您可以从任何COM兼容语言使用此库。我使用了一个示例VB6标准EXE应用程序来使用这个。您已经拥有了在代码中使用WinthEvents使用clsROMMonitor所需的一切，以便您可以跟踪事件。您必须将表单的hWnd传递给类的hWnd属性，然后跟踪事件并获取媒体的内容。请看下面示例应用程序的代码: 隐藏,收缩,复制Code

'********************************************************
'* 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!!!

结论 该库使用了Win32API和子类化技术。在调试库时要小心。希望你会喜欢! 历史 2008年9月20日:初任 本文转载于：http://www.diyabc.com/frontweb/news2300.html