Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0778: USB Gerät aus- oder einschalten

 von 

Beschreibung 

Anders als im Tipp 718 wird in diesem Beispiel gezeigt, wie ein USB Gerät, an dem ein Wechseldatenträger angeschlossen ist, aus-und wieder eingeschalten werden kann. Durch das wiedereinschalten des USB Gerätes, wird auch wieder der angeschlossene Wechseldatenträger erkannt.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CM_Get_DevNode_Status, CM_Get_Parent, CM_Locate_DevNodeA, CloseHandle, CreateFileA (CreateFile), DeviceIoControl, GetDriveTypeA (GetDriveType), GetLogicalDrives, IIDFromString, QueryDosDeviceA (QueryDosDevice), SetupDiChangeState, SetupDiDestroyDeviceInfoList, SetupDiEnumDeviceInfo, SetupDiEnumDeviceInterfaces, SetupDiGetClassDevsA (SetupDiGetClassDevs), SetupDiGetDeviceInterfaceDetailA (SetupDiGetDeviceInterfaceDetail), SetupDiGetDeviceRegistryPropertyA (SetupDiGetDeviceRegistryProperty), SetupDiSetClassInstallParamsA (SetupDiSetClassInstallParams)

Download:

Download des Beispielprojektes [6,4 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 Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kombinationsliste "cbDrive"
' Steuerelement: Schaltfläche "cmdUsbOn"
' Steuerelement: Schaltfläche "cmdUsbOff"
Option Explicit

' ----==== Const ====----
Private Const CONFIGFLAG_DISABLED As Long = &H1
Private Const CR_SUCCESS As Long = &H0
Private Const DICS_DISABLE As Long = &H2
Private Const DICS_ENABLE As Long = &H1
Private Const DICS_FLAG_GLOBAL As Long = &H1
Private Const DIGCF_DEVICEINTERFACE As Long = &H10
Private Const DIGCF_PRESENT As Long = &H2
Private Const DIF_PROPERTYCHANGE As Long = &H12
Private Const DN_REMOVABLE As Long = &H4000
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOVABLE As Long = 2
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Const ERROR_NO_MORE_ITEMS As Long = 259&
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const IOCTL_STORAGE_GET_DEVICE_NUMBER As Long = &H2D1080
Private Const MAX_PATH As Long = 260
Private Const OPEN_EXISTING As Long = 3
Private Const SPDRP_CONFIGFLAGS As Long = &HA

Private Const GUID_DEVINTERFACE_CDROM As String = _
    "{53F56308-B6BF-11D0-94F2-00A0C91EFB8B}"

Private Const GUID_DEVINTERFACE_DISK As String = _
    "{53F56307-B6BF-11D0-94F2-00A0C91EFB8B}"

Private Const GUID_DEVINTERFACE_FLOPPY As String = _
    "{53F56311-B6BF-11D0-94F2-00A0C91EFB8B}"

Private Const GUID_USB_BUS_DEVICES As String = _
    "{36FC9E60-C465-11CF-8056-444553540000}"

' ----==== Type ====----
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type SP_DEVICE_INTERFACE_DATA
    cbSize As Long
    InterfaceClassGuid As GUID
    flags As Long
    Reserved As Long
End Type

Private Type STORAGE_DEVICE_NUMBER
    DeviceType As Long
    DeviceNumber As Long
    PartitionNumber As Long
End Type

Private Type SP_DEVINFO_DATA
    cbSize As Long
    ClassGuid As GUID
    DevInst As Long
    Reserved As Long
End Type

Private Type SP_CLASSINSTALL_HEADER
    cbSize As Long
    InstallFunction As Long
End Type

Private Type SP_PROPCHANGE_PARAMS
    ClassInstallHeader  As SP_CLASSINSTALL_HEADER
    StateChange As Long
    Scope As Long
    HwProfile As Long
End Type

' ----==== Enum ====----
Private Enum Toggle
    ToggleOff = 0
    ToggleOn = 1
End Enum

' ----==== KERNEL32 Deklarationen ====----
Private Declare Function CloseHandle Lib "kernel32" ( _
                         ByVal hObject As Long) As Long

Private Declare Function CreateFile Lib "kernel32" _
                         Alias "CreateFileA" ( _
                         ByVal lpFileName As String, _
                         ByVal dwDesiredAccess As Long, _
                         ByVal dwShareMode As Long, _
                         ByRef lpSecurityAttributes As Any, _
                         ByVal dwCreationDisposition As Long, _
                         ByVal dwFlagsAndAttributes As Long, _
                         ByVal hTemplateFile As Long) As Long

Private Declare Function DeviceIoControl Lib "kernel32" ( _
                         ByVal hDevice As Long, _
                         ByVal dwIoControlCode As Long, _
                         ByRef lpInBuffer As Any, _
                         ByVal nInBufferSize As Long, _
                         ByRef lpOutBuffer As Any, _
                         ByVal nOutBufferSize As Long, _
                         ByRef lpBytesReturned As Long, _
                         ByRef lpOverlapped As Any) As Long

Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

Private Declare Function GetDriveType Lib "kernel32" _
                         Alias "GetDriveTypeA" ( _
                         ByVal nDrive As String) As Long

Private Declare Function QueryDosDevice Lib "kernel32.dll" _
                         Alias "QueryDosDeviceA" ( _
                         ByVal lpDeviceName As String, _
                         ByVal lpTargetPath As String, _
                         ByVal ucchMax As Long) As Long

' ----==== OLE32 Deklarationen ====----
Private Declare Function IIDFromString Lib "ole32" ( _
                         ByVal lpsz As Long, _
                         ByRef lpiid As GUID) As Long

' ----==== SETUPAPI Deklarationen ====----
Private Declare Function CM_Get_DevNode_Status Lib "setupapi.dll" ( _
                         ByRef pulStatus As Long, _
                         ByRef pulProblemNumber As Long, _
                         ByVal dnDevInst As Long, _
                         ByVal ulFlags As Long) As Long

Private Declare Function CM_Get_Parent Lib "setupapi.dll" ( _
                         ByRef pdnDevInst As Long, _
                         ByVal dnDevInst As Long, _
                         ByVal ulFlags As Long) As Long

Private Declare Function CM_Locate_DevNodeA Lib "setupapi.dll" ( _
                         ByRef pdnDevInst As Long, _
                         ByVal pDeviceID As Long, _
                         ByVal ulFlags As Long) As Long

Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" ( _
                         ByVal DeviceInfoSet As Long) As Long

Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" ( _
                         ByVal DeviceInfoSet As Long, _
                         ByRef DeviceInfoData As Any, _
                         ByRef InterfaceClassGuid As GUID, _
                         ByVal MemberIndex As Long, _
                         ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long

Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" _
                         Alias "SetupDiGetDeviceInterfaceDetailA" ( _
                         ByVal DeviceInfoSet As Long, _
                         ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, _
                         ByRef DeviceInterfaceDetailData As Any, _
                         ByVal DeviceInterfaceDetailDataSize As Long, _
                         ByRef RequiredSize As Long, _
                         ByRef DeviceInfoData As Any) As Long

Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" _
                         Alias "SetupDiGetClassDevsA" ( _
                         ByRef ClassGuid As GUID, _
                         ByVal Enumerator As String, _
                         ByVal hwndParent As Long, _
                         ByVal flags As Long) As Long

