Find and close all open handles to a drive

[pcuser]

Have you ever tried to run chkdsk on a drive or format it or eject a usb drive when other programs are still accessing it or running from it? The operation will fail... This code shows how to enumerate all open handles pointing to the drive letter you specify (in the Form_Load event) and lets you close them. If a program is running from the drive then closing the handle isn't enough so the process itself has to be terminated.

WARNING! Do NOT specify the drive letter of your SYSTEM (C drive or you'll find yourself pressing the "reset" button on the front of your computer. Yes, curiosity got the best of me and I just had to try it


How to test this code:

Open a few Explorer windows and command promt windows displaying the contents of your USB drive and maybe even run an exe or two from the drive then change "H:" in the Form_Load event to match your USB drive letter and run this program and it should find all open handles and display them in the listbox. Click the command button to have all handles closed for you and if the handle points to a process running from the USB drive then the process itself will be closed.


Create a new project:

Add a Listbox (List1)
Add a Command button (Command1)
Add a Timer (Timer1 set to 2000)


Here's the code:

Option Explicit

'/////////////////////////////////////////////////////////////////////////
' This code were explicitly developed for PSC(Planet Source Code) Users,
' as Open Source Project. This code are property of their author.
'
' You may use any of this code in you're own application(s).
'
' (c) Luprix  2004
' [email protected]
'/////////////////////////////////////////////////////////////////////////


'///////////////////////////// Constants and Types ////////////////////////

Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF

Private Const MAX_PATH As Long = 260
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"

Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const SE_PRIVILEGE_ENABLED As Long = &H2

Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_DUP_HANDLE = &H40
Private Const PROCESS_QUERY_INFORMATION = &H400

Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const GENERIC_ALL = &H10000000

Private Const INVALID_HANDLE_VALUE = -1
Private Const SystemHandleInformation = 16&
Private Const ObjectNameInformation = 1&

Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004

Private Type LUID
    LowPart As Long
    HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
   pLuid As LUID
   Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    TheLuid As LUID
    Attributes As Long
End Type

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type SYSTEM_HANDLE_TABLE_ENTRY_INFO
    UniqueProcessId  As Integer
    CreatorBackTraceIndex  As Integer
    ObjectTypeIndex As Byte
    HandleAttributes As Byte
    HandleValue As Integer
    Object  As Long
    GrantedAccess As Long
End Type

Private Type SYSTEM_HANDLE_INFORMATION
    NumberOfHandles As Long
    Handles() As SYSTEM_HANDLE_TABLE_ENTRY_INFO
End Type

Private Type OBJECT_NAME_PRIVATE
    Length          As Integer
    MaximumLength   As Integer
    Buffer          As Long
    ObjName(1023)     As Byte
End Type

'///////////////////////////// Declarations ///////////////////////////////

'Undocumented Native API
Private Declare Function NtDuplicateObject Lib "NTDLL.DLL" (ByVal _
    hSourceProcess As Long, _
    ByVal hSourceHandle As Long, _
    ByVal hCopyProcess As Long, _
    CopyHandle As Long, _
    ByVal DesiredAccess As Long, _
    ByVal Attributes As Long, _
    ByVal Options As Long) As Long

Private Declare Function NtClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long

Private Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" ( _
    ByVal dwInfoType As Long, _
    ByVal lpStructure As Long, _
    ByVal dwSize As Long, _
    dwReserved As Long) As Long

Private Declare Function NtQueryObject Lib "NTDLL.DLL" ( _
    ByVal ObjectHandle As Long, _
    ByVal ObjectInformationClass As Long, _
    ObjectInformation As OBJECT_NAME_PRIVATE, _
    ByVal Length As Long, _
    ResultLength As Long) As Long

'Win32 API
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" _
    Alias "LookupPrivilegeValueA" ( _
    ByVal lpSystemName As String, _
    ByVal lpName As String, _
    lpLuid As LUID) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" ( _
    ByVal TokenHandle As Long, _
    ByVal DisableAllPrivileges As Long, _
    ByRef NewState As TOKEN_PRIVILEGES, _
    ByVal BufferLength As Long, _
    ByRef PreviousState As TOKEN_PRIVILEGES, _
    ByRef ReturnLength As Long) As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
    ByVal ProcessHandle As Long, _
    ByVal DesiredAccess As Long, _
    ByRef TokenHandle As Long) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long) As Long
    
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

