VB 5/6-Tipp 0717: Erkennen, wann ein Laufwerk, z.B. ein USB-Massenspeicher, hinzugefügt oder entfernt worden ist
von Frank Schüler
Beschreibung
Dieses Beispiel zeigt wie ermittelt werden kann, wann und welches logische Laufwerk (Netzwerklaufwerk und USB-Massenspeicher (USB-Sticks, USB-Festplatten)) hinzugefügt oder entfernt worden ist. Ebenso wird der Wechsel eines Datenträgers in einem Laufwerk (CD-ROM) erkannt. Per "RegisterDeviceNotification" können weitere Informationen von der Geräteschnittstelle empfangen und ausgewertet werden.
| Schwierigkeitsgrad:
| Verwendete API-Aufrufe: CallWindowProcA (CallWindowProc), RtlMoveMemory (CopyMemory), IIDFromString, RegisterDeviceNotificationA (RegisterDeviceNotification), SetWindowLongA (SetWindowLong), UnregisterDeviceNotification | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '----------- Anfang Projektdatei DriveChange.vbp ----------- '------- Anfang Formular "frmMain" alias frmMain.frm ------- ' Steuerelement: Listen-Steuerelement "lbDevInfo" Option Explicit Private WithEvents cDevChange As clsDeviceChange Private Sub cDevChange_DevChangeInfo(ByVal Info As String) lbDevInfo.AddItem Info End Sub Private Sub Form_Load() Set cDevChange = New clsDeviceChange Call cDevChange.Hook(Me) End Sub Private Sub Form_Unload(Cancel As Integer) Call cDevChange.Unhook(Me) Set cDevChange = Nothing End Sub '-------- Ende Formular "frmMain" alias frmMain.frm -------- '--- Anfang Modul "modDeviceChange" alias modDeviceChange.bas --- Option Explicit ' ----==== Class ====---- Private oDeviceChange As clsDeviceChange ' ----==== Const ====---- Private Const GWL_WNDPROC As Long = (-4) ' --== Windows Nachricht ==-- Private Const WM_DEVICECHANGE As Long = &H219 ' --== WM_DEVICECHANGE Ereignisse (wParam) ==-- ' ein neues Gerät wurde hinzugefügt Private Const DBT_DEVICEARRIVAL As Long = &H8000& ' ein Gerät wurde entfernt Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004& ' --== Typ des Gerätes in DEV_BROADCAST_HDR ==-- ' logisches Laufwerk Private Const DBT_DEVTYP_VOLUME As Long = &H2 ' Geräteschnittstellenklasse Private Const DBT_DEVTYP_DEVICEINTERFACE As Long = &H5 ' --== Medientyp in DBT_DEVTYP_VOLUME ==-- ' Datenträger in einem Laufwerk eingelegt/entfernt Private Const DBTF_MEDIA As Long = &H1 ' logisches Laufwerk ist ein Netzwerklaufwerk Private Const DBTF_NET As Long = &H2 ' --== RegisterDeviceNotification Flags ==-- ' Nachrichten gehen an ein Fensterhandle Private Const DEVICE_NOTIFY_WINDOW_HANDLE As Long = &H0 ' --== die GUIDs der überwachbaren Geräte stehen in ==-- ' --== HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\DeviceClasses\ ==-- ' --== hier nur ein kleiner Auszug von Geräte-GUIDs aus der MSDN ==-- ' --== http://msdn2.microsoft.com/en-us/library/bb663138.aspx ==-- ' USB-Schnittstelle alle USB-Geräte Private Const GUID_DEVINTERFACE_USB_DEVICE As String = _ "{A5DCBF10-6530-11D2-901F-00C04FB951ED}" ' USB-Hub Private Const GUID_DEVINTERFACE_USB_HUB As String = _ "{F18A0E88-C30C-11D0-8815-00A0C906BED8}" ' HDD und sonstige Massenspeicher Private Const GUID_DEVINTERFACE_DISK As String = _ "{53F56307-B6BF-11D0-94F2-00A0C91EFB8B}" ' alle Laufwerke Private Const GUID_DEVINTERFACE_VOLUME As String = _ "{53F5630D-B6BF-11D0-94F2-00A0C91EFB8B}" ' ----==== Types ====---- Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type DEV_BROADCAST_HDR dbch_size As Long dbch_devicetype As Long dbch_reserved As Long End Type Private Type DEV_BROADCAST_VOLUME dbcv_size As Long dbcv_devicetype As Long dbcv_reserved As Long dbcv_unitmask As Long dbcv_flags As Integer End Type ' dieses UDT nehmen wir zum initialisieren ' von RegisterDeviceNotification Private Type DEV_BROADCAST_DEVICEINTERFACE dbcc_size As Long dbcc_devicetype As Long dbcc_reserved As Long dbcc_classguid As GUID dbcc_name As String End Type ' dieses UDT nehmen wir zum auslesen des ' DBT_DEVTYP_DEVICEINTERFACE Ereignisses Private Type DEV_BROADCAST_DEVICEINTERFACE1 dbcc_size As Long dbcc_devicetype As Long dbcc_reserved As Long dbcc_classguid As GUID dbcc_name(128) As Byte End Type ' ----==== KERNEL32 API Deklarationen ====---- Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ pDst As Any, _ pSrc As Any, _ ByVal ByteLen As Long) ' ----==== USER32 API Deklarationen ====---- Private 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 Private Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function RegisterDeviceNotification Lib "user32.dll" _ Alias "RegisterDeviceNotificationA" ( _ ByVal hRecipient As Long, _ ByRef NotificationFilter As DEV_BROADCAST_DEVICEINTERFACE, _ ByVal Flags As Long) As Long Private Declare Function UnregisterDeviceNotification Lib "user32.dll" ( _ ByRef Handle As Long) As Long ' ----==== OLE32 API Deklarationen ====---- Private Declare Function IIDFromString Lib "ole32" ( _ ByVal lpsz As Long, _ ByRef lpiid As GUID) As Long ' ----==== Variablen ====---- Private hPrevProc As Long Private hDevHandle As Long ' ------------------------------------------------------ ' Funktion : HookForm ' Übergabewert : F = Form, wo die Nachrichten ' empfangen werden sollne ' ------------------------------------------------------ Public Sub HookForm(ByRef oDevChange As clsDeviceChange, ByRef F As Form) Dim tGUID As GUID Dim tDBInt As DEV_BROADCAST_DEVICEINTERFACE Set oDeviceChange = oDevChange ' ---=== GUID_DEVINTERFACE_xxxxxxx ===--- ' --== mögliche Rückgabewerte ==-- ' --== Rückgabewerte zB. bei einem USB-Hub ==-- ' USB_HUB = USB\Vid_03eb&Pid_3301\5&768b61b&0&2\ ' --==Rückgabewerte zB. bei einem USB-Stick ==-- ' USB_DEVICE = USB\Vid_13fe&Pid_1d00\077301931DF8\ ' DISK = USBSTOR\Disk&Ven_&Prod_USB_DISK_30X&Rev_PMAP\077301931DF8&0\ ' VOLUME = STORAGE\RemovableMedia\7&2a6df3ef&0&RM\ ' GUID-String konvertieren -> tGUID Call IIDFromString(StrPtr(GUID_DEVINTERFACE_DISK), tGUID) ' BROADCAST_DEVICEINTERFACE tDBInt.dbcc_size = Len(tDBInt) tDBInt.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE tDBInt.dbcc_classguid = tGUID ' Form auf zusätzlichen Empfang von ' der Geräteschnittstellenklasse setzen hDevHandle = RegisterDeviceNotification(F.hwnd, tDBInt, _ DEVICE_NOTIFY_WINDOW_HANDLE) ' es können auch mehrere Geräteklassen registriert werden ' ************************************ ' Call IIDFromString(StrPtr(GUID_DEVINTERFACE_VOLUME), tGUID) ' tDBInt.dbcc_classguid = tGUID ' hDevHandle2 = RegisterDeviceNotification(F.hwnd, tDBInt, ' ' DEVICE_NOTIFY_WINDOW_HANDLE) ' ' Call IIDFromString(StrPtr(GUID_DEVINTERFACE_USB_DEVICE), tGUID) ' tDBInt.dbcc_classguid = tGUID ' hDevHandle3 = RegisterDeviceNotification(F.hwnd, tDBInt, ' ' DEVICE_NOTIFY_WINDOW_HANDLE) ' ************************************ ' wenn kein Handle vorhanden If hDevHandle = 0 Then MsgBox "Das registrieren der Geräteschnittstelle ist " & _ "fehlgeschlagen.", vbOKOnly Or vbInformation End If ' Windowsnachrichten empfangen hPrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub ' ------------------------------------------------------ ' Funktion : UnHookForm ' Übergabewert : F = Form, wo die Nachrichten ' wieder gelöscht werden sollen ' ------------------------------------------------------ Public Sub UnhookForm(ByRef F As Form) ' ist ein Handle vorhanden If hDevHandle <> 0 Then ' Empfang der zusätzlichen Daten löschen Call UnregisterDeviceNotification(hDevHandle) End If ' Empfang von Windowsnachrichten löschen Call SetWindowLong(F.hwnd, GWL_WNDPROC, hPrevProc) Set oDeviceChange = Nothing End Sub ' ------------------------------------------------------ ' Funktion : WindowProc ' Beschreibung : Windowsnachrichten empfangen und auswerten ' ------------------------------------------------------ Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal _ wParam As Long, ByVal lParam As Long) As Long ' auf die Nachricht WM_DEVICECHANGE reagieren If uMsg = WM_DEVICECHANGE Then ' auswerten der Nachricht WM_DEVICECHANGE Call ProcessDeviceChange(wParam, lParam) End If ' nächste Nachricht WindowProc = CallWindowProc(hPrevProc, hwnd, uMsg, wParam, lParam) End Function ' ------------------------------------------------------ ' Funktion : ProcessDeviceChange ' Beschreibung : Auswerten der WM_DEVICECHANGE Nachricht ' Übergabewert : wParam = WindowProc wParam ' lParam = WindowProc lParam ' ------------------------------------------------------ Private Sub ProcessDeviceChange(ByVal wParam As Long, ByVal lParam As Long) Dim strDrive As String Dim strDbccName As String Dim tDBHdr As DEV_BROADCAST_HDR Dim tDBVol As DEV_BROADCAST_VOLUME Dim tDBInt As DEV_BROADCAST_DEVICEINTERFACE1 ' sind Daten im Speicher vorhanden If lParam <> 0 Then ' Daten nach tDBHdr kopieren Call CopyMemory(tDBHdr, ByVal lParam, Len(tDBHdr)) ' WM_DEVICECHANGE Ereignisse Select Case wParam ' ein neues Gerät wurde hinzugefügt Case DBT_DEVICEARRIVAL ' Medientyp in DBT_DEVTYP_VOLUME Select Case tDBHdr.dbch_devicetype ' logisches Laufwerk Case DBT_DEVTYP_VOLUME ' Daten nach tDBVol kopieren CopyMemory tDBVol, ByVal lParam, Len(tDBVol) ' logisches Laufwerk hinzugefügt/verbunden If (tDBVol.dbcv_flags And DBTF_MEDIA) <> DBTF_MEDIA Then If (tDBVol.dbcv_flags And DBTF_NET) <> DBTF_NET Then ' Laufwerksbuchstaben ermitteln strDrive = DriveFromMask(tDBVol.dbcv_unitmask) Call oDeviceChange.RaiseDevChangeInfoEvent("New " & _ "logical drive " & strDrive & ":\ detected.") End If End If ' Medium in einem Laufwerk eingelegt If (tDBVol.dbcv_flags And DBTF_MEDIA) = DBTF_MEDIA Then ' Laufwerksbuchstaben ermitteln strDrive = DriveFromMask(tDBVol.dbcv_unitmask) Call oDeviceChange.RaiseDevChangeInfoEvent("New " & _ "media in Drive " & strDrive & ":\ inserted.") End If ' Netzwerklaufwerk hinzugefügt/verbunden If (tDBVol.dbcv_flags And DBTF_NET) = DBTF_NET Then ' Laufwerksbuchstaben ermitteln strDrive = DriveFromMask(tDBVol.dbcv_unitmask) Call oDeviceChange.RaiseDevChangeInfoEvent("New " & _ "network volume " & strDrive & ":\ detected.") End If ' Geräteschnittstellenklasse Case DBT_DEVTYP_DEVICEINTERFACE ' Daten nach tDBInt kopieren Call CopyMemory(tDBInt, ByVal lParam, Len(tDBInt)) ' DBInt1.dbcc_name enthält den Pfad des Gerätes zu ' HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum ' ByteArray konvertieren -> strDbccName strDbccName = StrConv(tDBInt.dbcc_name, vbUnicode) ' String bis vbNullchar strDbccName = Left$(strDbccName, InStr(1, strDbccName, _ vbNullChar) - 1) ' # durch \ ersetzen strDbccName = Replace(strDbccName, "#", "\") ' \\?\ durch HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\ ' ersetzen strDbccName = Replace(strDbccName, "\\?\", _ "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\") ' String ohne Geräte-GUID strDbccName = Left$(strDbccName, InStr(1, strDbccName, "{") - 1) ' hier können dann weitere Informationen zu diesem ' Gerät aus der Registry ausgelesen werden ' bei Registrierung mehrere Geräteklassen werden ' die Nachrichten in der Reihenfolge ausgegeben in ' der sie registriert worden sind Call oDeviceChange.RaiseDevChangeInfoEvent(strDbccName) End Select ' ein Gerät wurde entfernt Case DBT_DEVICEREMOVECOMPLETE ' Daten nach tDBHdr kopieren Select Case tDBHdr.dbch_devicetype ' logisches Laufwerk Case DBT_DEVTYP_VOLUME ' Daten nach tDBVol kopieren Call CopyMemory(tDBVol, ByVal lParam, Len(tDBVol)) ' logisches Laufwerk entfernt/getrennt If (tDBVol.dbcv_flags And DBTF_MEDIA) <> DBTF_MEDIA Then If (tDBVol.dbcv_flags And DBTF_NET) <> DBTF_NET Then ' Laufwerksbuchstaben ermitteln strDrive = DriveFromMask(tDBVol.dbcv_unitmask) Call oDeviceChange.RaiseDevChangeInfoEvent( _ "Logical drive " & strDrive & ":\ removed.") End If End If ' Medium aus dem Laufwerk entfernt If (tDBVol.dbcv_flags And DBTF_MEDIA) = DBTF_MEDIA Then ' Laufwerksbuchstaben ermitteln strDrive = DriveFromMask(tDBVol.dbcv_unitmask) Call oDeviceChange.RaiseDevChangeInfoEvent("Media in " & _ "Drive " & strDrive & ":\ removed.") End If ' Netzwerklaufwerk entfernt/getrennt If (tDBVol.dbcv_flags And DBTF_NET) = DBTF_NET Then ' Laufwerksbuchstaben ermitteln strDrive = DriveFromMask(tDBVol.dbcv_unitmask) Call oDeviceChange.RaiseDevChangeInfoEvent("Network " & _ "volume " & strDrive & ":\ removed.") End If ' Geräteschnittstellenklasse Case DBT_DEVTYP_DEVICEINTERFACE ' Daten nach tDBInt kopieren Call CopyMemory(tDBInt, ByVal lParam, Len(tDBInt)) ' DBInt1.dbcc_name enthält den Pfad des Gerätes zu ' HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum ' ByteArray konvertieren -> strDbccName strDbccName = StrConv(tDBInt.dbcc_name, vbUnicode) ' String bis vbNullchar strDbccName = Left$(strDbccName, InStr(1, strDbccName, _ vbNullChar) - 1) ' # durch \ ersetzen strDbccName = Replace(strDbccName, "#", "\") ' \\?\ durch HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\ ' ersetzen strDbccName = Replace(strDbccName, "\\?\", _ "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\") ' String ohne Geräte-GUID strDbccName = Left$(strDbccName, InStr(1, strDbccName, "{") - 1) ' hier können dann weitere Informationen zu diesem ' Gerät aus der Registry ausgelesen werden ' bei Registrierung mehrere Geräteklassen werden ' die Nachrichten in der Reihenfolge ausgegeben in ' der sie registriert worden sind Call oDeviceChange.RaiseDevChangeInfoEvent(strDbccName) End Select End Select End If End Sub ' ------------------------------------------------------ ' Funktion : DriveFromMask ' Beschreibung : Laufwerksbuchsten ermitteln ' Übergabewert : UnitMask = tDBVol.dbcv_unitmask ' Rückgabewert : Laufwerksbuchstabe ' ------------------------------------------------------ Private Function DriveFromMask(ByVal UnitMask As Long) As String Dim lngDriveNum As Long ' alle Laufwerksnummern durchlaufen (A-Z) For lngDriveNum = 0 To 25 ' ist das entsprechende Bit in UnitMask <> 0 If (UnitMask And 2 ^ lngDriveNum) <> 0 Then ' Laufwerksbuchstaben zurück geben DriveFromMask = Chr$(65 + lngDriveNum) ' Schleife verlassen Exit For End If ' nächste Laufwerksnummer Next lngDriveNum End Function '--- Ende Modul "modDeviceChange" alias modDeviceChange.bas --- '--- Anfang Klasse "clsDeviceChange" alias clsDeviceChange.cls --- Option Explicit ' ----==== Event ====---- Public Event DevChangeInfo(ByVal Info As String) Public Sub Hook(ByRef F As Form) Call modDeviceChange.HookForm(Me, F) End Sub Public Sub Unhook(ByRef F As Form) Call modDeviceChange.UnhookForm(F) End Sub ' wird von modDeviceChange aufgerufen Friend Sub RaiseDevChangeInfoEvent(ByVal sInfo As String) ' Event auslösen RaiseEvent DevChangeInfo(sInfo) End Sub '--- Ende Klasse "clsDeviceChange" alias clsDeviceChange.cls --- '------------ Ende Projektdatei DriveChange.vbp ------------
Tipp-Kompatibilität:
| Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
| VB4 |  | | | | | | |
| VB5 | | | | | | |  |
| VB6 | | | | | | | |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.