PDA

Click to See Complete Forum and Search --> : Find and close all open handles to a drive

pcuser
Mar 12th, 2009, 09:22 PM
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 :rolleyes:


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
' luprixnet@hotmail.com
'/////////////////////////////////////////////////////////////////////////


'///////////////////////////// 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
Mar 12th, 2009, 09:25 PM
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
Mar 12th, 2009, 09:26 PM
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