Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Text
Imports System.Threading
Public Class FileLocked
''' <summary>
''' Return a list of processes that hold on the given file.
''' </summary>
Public Shared Function GetProcessesLockingFile(filePath As String) As List(Of Process)
Dim procs = New List(Of Process)()
For Each process__1 In Process.GetProcesses()
Dim files = GetFilesLockedBy(process__1)
If files.Contains(filePath) Then
procs.Add(process__1)
End If
Next
Return procs
End Function
''' <summary>
''' Return a list of file locks held by the process.
''' </summary>
Public Shared Function GetFilesLockedBy(process As Process) As List(Of String)
Dim outp = New List(Of String)()
Dim ts As ThreadStart = New ThreadStart(
Sub()
Try
outp = UnsafeGetFilesLockedBy(process)
Catch
End Try
End Sub
)
Try
Dim t = New Thread(ts)
t.IsBackground = True
t.Start()
t.Join()
'If Not t.Join(250) Then
' Try
' t.Abort()
' Catch
' End Try
'End If
Catch
End Try
Return outp
End Function
#Region "Inner Workings"
Private Shared Function UnsafeGetFilesLockedBy(process As Process) As List(Of String)
Try
Dim [handles] = GetHandles(process)
Dim files = New List(Of String)()
For Each handle In [handles]
Dim file = GetFilePath(handle, process)
If file IsNot Nothing Then
files.Add(file)
End If
Next
Return files
Catch
Return New List(Of String)()
End Try
End Function
Const CNST_SYSTEM_HANDLE_INFORMATION As Integer = 16
Const STATUS_INFO_LENGTH_MISMATCH As UInteger = &HC0000004UI
Private Shared Function GetFilePath(sYSTEM_HANDLE_INFORMATION As Win32API.SYSTEM_HANDLE_INFORMATION, process As Process) As String
If sYSTEM_HANDLE_INFORMATION.GrantedAccess = &H12019F OrElse
sYSTEM_HANDLE_INFORMATION.GrantedAccess = &H1A019F OrElse
sYSTEM_HANDLE_INFORMATION.GrantedAccess = &H120189 OrElse
sYSTEM_HANDLE_INFORMATION.GrantedAccess = &H100000 Then
Return Nothing
End If
Dim m_ipProcessHwnd As IntPtr = Win32API.OpenProcess(Win32API.ProcessAccessFlags.All, False, process.Id)
Dim ipHandle As IntPtr = IntPtr.Zero
Dim objBasic = New Win32API.OBJECT_BASIC_INFORMATION()
Dim ipBasic As IntPtr = IntPtr.Zero
Dim objObjectType = New Win32API.OBJECT_TYPE_INFORMATION()
Dim ipObjectType As IntPtr = IntPtr.Zero
Dim objObjectName = New Win32API.OBJECT_NAME_INFORMATION()
Dim ipObjectName As IntPtr = IntPtr.Zero
Dim strObjectTypeName As String = ""
Dim strObjectName As String = ""
Dim nLength As Integer = 0
Dim nReturn As Integer = 0
Dim ipTemp As IntPtr = IntPtr.Zero
If Not Win32API.DuplicateHandle(m_ipProcessHwnd, sYSTEM_HANDLE_INFORMATION.Handle, Win32API.GetCurrentProcess(), ipHandle, 0, False, _
Win32API.DUPLICATE_SAME_ACCESS) Then
Return Nothing
End If
ipBasic = Marshal.AllocHGlobal(Marshal.SizeOf(objBasic))
Win32API.NtQueryObject(ipHandle, CInt(Win32API.ObjectInformationClass.ObjectBasicInformation), ipBasic, Marshal.SizeOf(objBasic), nLength)
objBasic = DirectCast(Marshal.PtrToStructure(ipBasic, objBasic.[GetType]()), Win32API.OBJECT_BASIC_INFORMATION)
Marshal.FreeHGlobal(ipBasic)
ipObjectType = Marshal.AllocHGlobal(objBasic.TypeInformationLength)
nLength = objBasic.TypeInformationLength
While CUInt(InlineAssignHelper(nReturn, Win32API.NtQueryObject(ipHandle, CInt(Win32API.ObjectInformationClass.ObjectTypeInformation), ipObjectType, nLength, nLength))) = Win32API.STATUS_INFO_LENGTH_MISMATCH
Marshal.FreeHGlobal(ipObjectType)
ipObjectType = Marshal.AllocHGlobal(nLength)
End While
objObjectType = DirectCast(Marshal.PtrToStructure(ipObjectType, objObjectType.[GetType]()), Win32API.OBJECT_TYPE_INFORMATION)
If Is64Bits() Then
ipTemp = New IntPtr(Convert.ToInt64(objObjectType.Name.Buffer.ToString(), 10) >> 32)
Else
ipTemp = objObjectType.Name.Buffer
End If
strObjectTypeName = Marshal.PtrToStringUni(ipTemp, objObjectType.Name.Length >> 1)
Marshal.FreeHGlobal(ipObjectType)
If strObjectTypeName <> "File" Then
Return Nothing
End If
'nLength = objBasic.NameInformationLength
nLength = &H1000
ipObjectName = Marshal.AllocHGlobal(nLength)
While CUInt(InlineAssignHelper(nReturn, Win32API.NtQueryObject(ipHandle, CInt(Win32API.ObjectInformationClass.ObjectNameInformation), ipObjectName, nLength, nLength))) = Win32API.STATUS_INFO_LENGTH_MISMATCH
Marshal.FreeHGlobal(ipObjectName)
ipObjectName = Marshal.AllocHGlobal(nLength)
End While
objObjectName = DirectCast(Marshal.PtrToStructure(ipObjectName, objObjectName.[GetType]()), Win32API.OBJECT_NAME_INFORMATION)
If Is64Bits() Then
ipTemp = New IntPtr(Convert.ToInt64(objObjectName.Name.Buffer.ToString(), 10) >> 32)
Else
ipTemp = objObjectName.Name.Buffer
End If
If ipTemp <> IntPtr.Zero Then
Dim baTemp As Byte() = New Byte(nLength - 1) {}
Try
Marshal.Copy(ipTemp, baTemp, 0, nLength)
strObjectName = Marshal.PtrToStringUni(If(Is64Bits(), New IntPtr(ipTemp.ToInt64()), New IntPtr(ipTemp.ToInt32())))
Catch generatedExceptionName As AccessViolationException
Return Nothing
Finally
Marshal.FreeHGlobal(ipObjectName)
Win32API.CloseHandle(ipHandle)
End Try
End If
Dim path As String = GetRegularFileNameFromDevice(strObjectName)
Try
Return path
Catch
Return Nothing
End Try
End Function
Private Shared Function GetRegularFileNameFromDevice(strRawName As String) As String
Dim strFileName As String = strRawName
For Each strDrivePath As String In Environment.GetLogicalDrives()
Dim sbTargetPath As New StringBuilder(Win32API.MAX_PATH)
If Win32API.QueryDosDevice(strDrivePath.Substring(0, 2), sbTargetPath, Win32API.MAX_PATH) = 0 Then
Return strRawName
End If
Dim strTargetPath As String = sbTargetPath.ToString()
If strFileName.StartsWith(strTargetPath) Then
strFileName = strFileName.Replace(strTargetPath, strDrivePath.Substring(0, 2))
Exit For
End If
Next
Return strFileName
End Function
Private Shared Function GetHandles(process As Process) As List(Of Win32API.SYSTEM_HANDLE_INFORMATION)
Dim nStatus As UInteger
Dim nHandleInfoSize As Integer = &H10000
Dim ipHandlePointer As IntPtr = Marshal.AllocHGlobal(nHandleInfoSize)
Dim nLength As Integer = 0
Dim ipHandle As IntPtr = IntPtr.Zero
While (InlineAssignHelper(nStatus, Win32API.NtQuerySystemInformation(CNST_SYSTEM_HANDLE_INFORMATION, ipHandlePointer, nHandleInfoSize, nLength))) = STATUS_INFO_LENGTH_MISMATCH
nHandleInfoSize = nLength
Marshal.FreeHGlobal(ipHandlePointer)
ipHandlePointer = Marshal.AllocHGlobal(nLength)
End While
Dim baTemp As Byte() = New Byte(nLength - 1) {}
Marshal.Copy(ipHandlePointer, baTemp, 0, nLength)
Dim lHandleCount As Long = 0
If Is64Bits() Then
lHandleCount = Marshal.ReadInt64(ipHandlePointer)
ipHandle = New IntPtr(ipHandlePointer.ToInt64() + 8)
Else
lHandleCount = Marshal.ReadInt32(ipHandlePointer)
ipHandle = New IntPtr(ipHandlePointer.ToInt32() + 4)
End If
Dim shHandle As Win32API.SYSTEM_HANDLE_INFORMATION
Dim lstHandles As New List(Of Win32API.SYSTEM_HANDLE_INFORMATION)()
For lIndex As Long = 0 To lHandleCount - 1
shHandle = New Win32API.SYSTEM_HANDLE_INFORMATION()
If Is64Bits() Then
shHandle = DirectCast(Marshal.PtrToStructure(ipHandle, shHandle.[GetType]()), Win32API.SYSTEM_HANDLE_INFORMATION)
ipHandle = New IntPtr(ipHandle.ToInt64() + Marshal.SizeOf(shHandle) + 8)
Else
ipHandle = New IntPtr(ipHandle.ToInt64() + Marshal.SizeOf(shHandle))
shHandle = DirectCast(Marshal.PtrToStructure(ipHandle, shHandle.[GetType]()), Win32API.SYSTEM_HANDLE_INFORMATION)
End If
If shHandle.ProcessID <> process.Id Then
Continue For
End If
lstHandles.Add(shHandle)
Next
Return lstHandles
End Function
Private Shared Function Is64Bits() As Boolean
Return If(Marshal.SizeOf(GetType(IntPtr)) = 8, True, False)
End Function
Friend Class Win32API
<DllImport("ntdll.dll")> _
Public Shared Function NtQueryObject(ObjectHandle As IntPtr, ObjectInformationClass As Integer, ObjectInformation As IntPtr, ObjectInformationLength As Integer, ByRef returnLength As Integer) As Integer
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Public Shared Function QueryDosDevice(lpDeviceName As String, lpTargetPath As StringBuilder, ucchMax As Integer) As UInteger
End Function
<DllImport("ntdll.dll")> _
Public Shared Function NtQuerySystemInformation(SystemInformationClass As Integer, SystemInformation As IntPtr, SystemInformationLength As Integer, ByRef returnLength As Integer) As UInteger
End Function
<DllImport("kernel32.dll")> _
Public Shared Function OpenProcess(dwDesiredAccess As ProcessAccessFlags, <MarshalAs(UnmanagedType.Bool)> bInheritHandle As Boolean, dwProcessId As Integer) As IntPtr
End Function
<DllImport("kernel32.dll")> _
Public Shared Function CloseHandle(hObject As IntPtr) As Integer
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Public Shared Function DuplicateHandle(hSourceProcessHandle As IntPtr, hSourceHandle As UShort, hTargetProcessHandle As IntPtr, ByRef lpTargetHandle As IntPtr, dwDesiredAccess As UInteger, <MarshalAs(UnmanagedType.Bool)> bInheritHandle As Boolean, _
dwOptions As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("kernel32.dll")> _
Public Shared Function GetCurrentProcess() As IntPtr
End Function
Public Enum ObjectInformationClass As Integer
ObjectBasicInformation = 0
ObjectNameInformation = 1
ObjectTypeInformation = 2
ObjectAllTypesInformation = 3
ObjectHandleInformation = 4
End Enum
<Flags()> _
Public Enum ProcessAccessFlags As UInteger
All = &H1F0FFF
Terminate = &H1
CreateThread = &H2
VMOperation = &H8
VMRead = &H10
VMWrite = &H20
DupHandle = &H40
SetInformation = &H200
QueryInformation = &H400
Synchronize = &H100000
End Enum
<StructLayout(LayoutKind.Sequential)> _
Public Structure OBJECT_BASIC_INFORMATION
' Information Class 0
Public Attributes As Integer
Public GrantedAccess As Integer
Public HandleCount As Integer
Public PointerCount As Integer
Public PagedPoolUsage As Integer
Public NonPagedPoolUsage As Integer
Public Reserved1 As Integer
Public Reserved2 As Integer
Public Reserved3 As Integer
Public NameInformationLength As Integer
Public TypeInformationLength As Integer
Public SecurityDescriptorLength As Integer
Public CreateTime As System.Runtime.InteropServices.ComTypes.FILETIME
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure OBJECT_TYPE_INFORMATION
' Information Class 2
Public Name As UNICODE_STRING
Public ObjectCount As Integer
Public HandleCount As Integer
Public Reserved1 As Integer
Public Reserved2 As Integer
Public Reserved3 As Integer
Public Reserved4 As Integer
Public PeakObjectCount As Integer
Public PeakHandleCount As Integer
Public Reserved5 As Integer
Public Reserved6 As Integer
Public Reserved7 As Integer
Public Reserved8 As Integer
Public InvalidAttributes As Integer
Public GenericMapping As GENERIC_MAPPING
Public ValidAccess As Integer
Public Unknown As Byte
Public MaintainHandleDatabase As Byte
Public PoolType As Integer
Public PagedPoolUsage As Integer
Public NonPagedPoolUsage As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure OBJECT_NAME_INFORMATION
' Information Class 1
Public Name As UNICODE_STRING
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Public Structure UNICODE_STRING
Public Length As UShort
Public MaximumLength As UShort
Public Buffer As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure GENERIC_MAPPING
Public GenericRead As Integer
Public GenericWrite As Integer
Public GenericExecute As Integer
Public GenericAll As Integer
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Public Structure SYSTEM_HANDLE_INFORMATION
' Information Class 16
Public ProcessID As Integer
Public ObjectTypeNumber As Byte
Public Flags As Byte
' 0x01 = PROTECT_FROM_CLOSE, 0x02 = INHERIT
Public Handle As UShort
Public Object_Pointer As Integer
Public GrantedAccess As UInt32
End Structure
Public Const MAX_PATH As Integer = 260
Public Const STATUS_INFO_LENGTH_MISMATCH As UInteger = &HC0000004UI
Public Const DUPLICATE_SAME_ACCESS As Integer = &H2
End Class
Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
#End Region
End Class