Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0717: Erkennen, wann ein Laufwerk, z.B. ein USB-Massenspeicher, hinzugefügt oder entfernt worden ist

 von 

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:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CallWindowProcA (CallWindowProc), RtlMoveMemory (CopyMemory), IIDFromString, RegisterDeviceNotificationA (RegisterDeviceNotification), SetWindowLongA (SetWindowLong), UnregisterDeviceNotification

Download:

Download des Beispielprojektes [6,34 KB]

'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-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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.