Private Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" ( _
                         ByVal DeviceInfoSet As Long, _
                         ByVal MemberIndex As Long, _
                         ByRef DeviceInfoData As SP_DEVINFO_DATA) As Long

Private Declare Function SetupDiGetDeviceRegistryProperty Lib "setupapi.dll" _
                         Alias "SetupDiGetDeviceRegistryPropertyA" ( _
                         ByVal DeviceInfoSet As Long, _
                         ByRef DeviceInfoData As SP_DEVINFO_DATA, _
                         ByVal Property As Long, _
                         ByRef PropertyRegDataType As Long, _
                         ByRef PropertyBuffer As Any, _
                         ByVal PropertyBufferSize As Long, _
                         ByRef RequiredSize As Long) As Long

Private Declare Function SetupDiSetClassInstallParams Lib "setupapi.dll" _
                         Alias "SetupDiSetClassInstallParamsA" ( _
                         ByVal DeviceInfoSet As Long, _
                         ByRef DeviceInfoData As SP_DEVINFO_DATA, _
                         ByRef ClassInstallParams As SP_CLASSINSTALL_HEADER, _
                         ByVal ClassInstallParamsSize As Long) As Long

Private Declare Function SetupDiChangeState Lib "setupapi.dll" ( _
                         ByVal DeviceInfoSet As Long, _
                         ByRef DeviceInfoData As SP_DEVINFO_DATA) As Long