Private Declare Function GetLastError Lib "kernel32.dll" () As Long

Private Declare Function OpenProcess Lib "kernel32.dll" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

Private Declare Function DuplicateHandle Lib "kernel32" ( _
    ByVal hSourceProcessHandle As Long, _
    ByVal hSourceHandle As Long, _
    ByVal hTargetProcessHandle As Long, _
    lpTargetHandle As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwOptions As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" _
    Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Private Declare Function EnumProcessModules Lib "psapi.dll" ( _
    ByVal hProcess As Long, _
    ByRef lphModule As Long, _
    ByVal cb As Long, _
    ByRef cbNeeded As Long) As Long

Private Declare Function GetModuleFileNameExA Lib "psapi.dll" ( _
    ByVal hProcess As Long, _
    ByVal hModule As Long, _
    ByVal ModuleName As String, _
    ByVal nSize As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

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

'Global Vars
Dim Privilege As Boolean
Dim ResultPorts(1, 65535) As Long
Dim DriveLetter As String

[pcuser]

It didn't all fit in one post...

Function OpenPort() As Boolean

    Dim i As Long, Status As Long
    Dim Ret As Long, NumHandles As Long
    Dim HandleInfo As SYSTEM_HANDLE_INFORMATION
    Dim RequiredLength As Long
    Dim Buffer() As Byte
    
    Do
        ReDim Buffer(0 To 19)
        RequiredLength = 20 'len SYSTEM_HANDLE_INFORMATION
    
        'first, find the RequiredLength for the SYSTEM_HANDLE_INFORMATION array
        
        Status = NtQuerySystemInformation(SystemHandleInformation, _
              ByVal VarPtr(Buffer(0)), ByVal RequiredLength, 0&)
                
        If Status = 0 Then
            Exit Do
        End If
        
        'obtain, RequiredLength
        CopyMemory ByVal VarPtr(NumHandles), ByVal VarPtr(Buffer(0)), 4
        RequiredLength = NumHandles * 16 + 4
        ReDim Buffer(0 To RequiredLength)
    
        'Native API NTDLL. Find system information
        Status = NtQuerySystemInformation(SystemHandleInformation, _
              ByVal VarPtr(Buffer(0)), ByVal RequiredLength, 0&)
        ReDim HandleInfo.Handles(NumHandles)
        CopyMemory ByVal VarPtr(HandleInfo.Handles(0)), _
            ByVal VarPtr(Buffer(4)), RequiredLength - 4
    
    Loop While Status = STATUS_INFO_LENGTH_MISMATCH
    
    If Status = STATUS_INFO_LENGTH_MISMATCH Then
        MsgBox "STATUS_INFO_LENGTH_MISMATCH"
    End If
    
    Dim MyPID As Long
    Dim MyName As String
    
    MyName = "Unknown"
    
    List1.Clear
        
    For i = 0 To NumHandles - 1
            MyPID = CLng(HandleInfo.Handles(i).UniqueProcessId)
            If Hex(HandleInfo.Handles(i).GrantedAccess) <> "12019F" And Hex(HandleInfo.Handles(i).GrantedAccess) <> "100000" And Hex(HandleInfo.Handles(i).GrantedAccess) <> "120089" Then
                MyName = GetObjectName(HandleInfo.Handles(i).UniqueProcessId, HandleInfo.Handles(i).HandleValue)
            Else
                MyName = "Skipped..."
            End If
            If InStr(1, MyName, DriveLetterToVolumeName(DriveLetter), vbTextCompare) Then
                List1.AddItem ProcessPathByPID(MyPID) & "    PID = " & HandleInfo.Handles(i).UniqueProcessId & "    Handle = 0x" & Hex(HandleInfo.Handles(i).HandleValue)
            End If
    Next i
        
    OpenPort = True

End Function


Function LoadPrivilege(ByVal Privilege As String) As Boolean

    'The access
    Dim hToken As Long
    Dim SEDebugNameValue As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim hProcessHandle As Long
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lbuffer As Long
    
    hProcessHandle = GetCurrentProcess()
    If GetLastError <> 0 Then
        MsgBox "GetCurrentProcess, Error: " & GetLastError()
        Exit Function
    End If
    
    OpenProcessToken hProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hToken
    If GetLastError <> 0 Then
        MsgBox "OpenProcessToken, Error: " & GetLastError()
        Exit Function
    End If
    
    LookupPrivilegeValue "", Privilege, SEDebugNameValue
    If GetLastError <> 0 Then
        MsgBox "LookupPrivilegeValue, Error: " & GetLastError()
        Exit Function
    End If
    
    With tkp
        .PrivilegeCount = 1
        .TheLuid = SEDebugNameValue
        .Attributes = SE_PRIVILEGE_ENABLED
    End With
    
    AdjustTokenPrivileges hToken, False, tkp, Len(tkp), tkpNewButIgnored, lbuffer
    If GetLastError <> 0 Then
        MsgBox "AdjustTokenPrivileges, Error: " & GetLastError()
        Exit Function
    End If
        
    LoadPrivilege = True

End Function


Function ProcessPathByPID(PID As Long) As String

    'Return path to the executable from PID
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;187913
    Dim cbNeeded As Long
    Dim Modules(1 To 200) As Long
    Dim Ret As Long
    Dim ModuleName As String
    Dim nSize As Long
    Dim hProcess As Long
    
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
        Or PROCESS_VM_READ, 0, PID)
                
    If hProcess <> 0 Then
                    
        Ret = EnumProcessModules(hProcess, Modules(1), _
            200, cbNeeded)
                    
        If Ret <> 0 Then
            ModuleName = Space(MAX_PATH)
            nSize = 500
            Ret = GetModuleFileNameExA(hProcess, _
                Modules(1), ModuleName, nSize)
            ProcessPathByPID = Left(ModuleName, Ret)
        End If
    End If
              
    Ret = CloseHandle(hProcess)
    
    If ProcessPathByPID = "" Then
        ProcessPathByPID = "SYSTEM"
    End If

End Function


Function GetObjectName(ProcessId As Integer, hCurrent As Integer) As String

    Dim hPort As Long, Port As Long
    Dim RequiredLength As Long
    Dim ResultLength As Long
    Dim Status As Long
    Dim hProc As Long
    Dim Ret As Long
    Dim pObjName As OBJECT_NAME_PRIVATE
    
    If ProcessId = 0 Then
        Exit Function
    End If
    
    hProc = OpenProcess(PROCESS_DUP_HANDLE, 0&, ProcessId)
    
    If hProc = INVALID_HANDLE_VALUE Then
        Exit Function
    End If
    
    Ret = DuplicateHandle(hProc, hCurrent, -1, hPort, STANDARD_RIGHTS_ALL Or GENERIC_ALL, 0&, &H2)
    
    RequiredLength = LenB(pObjName)
        
    Status = NtQueryObject(hPort, ObjectNameInformation, pObjName, RequiredLength, ResultLength)
    
    Ret = CloseHandle(hPort)
    Ret = CloseHandle(hProc)
    
    GetObjectName = Trim(pObjName.ObjName)

End Function


Private Sub CloseHandleEx(ByVal lPID As Long, ByVal lHandle As Long)

    Dim hProcess As Long
    
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, lPID)
    Call NtDuplicateObject(hProcess, lHandle, 0, ByVal 0, 0, 0, DUPLICATE_CLOSE_SOURCE)
    Call NtClose(hProcess)
    
