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