Private hUsbDevInst As Long
Private strDriveLetter As String

' ------------------------------------------------------
' Funktion     : ToggleUSBController
' Beschreibung : De- oder Aktiviert einen USB Controller
' Übergabewert : hDevInst = Handle auf einen USB Controller
'                ToggleStatus = Type Toggle
' Rückgabewert : True = Erfolgreich / False = nicht erfolgreich
' ------------------------------------------------------
' Der Original Code zu dieser Funktion ist auf der Seite
' http://www.vb-paradise.de/index.php/Thread/10749-USB-Deaktivieren
' zu finden.
' ------------------------------------------------------
Private Function ToggleUSBController(ByVal hDevInst As Long, Optional _
    ByVal ToggleStatus As Toggle = ToggleOff) As Boolean

    Dim tSPDD As SP_DEVINFO_DATA
    Dim tGUID As GUID
    Dim hDevInfo As Long
    Dim lngIndex As Long
    Dim bolEnabled As Boolean

    ' String zu GUID konvertieren
    Call IIDFromString(StrPtr(GUID_USB_BUS_DEVICES), tGUID)

    ' Handle auf ein "Device Information Set" holen
    hDevInfo = SetupDiGetClassDevs(tGUID, vbNullString, 0, DIGCF_PRESENT)

    ' kein gültiges Handle
    If hDevInfo = INVALID_HANDLE_VALUE Then

        ToggleUSBController = False

        Exit Function

    End If

    tSPDD.cbSize = LenB(tSPDD)

    ' "Device Information Set" -> SP_DEVINFO_DATA
    ' USB Device Tree durchlaufen
    While SetupDiEnumDeviceInfo(hDevInfo, lngIndex, tSPDD) <> 0

        ' ist das gesuchte USB Device gleich dem aus dem USB Device Tree
        If hDevInst = tSPDD.DevInst Then
        
            ' Status (On/Off) vom USB Device ermitteln -> bolEnabled
            If Not GetDeviceState(hDevInfo, tSPDD, bolEnabled) Then

                ' wenn das ermitteln des Status fehl schlägt
                ToggleUSBController = False

                ' "Device Information Set" löschen
                Call SetupDiDestroyDeviceInfoList(hDevInfo)

                Exit Function

            End If

            ' soll das USB Device augeschalten werden
            If ToggleStatus = ToggleOff Then
            
                ' ist das USB Device eingeschalten
                If bolEnabled = True Then
                    
                    ' dann das USB Device ausschalten
                    If Not EnableDevice(hDevInfo, tSPDD, False) Then

                        ' wenn das ausschalten fehl schlägt
                        ToggleUSBController = False

                        ' "Device Information Set" löschen
                        Call SetupDiDestroyDeviceInfoList(hDevInfo)

                        Exit Function

                    End If
                End If

            Else
                ' soll das USB Device augeschalten werden
                
                ' ist das USB Device ausgeschalten
                If bolEnabled = False Then
                
                    ' dann das USB Device einschalten
                    If Not EnableDevice(hDevInfo, tSPDD, True) Then

                        ' wenn das einschalten fehl schlägt
                        ToggleUSBController = False

                        ' "Device Information Set" löschen
                        Call SetupDiDestroyDeviceInfoList(hDevInfo)

                        Exit Function

                    End If
                End If
            End If
        End If

        lngIndex = lngIndex + 1

    Wend

    ' "Device Information Set" löschen
    Call SetupDiDestroyDeviceInfoList(hDevInfo)

    ToggleUSBController = (Err.LastDllError = 0 Or Err.LastDllError = _
        ERROR_NO_MORE_ITEMS)

End Function