End Sub

[pcuser]

It didn't all fit in two posts!

Private Sub Command1_Click()

    Dim i As Long, Status As Long
    Dim Ret As Long, NumHandles As Long
    Dim HandleInfo As SYSTEM_HANDLE_INFORMATION
    Dim RequiredLength As Long
    Dim Buffer() As Byte
    
    Screen.MousePointer = vbHourglass
    
    Do
        ReDim Buffer(0 To 19)
        RequiredLength = 20 'len SYSTEM_HANDLE_INFORMATION
    
        'first, find the RequiredLength for the SYSTEM_HANDLE_INFORMATION array
        Status = NtQuerySystemInformation(SystemHandleInformation, _
              ByVal VarPtr(Buffer(0)), ByVal RequiredLength, 0&)
    
        If Status = 0 Then
            Exit Do
        End If
        
        'obtain, RequiredLength
        CopyMemory ByVal VarPtr(NumHandles), ByVal VarPtr(Buffer(0)), 4
        RequiredLength = NumHandles * 16 + 4
        ReDim Buffer(0 To RequiredLength)
    
        'Native API NTDLL. Find system information
        Status = NtQuerySystemInformation(SystemHandleInformation, _
              ByVal VarPtr(Buffer(0)), ByVal RequiredLength, 0&)
    
        ReDim HandleInfo.Handles(NumHandles)
        CopyMemory ByVal VarPtr(HandleInfo.Handles(0)), _
            ByVal VarPtr(Buffer(4)), RequiredLength - 4
    
    Loop While Status = STATUS_INFO_LENGTH_MISMATCH
    
    Dim MyPID As Long
    Dim MyName As String
    
    MyName = "Unknown"
        
    For i = 0 To NumHandles - 1
            MyPID = CLng(HandleInfo.Handles(i).UniqueProcessId)
            If Hex(HandleInfo.Handles(i).GrantedAccess) <> "12019F" And Hex(HandleInfo.Handles(i).GrantedAccess) <> "100000" And Hex(HandleInfo.Handles(i).GrantedAccess) <> "120089" Then
                MyName = GetObjectName(HandleInfo.Handles(i).UniqueProcessId, HandleInfo.Handles(i).HandleValue)
            Else
                MyName = "Skipped..."
            End If
            If InStr(1, MyName, DriveLetterToVolumeName(DriveLetter), vbTextCompare) Then
                CloseHandleEx HandleInfo.Handles(i).UniqueProcessId, HandleInfo.Handles(i).HandleValue
                If StrComp(Left(ProcessPathByPID(CLng(HandleInfo.Handles(i).UniqueProcessId)), 2), DriveLetter, vbTextCompare) = 0 Then
                    ProcessTerminate CLng(HandleInfo.Handles(i).UniqueProcessId)
                End If
            End If
    Next i
    
