Safely Remove USB Flash Drive

[Ellis Dee]

Thanks to rm_03 for linking this solution. I pared down the German code to the barest essentials. This will be included in my XP library next time I update it, but until then:

Option Explicit
 
Private Declare Function CM_Get_DevNode_Status Lib "setupapi.dll" (lStatus As Long, lProblem As Long, ByVal hDevice As Long, ByVal dwFlags As Long) As Long
Private Declare Function CM_Get_Parent Lib "setupapi.dll" (hParentDevice As Long, ByVal hDevice As Long, ByVal dwFlags As Long) As Long
Private Declare Function CM_Locate_DevNodeA Lib "setupapi.dll" (hDevice As Long, ByVal lpDeviceName As Long, ByVal dwFlags As Long) As Long
Private Declare Function CM_Request_Device_EjectA Lib "setupapi.dll" (ByVal hDevice As Long, lVetoType As Long, ByVal lpVetoName As Long, ByVal cbVetoName As Long, ByVal dwFlags As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal lpdwReserved As Long, lpdwType As Long, lpData As Any, lpcbData As Long) As Long
 
' Safely remove USB flash drive
Public Function SafelyRemove(ByVal pstrDrive As String) As Boolean
    Const DN_REMOVABLE = &H4000
    Dim strDeviceInstance As String
    Dim lngDevice As Long
    Dim lngStatus As Long
    Dim lngProblem As Long
    Dim lngVetoType As Long
    Dim strVeto As String * 255
    
    pstrDrive = UCase$(Left$(pstrDrive, 1)) & ":"
    strDeviceInstance = StrConv(GetDeviceInstance(pstrDrive), vbFromUnicode)
    If CM_Locate_DevNodeA(lngDevice, StrPtr(strDeviceInstance), 0) = 0 Then
        If CM_Get_DevNode_Status(lngStatus, lngProblem, lngDevice, 0) = 0 Then
            Do While Not (lngStatus And DN_REMOVABLE) > 0
                If CM_Get_Parent(lngDevice, lngDevice, 0) <> 0 Then Exit Do
                If CM_Get_DevNode_Status(lngStatus, lngProblem, lngDevice, 0) <> 0 Then Exit Do
            Loop
            If (lngStatus And DN_REMOVABLE) > 0 Then SafelyRemove = (CM_Request_Device_EjectA(lngDevice, lngVetoType, StrPtr(strVeto), 255, 0) = 0)
        End If
    End If
End Function
 
Private Function GetDeviceInstance(pstrDrive As String) As String
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const KEY_QUERY_VALUE = &H1
    Const REG_BINARY = &H3
    Const ERROR_SUCCESS = 0&
    Dim strKey As String
    Dim strValue As String
    Dim lngHandle As Long
    Dim lngType As Long
    Dim strBuffer As String
    Dim lngLen As Long
    Dim bytArray() As Byte
    
    strKey = "SYSTEM\MountedDevices"
    strValue = "\DosDevices\" & pstrDrive
    If RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0&, KEY_QUERY_VALUE, lngHandle) = ERROR_SUCCESS Then
        If RegQueryValueEx(lngHandle, strValue, 0&, lngType, 0&, lngLen) = 234 Then
            If lngType = REG_BINARY Then
                strBuffer = Space$(lngLen)
                If RegQueryValueEx(lngHandle, strValue, 0&, 0&, ByVal strBuffer, lngLen) = ERROR_SUCCESS Then
                    If lngLen > 0 Then
                        ReDim bytArray(lngLen - 1)
                        bytArray = Left$(strBuffer, lngLen)
                        strBuffer = StrConv(bytArray, vbFromUnicode)
                        Erase bytArray
                        If Left$(strBuffer, 4) = "\??\" Then
                            strBuffer = Mid$(strBuffer, 5, InStr(1, strBuffer, "{") - 6)
                            GetDeviceInstance = Replace(strBuffer, "#", "\")
                        End If
                    End If
                End If
            End If
        End If
        RegCloseKey lngHandle
    End If
End Function

Sample usage:

If SafelyRemove("F:") Then
    MsgBox "Safe to remove", vbInformation, "Notice"
End If