' ------------------------------------------------------
' Funktion     : GetDeviceState
' Beschreibung : Ermittelt den Status eines USB Controller
' Übergabewert : hDevInst = Handle auf einen USB Controller
'                devInfoData = Type SP_DEVINFO_DATA
'                bEnabled = Rückgabe ob On (True) oder Off (False)
' Rückgabewert : True = Erfolgreich / False = nicht erfolgreich
' ------------------------------------------------------
' Der Original Code zu dieser Funktion ist auf der Seite
' http://www.vb-paradise.de/index.php/Thread/10749-USB-Deaktivieren
' zu finden.
' ------------------------------------------------------
Private Function GetDeviceState(ByVal hDevInfo As Long, ByRef devInfoData _
    As SP_DEVINFO_DATA, ByRef bEnabled) As Boolean

    Dim lngFlags As Long

    ' Status des USB Controllers ermitteln
    If SetupDiGetDeviceRegistryProperty(hDevInfo, devInfoData, _
        SPDRP_CONFIGFLAGS, ByVal 0, lngFlags, 4, ByVal 0) = 0 Then

        GetDeviceState = False

        Exit Function

    End If

    bEnabled = ((lngFlags And CONFIGFLAG_DISABLED) = 0)
    GetDeviceState = True

End Function

' ------------------------------------------------------
' Funktion     : EnableDevice
' Beschreibung : Status eines USB Controller ändern
' Übergabewert : hDevInfo = Handle auf ein "Device Information Set"
'                devInfoData = Type SP_DEVINFO_DATA
'                bEnabled: True = einschalten / False = ausschalten
' Rückgabewert : True = Erfolgreich / False = nicht erfolgreich
' ------------------------------------------------------
' Der Original Code zu dieser Funktion ist auf der Seite
' http://www.vb-paradise.de/index.php/Thread/10749-USB-Deaktivieren
' zu finden.
' ------------------------------------------------------
Private Function EnableDevice(ByVal hDevInfo As Long, ByRef devInfoData _
    As SP_DEVINFO_DATA, ByVal bEnable As Boolean) As Boolean

    Dim tSPPP As SP_PROPCHANGE_PARAMS

    With tSPPP

        .ClassInstallHeader.cbSize = LenB(.ClassInstallHeader)
        
        ' Anweisen das sich eine Eigenschaft geändert hat
        .ClassInstallHeader.InstallFunction = DIF_PROPERTYCHANGE
        
        ' Änderungen in allen Hardwareprofilen durchführen
        .Scope = DICS_FLAG_GLOBAL

        If bEnable = True Then

            ' Device einschalten
            .StateChange = DICS_ENABLE

        Else

            ' Device ausschalten
            .StateChange = DICS_DISABLE

        End If

        .HwProfile = 0

    End With

    ' Änderungen am "Device Information Set" durchführen
    If SetupDiSetClassInstallParams(hDevInfo, devInfoData, _
        tSPPP.ClassInstallHeader, LenB(tSPPP)) = 1 Then

        EnableDevice = (SetupDiChangeState(hDevInfo, devInfoData) = 1)

    End If

End Function

