检测 CD / DVD 插入 / 弹出
4.50/5 (9投票s)
如何在 VB6 中检测 ROM 中的媒体插入/弹出
引言
您是否曾经想过如何检测您在 ROM 中插入 CD / DVD 光盘或弹出 ROM 时发生的事件？您是否曾经需要在插入光盘时获取您在 ROM 中插入的 CD / DVD 的内容类型？如果以上情况属实，那么这篇文章适合您。
背景
使用 Win32 API，您可以跟踪许多 Windows 消息。当您插入/弹出 CD /DVD 时，Windows 中会发生一个 WM_DEVICECHANGE 消息，您可以在子类化的应用程序中跟踪该消息。使用该技术和其他技术，您可以编写一个库，该库可以在 CD / DVD 内容到达和删除时触发事件。此外，您还可以在媒体到达时获取媒体的内容类型。
Using the Code
我已经在 VB6 中创建了一个 ActiveX DLL 项目。有一个名为 clsROMMonitor 的类，它是负责子类化和事件触发的主要类。一个名为 modROMMonitor 的通用模块包含一些用于子类化和库所需的 Win32 API 的有用方法。该库需要一个 "Form" 的外部 hWnd 才能工作。它有两个名为 OnMediaInsert 和 OnMediaEject 的事件，它们将在媒体到达和删除时触发，正如其名称所示。您还可以知道媒体的内容类型。我实现了 AudioCD 检测和 DVD 视频检测逻辑。该类的 IsMediaAudioCD 和 IsMediaDVDVideo 属性将帮助您解决这个问题。它可以扩展到您能想到的任何特定类型。记住一件事，您可能会遇到从 VB IDE 调试代码的问题，因为它使用子类化。但是，请参阅下面的主类 clsROMMonitor 的代码
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 的代码
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 所需的一切，以便您可以跟踪事件。您必须将 Form 的 hWnd 传递给类的 hWnd 属性，然后跟踪事件并获取媒体的内容。请参阅下面的示例应用程序的代码
'********************************************************
'* 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 日：初始帖子