Feedback

VB - Ermitteln des Prozesses der eine Datei gesperrt hat bzw. geöffnet

Veröffentlicht von am 28.10.2015
(0 Bewertungen)
Oftmals gibt es das Problem das man nicht auf bestimmte Dateien zugreifen, ändern, öffnen oder löschen kann weil eine andere Anwendung diese Datei bereits geöffnet hat. Mit diesem VB.Net Snippet ist es möglich den Täter ausfindig zu mach.

Um diese Classe dann anzuwenden ist hier ein kleines Beispiel:

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Try
Dim handleList As New System.Collections.Generic.List(Of Process)
handleList = FileLocked.GetProcessesLockingFile("DateiPfad")
For Each t In handleList
MsgBox(t.ProcessName)
Next
Catch ex As Exception

End Try
End Sub
GFU-Schulungen  [Anzeige]

C# Grundlagen

Die Schulung vermittelt Ihnen die Grundlagen von C# in der Arbeit mit Datentypen sowie bei Klassenbibliotheken. Sie lernen, mit Variablen umzugehen und deren verschiedene Formen zu konvertieren. 

Visual Studio Team Foundation Server 2017/2015 (TFS) für Administratoren - Kompakt

Nach dieser Schulung beherrschen Sie die Grundlagen des TFS. Sie erledigen administrative Aufgaben schnell und sicher.


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

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!