' ------------------------------------------------------
' Funktion     : GetDevInstStr
' Beschreibung : Gerätenamen zu einem Laufwerk ermitteln
' Übergabewert : DriveLetter = Laufwerksbuchstabe
' Rückgabewert : Gerätename
' ------------------------------------------------------
' Der Original C++ Code zu dieser Funktion ist auf der Seite
' http://www.codeproject.com/KB/system/RemoveDriveByLetter.aspx
' zu finden. Einge Teile zu dieser Funktion stammen auch von
' http://www.vbarchiv.net/workshop/workshop78s2.html
' ------------------------------------------------------
Private Function GetDevInstStr(ByVal DriveLetter As String) As String

    Dim hVolume As Long
    Dim hDevInfo As Long
    Dim bolIsFloppy As Boolean
    Dim bytBuff() As Byte
    Dim lngRet As Long
    Dim lngBuffLen As Long
    Dim lngDevNumber As Long
    Dim lngIndex As Long
    Dim strRet As String
    Dim strBuff As String * MAX_PATH
    Dim strDosDevName As String
    Dim tGUID As GUID
    Dim tSDN As STORAGE_DEVICE_NUMBER
    Dim tSPDID As SP_DEVICE_INTERFACE_DATA

    ' Handle auf das Laufwerk holen
    hVolume = CreateFile("\\.\" & DriveLetter & ":", 0&, FILE_SHARE_READ _
        Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0&, ByVal 0&)

    ' ist ein gültiges Handle vorhanden
    If hVolume <> INVALID_HANDLE_VALUE Then

        ' Laufwerksnummer ermitteln
        If DeviceIoControl(hVolume, IOCTL_STORAGE_GET_DEVICE_NUMBER, _
            ByVal 0&, 0&, tSDN, Len(tSDN), lngRet, ByVal 0&) Then

            ' Laufwerksnummer speichern
            lngDevNumber = tSDN.DeviceNumber

        End If

        ' Handle schließen
        Call CloseHandle(hVolume)

    End If

    ' DOS-Gerätenamen vom Laufwerk ermitteln
    If QueryDosDevice(DriveLetter & ":", strBuff, MAX_PATH) Then

        ' DOS-Gerätename
        strDosDevName = Left$(strBuff, InStr(1, strBuff, vbNullChar) - 1)

        ' ist das Laufwerk ein Diskettenlauferk
        If InStr(1, strDosDevName, "\Floppy") Then

            ' Laufwerk ist ein Diskettenlaufwerk
            bolIsFloppy = True

        End If
    End If

    ' Laufwerkstyp ermitteln
    Select Case GetDriveType(DriveLetter & ":\")

        ' auswerfbare Laufwerke
    Case DRIVE_REMOVABLE

        ' Diskettenlaufwerke
        If bolIsFloppy Then

            ' String zu GUID konvertieren
            Call IIDFromString(StrPtr(GUID_DEVINTERFACE_FLOPPY), tGUID)

        Else

            ' andere auswerfbare Laufwerke
            ' String zu GUID konvertieren
            Call IIDFromString(StrPtr(GUID_DEVINTERFACE_DISK), tGUID)

        End If

        ' HD-Laufwerke
    Case DRIVE_FIXED

        ' String zu GUID konvertieren
        Call IIDFromString(StrPtr(GUID_DEVINTERFACE_DISK), tGUID)

        ' CDROM-Laufwerke
    Case DRIVE_CDROM

        ' String zu GUID konvertieren
        Call IIDFromString(StrPtr(GUID_DEVINTERFACE_CDROM), tGUID)

    End Select

    ' Handle auf die Geräteklasse holen
    hDevInfo = SetupDiGetClassDevs(tGUID, vbNullString, 0&, DIGCF_PRESENT _
        Or DIGCF_DEVICEINTERFACE)

    ' ist ein gültiges Handle vorhanden
    If hDevInfo <> INVALID_HANDLE_VALUE Then

        tSPDID.cbSize = Len(tSPDID)

        ' alle Geräte in dieser Geräteklasse durchlaufen
        Do

            ' Geräte in dieser Geräteklasse auflisten
            If SetupDiEnumDeviceInterfaces(hDevInfo, ByVal 0&, tGUID, _
                lngIndex, tSPDID) = 0 Then

                ' wenn keine Geräte mehr in dieser Geräteklasse
                ' vorhanden sind
                If Err.LastDllError = ERROR_NO_MORE_ITEMS Then

                    ' Schleife verlassen
                    Exit Do

                Else

                    ' Funktion verlassen
                    Exit Function

                End If
            End If

            ' hier ermitteln wir die erforderliche Buffergröße zur
            ' Aufnahme des Gerätenamens
            If SetupDiGetDeviceInterfaceDetail(hDevInfo, tSPDID, ByVal _
                0&, 0&, lngBuffLen, ByVal 0&) = 0 Then

                ' wenn der Buffer zu klein ist
                If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then

                    ' Type SP_DEVICE_INTERFACE_DETAIL_DATA
                    '    cbSize As Long
                    '    DevicePath(0) As Byte
                    ' End Type
                    ' anstelle von SP_DEVICE_INTERFACE_DETAIL_DATA
                    ' verwenden wir hier ein BytaArray
                    ' Buffer dimensionieren
                    ReDim bytBuff(lngBuffLen - 1)

                    ' Len(SP_DEVICE_INTERFACE_DETAIL_DATA)
                    bytBuff(0) = 5

                    ' Gerätenamen ermitteln
                    If SetupDiGetDeviceInterfaceDetail(hDevInfo, tSPDID, _
                        bytBuff(0), lngBuffLen, lngBuffLen, ByVal 0&) <> _
                        0 Then

                        ' Handle auf das Gerät holen
                        hVolume = CreateFile(Mid$(StrConv(bytBuff, _
                            vbUnicode), 5, lngBuffLen - 5), 0&, _
                            FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal _
                            0&, OPEN_EXISTING, 0&, ByVal 0&)

                        ' ist ein gültiges Handle vorhanden
                        If hVolume <> INVALID_HANDLE_VALUE Then

                            ' Gerätenummer ermitteln
                            If DeviceIoControl(hVolume, _
                                IOCTL_STORAGE_GET_DEVICE_NUMBER, ByVal _
                                0&, 0&, tSDN, Len(tSDN), lngRet, ByVal _
                                0&) Then

                                ' ist die Laufwerksnummer gleich der
                                ' Gerätenummer
                                If lngDevNumber = tSDN.DeviceNumber Then

                                    ' Handle auf das Gerät schließen
                                    Call CloseHandle(hVolume)

                                    ' Handle auf die Geräteklasse schließen
                                    Call SetupDiDestroyDeviceInfoList( _
                                        hDevInfo)

                                    ' Gerätename
                                    strRet = Mid$(StrConv(bytBuff, _
                                        vbUnicode), 5, lngBuffLen - 5)

                                    ' # durch \ ersetzen
                                    strRet = Replace(strRet, "#", "\")

                                    ' die ersten 4 Zeichen und die
                                    ' Geräte-GUID
                                    ' wegschneiden
                                    strRet = Mid$(strRet, 5, InStr(1, _
                                        strRet, "{") - 6)

                                    ' für GetUsbDriveDevInst benötigen wir
                                    ' nur auswerfbare USB-Laufwerke
                                    If UCase$(Left$(strRet, 7)) = _
                                        "USBSTOR" Then

                                        ' Gerätenamen zurückgeben
                                        GetDevInstStr = strRet

                                    End If
                                End If
                            End If

                            ' Handle auf das Gerät schließen
                            Call CloseHandle(hVolume)

                        End If
                    End If
                End If
            End If

            ' nächste Geräteindexnummer
            lngIndex = lngIndex + 1

            ' nächstes Geräte in dieser Geräteklasse
        Loop

        ' Handle auf die Geräteklasse schließen
        Call SetupDiDestroyDeviceInfoList(hDevInfo)

    End If

End Function

' ------------------------------------------------------
' Funktion     : GetUsbDriveDevInst
' Beschreibung : DevInst eines USB-Laufwerks ermitteln
' Übergabewert : DriveLetter = Laufwerksbuchstabe
' Rückgabewert : DevInst
' ------------------------------------------------------
Private Function GetUsbDriveDevInst(ByVal DriveLetter As String) As Long

    Dim strDevInst As String
    Dim hDevInst As Long
    Dim lngStatus As Long
    Dim lngProblem As Long

    ' Storagename aus der Registry auslesen
    strDevInst = GetDevInstStr(DriveLetter)

    ' ist ein Storagename vorhanden
    If Len(strDevInst) <> 0 Then

        ' Handle auf den Node holen
        If CM_Locate_DevNodeA(hDevInst, StrPtr(StrConv(strDevInst, _
            vbFromUnicode)), 0&) = CR_SUCCESS Then

            ' wenn dieser Node nicht auswerfbar ist, dann solange bis zum
            ' Parentnode raufgehen bis dieser auswerfbar ist
            If CM_Get_DevNode_Status(lngStatus, lngProblem, hDevInst, 0&) _
                = CR_SUCCESS Then

                ' solange die Schleife durchlaufen bis (lngStatus And
                ' DN_REMOVABLE) = DN_REMOVABLE
                Do While Not (lngStatus And DN_REMOVABLE) = DN_REMOVABLE

                    ' wenn kein Parentnode mehr vorhanden, dann Schleife
                    ' verlassen
                    If Not CM_Get_Parent(hDevInst, hDevInst, 0&) = _
                        CR_SUCCESS Then Exit Do

                    ' wenn CM_Get_DevNode_Status nicht = CR_SUCCESS ist,
                    ' dann Schleife verlassen
                    If Not CM_Get_DevNode_Status(lngStatus, lngProblem, _
                        hDevInst, 0&) = CR_SUCCESS Then Exit Do

                Loop

                ' Handle zurück geben
                GetUsbDriveDevInst = hDevInst

            End If
        End If
    End If

End Function

Private Sub ListRemovableDrives()

    Dim lngDriveNum As Long
    Dim lngRet As Long
    Dim strDriveName As String
    
    ' alle Items in der ListBox löschen
    cbDrive.Clear
    
    ' alle verfügbare Laufwerke ermitteln
    lngRet = GetLogicalDrives
    
    ' alle Laufwerksnummern durchlaufen
    For lngDriveNum = 0 To 25
    
        ' ist das entsprechende Bit in lngRet <> 0
        If (lngRet And 2 ^ lngDriveNum) <> 0 Then
        
            ' Laufwerksbuchstabe
            strDriveName = Chr$(65 + lngDriveNum)
            
                ' Laufwerkstyp ermitteln (USB-Laufwerke)
                If Len(GetDevInstStr(strDriveName)) > 0 Then
                
                    ' Daten in der ComboBox ausgeben und speichern
                    cbDrive.AddItem strDriveName & ":\"
                    cbDrive.ItemData(cbDrive.NewIndex) = lngDriveNum
                    
                End If
        End If
        
        ' nächste Laufwerksnummer
    Next lngDriveNum
    
    ' sind Einträge in der ComboBox vorhanden
    If cbDrive.ListCount > 0 Then
    
        ' erster Eintrag in der ComboBox
        cbDrive.ListIndex = 0
        
        ' Button aktivieren
        cmdUsbOff.Enabled = True
        
    End If

End Sub

Private Sub cmdUsbOff_Click()

    ' sind Einträge in der ComboBox vorhanden
    If cbDrive.ListCount > 0 Then
    
        ' Laufwerksbuchstaben auslesen
        strDriveLetter = Chr$(65 + cbDrive.ItemData(cbDrive.ListIndex))
        
        ' Handle auf das USB-Laufwerk holen
        hUsbDevInst = GetUsbDriveDevInst(strDriveLetter)
        
        ' Laufwerk ausschalten
        If ToggleUSBController(hUsbDevInst, ToggleOff) Then
        
            MsgBox "Laufwerk '" & strDriveLetter & ":\' wurde " & _
                "erfolgreich ausgeschalten.", vbOKOnly Or vbInformation
                
            ' alle auswerfbare Laufwerke ermitteln
            Call ListRemovableDrives
                
            cmdUsbOff.Enabled = False
            cmdUsbOn.Enabled = True
            cmdUsbOn.Caption = strDriveLetter & ":\ Toggle On"
                
        Else
        
            MsgBox "Laufwerk '" & strDriveLetter & ":\' konnte nicht " & _
                "ausgeschalten werden.", vbOKOnly Or vbExclamation
                
        End If
    End If

End Sub

Private Sub cmdUsbOn_Click()

        ' Laufwerk einschalten
        If ToggleUSBController(hUsbDevInst, ToggleOn) Then
        
            MsgBox "Laufwerk '" & strDriveLetter & ":\' wurde " & _
                "erfolgreich eingeschalten.", vbOKOnly Or vbInformation
                            
            ' alle auswerfbare Laufwerke ermitteln
            Call ListRemovableDrives
                
            cmdUsbOff.Enabled = True
            cmdUsbOn.Enabled = False
            cmdUsbOn.Caption = "Toggle On"
                
        Else
        
            MsgBox "Laufwerk '" & strDriveLetter & ":\' konnte nicht " & _
                "eingeschalten werden.", vbOKOnly Or vbExclamation
                
        End If

End Sub

Private Sub Form_Load()
    
    cmdUsbOn.Enabled = False
    
    ' alle auswerfbare Laufwerke ermitteln
    Call ListRemovableDrives
    
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.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.