End Sub

Private Sub Form_Activate()

    'If List1.ListCount <= 0 Then Unload Me
    
End Sub

Private Sub Form_Load()

    Dim PathBuf As String
    Dim txtBuffer As String
    Dim i As Long
    
    DriveLetter = "H:"
    
    Me.Caption = "*** ATTENTION ***"
    
    Me.Left = Screen.Width / 2 - Me.Width / 2
    Me.Top = Screen.Height / 2 - Me.Width / 2
        
    If Not Privilege Then
        'Require Admin privileges
        If Not (LoadPrivilege(SE_DEBUG_NAME)) Then
            End
        End If
    End If
    Privilege = True
    
    OpenPort
        
End Sub


Private Sub Timer1_Timer()

    OpenPort
    
    If List1.ListCount = 0 Then
        'Unload Me
    End If
    
    Screen.MousePointer = vbNormal
    
End Sub


Private Function DriveLetterToVolumeName(DriveLetter As String) As String

    Dim sBuff As String, iLen As Integer
    Const MAX_PATH As Integer = 260
    
    sBuff = String$(MAX_PATH, Chr$(0))
    iLen = QueryDosDevice(DriveLetter, sBuff, MAX_PATH)
    ' Return just the first NULL-terminated string in the return value
    sBuff = Left$(sBuff, InStr(sBuff, Chr$(0)) - 1)
    
    DriveLetterToVolumeName = sBuff & "\"
    
End Function


Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean

   Dim lhwndProcess As Long
   Dim lExitCode As Long
   Dim lRetVal As Long
   Dim lhThisProc As Long
   Dim lhTokenHandle As Long
   Dim tLuid As LUID
   Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
   Dim lBufferNeeded As Long
   
   Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINATE = &H1
   Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
   Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege"
   Const SE_PRIVILEGE_ENABLED = &H2

   On Error Resume Next
   If lHwndWindow Then
       'Get the process ID from the window handle
       lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
   End If
   
   If lProcessID Then
       'Give Kill permissions to this process
       lhThisProc = GetCurrentProcess
       
       OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
       LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
       'Set the number of privileges to be change
       tTokenPriv.PrivilegeCount = 1
       tTokenPriv.TheLuid = tLuid
       tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
       'Enable the kill privilege in the access token of this process
       AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded

       'Open the process to kill
       lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
   
       If lhwndProcess Then
           'Obtained process handle, kill the process
           ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
           Call CloseHandle(lhwndProcess)
       End If
   End If
   On Error GoTo 0
   
End Function