VB.NET wrappers for much of the Windows API

Imports System
Imports System.Collections.Generic
Imports System.Diagnostics
Imports System.IO
Imports System.Runtime.CompilerServices
Imports System.Runtime.ConstrainedExecution
Imports System.Runtime.InteropServices
Imports System.Security.Permissions
Imports System.Text
Imports System.Threading
Imports Microsoft.Win32.SafeHandles

Public Class OpenedFiles

    Public Const PROCESS_DUP_HANDLE As Integer = &H40

    Public Class FileDetail
        Public ProcessId As Integer
        Public FileHandle As IntPtr
        Public FileName As String
    End Class

    Protected Enum NT_STATUS
        STATUS_SUCCESS = &H0
        STATUS_BUFFER_OVERFLOW = &H80000005
        STATUS_INFO_LENGTH_MISMATCH = &HC0000004
    End Enum

    Protected Enum SYSTEM_INFORMATION_CLASS
        SystemBasicInformation = 0
        SystemPerformanceInformation = 2
        SystemTimeOfDayInformation = 3
        SystemProcessInformation = 5
        SystemProcessorPerformanceInformation = 8
        SystemHandleInformation = 16
        SystemInterruptInformation = 23
        SystemExceptionInformation = 33
        SystemRegistryQuotaInformation = 37
        SystemLookasideInformation = 45
    End Enum

    Protected Enum OBJECT_INFORMATION_CLASS
        ObjectBasicInformation = 0
        ObjectNameInformation = 1
        ObjectTypeInformation = 2
        ObjectAllTypesInformation = 3
        ObjectHandleInformation = 4
    End Enum

    <Flags()> _
    Protected Enum ProcessAccessRights
        PROCESS_DUP_HANDLE = &H40
    End Enum

    <Flags()> _
    Protected Enum DuplicateHandleOptions
        DUPLICATE_CLOSE_SOURCE = &H1
        DUPLICATE_SAME_ACCESS = &H2
    End Enum

    <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 SYSTEM_HANDLE_ENTRY
        Public OwnerPid As Integer
        Public ObjectType As Byte
        Public HandleFlags As Byte
        Public HandleValue As Short
        Public ObjectPointer As Integer
        Public AccessMask As Integer
    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)> _
    Public Structure OBJECT_NAME_INFORMATION
        Public Name As UNICODE_STRING
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure OBJECT_BASIC_INFORMATION
        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 ComTypes.FILETIME
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure OBJECT_TYPE_INFORMATION
        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


    <SecurityPermission(SecurityAction.LinkDemand, UnmanagedCode:=True)> _
    Protected Class SafeObjectHandle
        Inherits SafeHandleZeroOrMinusOneIsInvalid

        Private Sub New()
            MyBase.New(True)
        End Sub

        Protected Overrides Function ReleaseHandle() As Boolean
            Return NativeMethods.CloseHandle(MyBase.handle)
        End Function

        Protected Sub New(ByVal preexistingHandle As IntPtr, ByVal ownsHandle As Boolean)
            MyBase.New(ownsHandle)
            MyBase.SetHandle(preexistingHandle)
        End Sub
    End Class

    <SecurityPermission(SecurityAction.LinkDemand, UnmanagedCode:=True)> _
    Protected Class SafeProcessHandle
        Inherits SafeHandleZeroOrMinusOneIsInvalid

        Private Sub New()
            MyBase.New(True)
        End Sub

        Protected Overrides Function ReleaseHandle() As Boolean
            Return NativeMethods.CloseHandle(MyBase.handle)
        End Function

        Public Sub New(ByVal preexistingHandle As IntPtr, ByVal ownsHandle As Boolean)
            MyBase.New(ownsHandle)
            MyBase.SetHandle(preexistingHandle)
        End Sub
    End Class


    Protected Class NativeMethods

        <DllImport("ntdll.dll", SetLastError:=True)> _
        Public Shared Function NtQuerySystemInformation( _
                <[In]()> ByVal SystemInformationClass As SYSTEM_INFORMATION_CLASS, _
                <[In]()> ByVal SystemInformation As IntPtr, _
                <[In]()> ByVal SystemInformationLength As Integer, _
                <Out()> ByRef ReturnLength As Integer _
            ) As NT_STATUS
        End Function

        <DllImport("ntdll.dll", SetLastError:=True)> _
        Public Shared Function NtQueryObject( _
                <[In]()> ByVal Handle As IntPtr, _
                <[In]()> ByVal ObjectInformationClass As OBJECT_INFORMATION_CLASS, _
                <[In]()> ByVal ObjectInformation As IntPtr, _
                <[In]()> ByVal ObjectInformationLength As Integer, _
                <Out()> ByRef ReturnLength As Integer _
            ) As NT_STATUS
        End Function

        <DllImport("ntdll.dll", SetLastError:=True)> _
        Public Shared Function NtQueryObject2( _
                <[In]()> ByVal Handle As IntPtr, _
                <[In]()> ByVal ObjectInformationClass As OBJECT_INFORMATION_CLASS, _
                <[In]()> ByVal ObjectInformation As IntPtr, _
                <[In]()> ByVal ObjectInformationLength As Integer, _
                <Out()> ByRef ReturnLength As Integer _
            ) As SafeProcessHandle
        End Function

        <DllImport("kernel32.dll", SetLastError:=True, EntryPoint:="RtlZeroMemory")> _
        Public Shared Sub ZeroMemory( _
                <[In]()> ByVal Destination As IntPtr, _
                <[In]()> ByVal length As Integer _
            )
        End Sub

        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function OpenProcess( _
                ByVal dwDesiredAccess As ProcessAccessRights, _
                ByVal bInheritHandle As Integer, _
                ByVal dwProcessId As Integer _
            ) As Integer
        End Function

        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function DuplicateHandle( _
                <[In]()> ByVal hSourceProcessHandle As Integer, _
                <[In]()> ByVal hSourceHandle As Integer, _
                <[In]()> ByVal hTargetProcessHandle As Integer, _
                <Out()> ByRef lpTargetHandle As Integer, _
                <[In]()> ByVal dwDesiredAccess As Integer, _
                <[In]()> ByVal bInheritHandle As Integer, _
                <[In]()> ByVal dwOptions As Integer _
            ) As Boolean
        End Function

        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function GetCurrentProcess() As Integer
        End Function

        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function GetProcessId(ByVal process As IntPtr) As Integer
        End Function

        <ReliabilityContract(Consistency.WillNotCorruptState, Cer.Success)> _
        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function CloseHandle(ByVal hObject As IntPtr) As Boolean
        End Function

        <ReliabilityContract(Consistency.WillNotCorruptState, Cer.Success)> _
        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function CloseHandle(ByVal hObject As Integer) As Boolean
        End Function

        <ReliabilityContract(Consistency.WillNotCorruptState, Cer.Success)> _
        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function CloseHandle(ByVal hObject As SafeProcessHandle) As Boolean
        End Function

        <DllImport("kernel32.dll", SetLastError:=True)> _
        Public Shared Function QueryDosDevice( _
                ByVal lpDeviceName As String, _
                ByVal lpTargetPath As StringBuilder, _
                ByVal ucchMax As Integer _
            ) As Integer
        End Function

    End Class

    Protected Enum SystemHandleType
        OB_TYPE_UNKNOWN = 0
        OB_TYPE_TYPE = 1
        OB_TYPE_DIRECTORY
        OB_TYPE_SYMBOLIC_LINK
        OB_TYPE_TOKEN
        OB_TYPE_PROCESS
        OB_TYPE_THREAD
        OB_TYPE_UNKNOWN_7
        OB_TYPE_EVENT
        OB_TYPE_EVENT_PAIR
        OB_TYPE_MUTANT
        OB_TYPE_UNKNOWN_11
        OB_TYPE_SEMAPHORE
        OB_TYPE_TIMER
        OB_TYPE_PROFILE
        OB_TYPE_WINDOW_STATION
        OB_TYPE_DESKTOP
        OB_TYPE_SECTION
        OB_TYPE_KEY
        OB_TYPE_PORT
        OB_TYPE_WAITABLE_PORT
        OB_TYPE_UNKNOWN_21
        OB_TYPE_UNKNOWN_22
        OB_TYPE_UNKNOWN_23
        OB_TYPE_UNKNOWN_24
        OB_TYPE_IO_COMPLETION
        OB_TYPE_FILE
        'OB_TYPE_CONTROLLER
        'OB_TYPE_DEVICE
        'OB_TYPE_DRIVER
    End Enum

    Public Shared Function GetOpenHandles() As SYSTEM_HANDLE_ENTRY()
        Dim entries() As SYSTEM_HANDLE_ENTRY = Nothing
        Dim ptr As IntPtr = IntPtr.Zero

        Try
            RuntimeHelpers.PrepareConstrainedRegions()

            Dim ret As NT_STATUS
            Dim length As Integer = &H100
            Dim returnLength As Integer
            ptr = Marshal.AllocHGlobal(length)
            ret = NativeMethods.NtQuerySystemInformation(SYSTEM_INFORMATION_CLASS.SystemHandleInformation, ptr, length, returnLength)

            'verify length is good
            Do While (ret = NT_STATUS.STATUS_INFO_LENGTH_MISMATCH)
                length = length + 64000
                Marshal.FreeHGlobal(ptr)
                ptr = Marshal.AllocHGlobal(length)
                ret = NativeMethods.NtQuerySystemInformation(SYSTEM_INFORMATION_CLASS.SystemHandleInformation, ptr, length, returnLength)
            Loop

            If ret = NT_STATUS.STATUS_SUCCESS Then
                Dim handleCount As Integer = Marshal.ReadInt32(ptr)
                Dim offset As Integer = Marshal.SizeOf(GetType(System.Int32))
                Dim size As Integer = Marshal.SizeOf(GetType(SYSTEM_HANDLE_ENTRY))

                ReDim entries(handleCount - 1)

                Dim i As Integer = 0
                For i = 0 To handleCount - 1
                    Dim handleEntry As SYSTEM_HANDLE_ENTRY
                    handleEntry = CType(Marshal.PtrToStructure(New IntPtr(ptr.ToInt32() + offset), GetType(SYSTEM_HANDLE_ENTRY)), SYSTEM_HANDLE_ENTRY)

                    entries(i) = handleEntry

                    offset += size
                Next
            End If
        Finally
            Marshal.FreeHGlobal(ptr)
        End Try

        Return entries
    End Function

    Public Shared Function GetOpenFileHandles() As List(Of FileDetail)

        Dim objectTypeNumber As Integer = OpenedFiles.GetObjectTypeNumber("File")

        GetOpenFileHandles = New List(Of FileDetail)

        Dim entries() As SYSTEM_HANDLE_ENTRY = OpenedFiles.GetOpenHandles()
        For Each entry As SYSTEM_HANDLE_ENTRY In entries
            If entry.ObjectType = objectTypeNumber Then ' And entry.OwnerPid = 2028 Then
                Dim d As FileDetail
                d = RetrieveObjectThreaded(entry)
                If Not String.IsNullOrEmpty(d.FileName) Then
                    GetOpenFileHandles.Add(d)
                End If
            End If
        Next
    End Function

    Private Shared Function GetObjectTypeNumber(ByVal typeName As String) As Integer
        Dim buffObjTypes As IntPtr = IntPtr.Zero
        Dim cbReqLength As Integer = 0
        Dim cTypeCount As Integer = 0
        Dim x As Integer = 0
        Dim lpTypeInfo As IntPtr = IntPtr.Zero
        Dim typeInfo As New OBJECT_TYPE_INFORMATION()
        Dim strType As String = ""
        If Utilities.IsVista() Then
            Dim b As IntPtr = Marshal.AllocHGlobal(4)
            NativeMethods.NtQueryObject(IntPtr.Zero, OBJECT_INFORMATION_CLASS.ObjectAllTypesInformation, b, 4, cbReqLength)
            Marshal.FreeHGlobal(b)
        Else
            NativeMethods.NtQueryObject(IntPtr.Zero, OBJECT_INFORMATION_CLASS.ObjectAllTypesInformation, IntPtr.Zero, 0, cbReqLength)
        End If

        buffObjTypes = Marshal.AllocHGlobal(cbReqLength)
        NativeMethods.NtQueryObject(IntPtr.Zero, OBJECT_INFORMATION_CLASS.ObjectAllTypesInformation, buffObjTypes, cbReqLength, cbReqLength)
        cTypeCount = Marshal.ReadInt32(buffObjTypes, 0)
        lpTypeInfo = New IntPtr(buffObjTypes.ToInt32() + 4)

        For x = 0 To cTypeCount - 1
            typeInfo = CType(Marshal.PtrToStructure(lpTypeInfo, typeInfo.GetType()), OBJECT_TYPE_INFORMATION)
            strType = Marshal.PtrToStringUni(typeInfo.Name.Buffer, typeInfo.Name.Length >> 1)
            If (typeName.Equals(strType)) Then
                Return x + 1
            End If

            lpTypeInfo = New IntPtr(lpTypeInfo.ToInt32() + 96 + typeInfo.Name.MaximumLength)
            lpTypeInfo = New IntPtr(lpTypeInfo.ToInt32() + (lpTypeInfo.ToInt32() Mod 4))
        Next

        Marshal.FreeHGlobal(buffObjTypes)

        If (typeName.Equals("Driver")) Then
            Return 24
        ElseIf (typeName.Equals("IoCompletion")) Then
            Return 25
        ElseIf (typeName.Equals("File")) Then
            Return 26
        End If
        Return 0
    End Function

    Public Shared Function RetrieveObjectThreaded(ByVal Handle As SYSTEM_HANDLE_ENTRY) As FileDetail
        Dim del As New DelegateRetrieveObject(AddressOf RetrieveObject)
        Dim iar As IAsyncResult
        iar = del.BeginInvoke(Handle, Nothing, Nothing)
        iar.AsyncWaitHandle.WaitOne(100, False)
        If iar.IsCompleted Then
            Return del.EndInvoke(iar)
        Else
            Return New FileDetail()
        End If
    End Function

    Public Delegate Function DelegateRetrieveObject(ByVal Handle As SYSTEM_HANDLE_ENTRY) As FileDetail

    Public Shared Function RetrieveObject(ByVal Handle As SYSTEM_HANDLE_ENTRY) As FileDetail
        Dim detail As New FileDetail()
        Dim length As Integer = 0
        Dim retv As Integer = 0
        Dim ret2 As Integer = 0
        Dim hHandle As Integer = 0

        Dim ObjBasic As New OBJECT_BASIC_INFORMATION()
        Dim ObjName As New OBJECT_NAME_INFORMATION()

        Dim m_ObjectTypeName As String
        Dim m_ObjectName As String
        Dim BufferObjName As IntPtr = IntPtr.Zero
        Dim BufferObjBasic As IntPtr = IntPtr.Zero

        Try
            OpenProcessForHandle(Handle.OwnerPid)

            NativeMethods.DuplicateHandle(m_hProcess, Handle.HandleValue, NativeMethods.GetCurrentProcess(), hHandle, 0, 0, DuplicateHandleOptions.DUPLICATE_SAME_ACCESS)
            If hHandle = 0 Then
                Return detail
            End If

            BufferObjBasic = Marshal.AllocHGlobal(Marshal.SizeOf(ObjBasic))
            ret2 = NativeMethods.NtQueryObject(New IntPtr(hHandle), OBJECT_INFORMATION_CLASS.ObjectBasicInformation, BufferObjBasic, Marshal.SizeOf(ObjBasic), retv)
            ObjBasic = CType(Marshal.PtrToStructure(BufferObjBasic, ObjBasic.GetType()), OBJECT_BASIC_INFORMATION)

            m_ObjectTypeName = "File"
            If ObjBasic.NameInformationLength = 0 Then
                length = 512
            Else
                length = ObjBasic.NameInformationLength + 2
            End If

            BufferObjName = Marshal.AllocCoTaskMem(length)
            NativeMethods.ZeroMemory(BufferObjName, length)
            ret2 = NativeMethods.NtQueryObject(New IntPtr(hHandle), OBJECT_INFORMATION_CLASS.ObjectNameInformation, BufferObjName, length, retv)
            ObjName = CType(Marshal.PtrToStructure(BufferObjName, ObjName.GetType()), OBJECT_NAME_INFORMATION)
            m_ObjectName = Marshal.PtrToStringUni(New IntPtr(BufferObjName.ToInt32() + 8))

            m_ObjectName = GetRegularFileNameFromDevice(m_ObjectName)

            'return FileDetail object
            detail.FileHandle = New IntPtr(Handle.HandleValue)
            detail.ProcessId = Handle.OwnerPid
            detail.FileName = m_ObjectName

            Return detail
        Finally
            Marshal.FreeHGlobal(BufferObjBasic)
            Marshal.FreeCoTaskMem(BufferObjName)
            NativeMethods.CloseHandle(hHandle)
        End Try
    End Function

    Private Shared m_lastPID As Integer
    Private Shared m_hProcess As Integer
    Public Shared Sub OpenProcessForHandle(ByVal ProcessID As Integer)
        If ProcessID <> m_lastPID Then
            NativeMethods.CloseHandle(m_hProcess)
            m_hProcess = NativeMethods.OpenProcess(ProcessAccessRights.PROCESS_DUP_HANDLE, 0, ProcessID)
            m_lastPID = ProcessID
        End If
    End Sub

    Public Shared Function GetRegularFileNameFromDevice(ByVal rawName As String) As String
        Dim filename As String = rawName

        For Each drivePath As String In Environment.GetLogicalDrives()
            Dim drive As String = drivePath.Substring(0, 2)
            Dim lpTargetPath As StringBuilder = New StringBuilder(260)

            If NativeMethods.QueryDosDevice(drive, lpTargetPath, 260) = 0 Then
                Return rawName
            End If

            Dim targetPath As String = lpTargetPath.ToString()

            If (filename.StartsWith(targetPath)) Then
                filename = filename.Replace(targetPath, drive)
                Return filename
            End If
        Next
        Return ""
    End Function

    Private Shared Function GetFileNameFromHandle(ByVal handle As IntPtr) As String
        Dim ptr As IntPtr = IntPtr.Zero
        Dim length As Integer = &H200

        Dim filename As String = ""

        Try
            RuntimeHelpers.PrepareConstrainedRegions()
            ptr = Marshal.AllocHGlobal(length)

            Dim ret As NT_STATUS
            ret = NativeMethods.NtQueryObject(handle, OBJECT_INFORMATION_CLASS.ObjectNameInformation, ptr, length, length)

            'verify length is good
            Do While (ret = NT_STATUS.STATUS_BUFFER_OVERFLOW)
                length = length + 64000
                Marshal.FreeHGlobal(ptr)
                ptr = Marshal.AllocHGlobal(length)
                ret = NativeMethods.NtQueryObject(handle, OBJECT_INFORMATION_CLASS.ObjectNameInformation, ptr, length, length)
            Loop

            If ret = NT_STATUS.STATUS_SUCCESS Then
                filename = Marshal.PtrToStringUni(New IntPtr((ptr.ToInt32() + 8)), CInt((length - 9) / 2))
            End If
        Finally
            Marshal.FreeHGlobal(ptr)
        End Try
        Return filename
    End Function

End Class