下载源码- 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