i use below code to get list of opened files in proccess this code works fine but sometime this code get duplicate file name in current proccess.for example if a video file abc.mpg open in media player and a def.mpg file opened in km player if i close abc.mpg file this code still show the abc.mpg file is runing.
here is my code
Private Const DUPLICATE_SAME_ACCESS As Long = &H2
Private Const DUPLICATE_CLOSE_SOURCE As Long = &H1
Private Const STATUS_INFO_LENGTH_MISMATCH As Long = &HC0000004
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const FILE_MAP_READ As Long = &H4
Private Const PAGE_READONLY As Long = &H2
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const SE_PRIVILEGE_NAME As String = "SeDebugPrivilege"
Private Const TOKEN_QUERY As Long = &H8
Private Const SystemHandleInformation As Long = &H10
Private Type SYSTEM_HANDLE_INFORMATION
ProcessID As Long
ObjectTypeNumber As Byte
Flags As Byte
Handle As Integer
Object_Pointer As Long
GrantedAccess As Long
End Type
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
LuidUDT As LUID
Attributes As Long
End Type
Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
Private Declare Function HeapDestroy Lib "kernel32.dll" (ByVal hHeap As Long) As Long
Private Declare Function NtQuerySystemInformation Lib "ntdll.dll" (ByVal SystemInformationClass As Long, ByVal pSystemInformation As Long, ByVal SystemInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function DuplicateHandle Lib "kernel32.dll" (ByVal hSourceProcessHandle As Long, ByVal hSourceHandle As Long, ByVal hTargetProcessHandle As Long, ByRef lpTargetHandle As Long, ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwOptions As Long) 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 CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateFileMappingW Lib "kernel32" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function GetMappedFileNameW Lib "Psapi.dll" (ByVal hProcess As Long, ByVal lpv As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (ByVal lpBaseAddress As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValueA Lib "advapi32" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Any) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub RtlZeroMemory Lib "kernel32.dll" (Destination As Any, ByVal Length As Long)
Private Declare Function GetModuleFileNameExW Lib "Psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
Dim HandleInfo() As SYSTEM_HANDLE_INFORMATION
Dim m_cHandles As Long
Dim hProcess As Long
Dim hHandle As Long
Dim szName As String
Dim szAppName As String
Public Sub QueryHandlesBuffer()
Dim lpBufferHandles As Long
Dim Length As Long
Dim ret As Long
Dim n As Long
Length = &H100
lpBufferHandles = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Length)
If lpBufferHandles = 0 Then
Exit Sub
End If
While (NtQuerySystemInformation(SystemHandleInformation, lpBufferHandles, Length, ret) = STATUS_INFO_LENGTH_MISMATCH)
Length = Length * 2
HeapFree GetProcessHeap, 0, lpBufferHandles
lpBufferHandles = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Length)
Wend
If lpBufferHandles = 0 Then
Exit Sub
End If
m_cHandles = ReadLong(lpBufferHandles)
ReDim HandleInfo(m_cHandles) As SYSTEM_HANDLE_INFORMATION
RtlZeroMemory HandleInfo(0), LenB(HandleInfo(0)) * m_cHandles
RtlMoveMemory HandleInfo(0), ByVal lpBufferHandles + 4, LenB(HandleInfo(0)) * m_cHandles
HeapFree GetProcessHeap, 0, lpBufferHandles
For n = 0 To m_cHandles - 1
If HandleInfo(n).ObjectTypeNumber = 28 Then
OpenProcessForHandle HandleInfo(n).ProcessID
DuplicateHandle hProcess, HandleInfo(n).Handle, GetCurrentProcess, hHandle, 0, 0, DUPLICATE_SAME_ACCESS
If hHandle <> 0 Then
szName = GetObjectName(hHandle)
szAppName = GetProcessName(hProcess)
If LenB(szName) > 0 Then
If InStr(1, szName, ".tax", vbTextCompare) > 0 Then
List1.AddItem "hProcess = " & hProcess
List1.AddItem "File = " & szName
List1.AddItem "Process = " & szAppName
List1.AddItem "handle= " & HandleInfo(n).Handle
List1.AddItem HandleInfo(n).ProcessID
End If
End If
CloseHandle hHandle
End If
End If
Next n
End Sub
Private Function GetObjectName(ByVal dwHandle As Long) As String
Dim hFileMap As Long
Dim pMem As Long
Dim cbLength As Long
Dim bName(8192) As Byte
hFileMap = CreateFileMappingW(dwHandle, 0, PAGE_READONLY, 0, 1, 0)
If hFileMap = 0 Then
Exit Function
End If
pMem = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 1)
If pMem = 0 Then
CloseHandle hFileMap
Exit Function
End If
cbLength = GetMappedFileNameW(GetCurrentProcess, pMem, VarPtr(bName(0)), 8192)
If cbLength <> 0 Then
GetObjectName = Left$(bName, cbLength)
Else
GetObjectName = vbNullString
End If
CloseHandle hFileMap
UnmapViewOfFile pMem
Erase bName
End Function
Private Function GetProcessName(ByVal dwProcess As Long) As String
Dim bProcess(8192) As Byte
Dim cbLength As Long
cbLength = GetModuleFileNameExW(dwProcess, 0, VarPtr(bProcess(0)), 8192)
If cbLength <> 0 Then
GetProcessName = Left$(bProcess, cbLength)
Else
GetProcessName = vbNullString
End If
Erase bProcess
End Function
Private Sub OpenProcessForHandle(ByVal ProcessID As Long)
Dim LastPID As Long
If ProcessID <> LastPID Then
CloseHandle hProcess
hProcess = OpenProcess( _
PROCESS_ALL_ACCESS, _
0, _
ProcessID)
LastPID = ProcessID
End If
End Sub
Public Sub SeDebugPrivilege()
Dim Success As Long
Dim hToken As Long
Dim TokenPriv As TOKEN_PRIVILEGES
Success = OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
Success = LookupPrivilegeValueA(vbNullString, SE_PRIVILEGE_NAME, TokenPriv.LuidUDT)
TokenPriv.PrivilegeCount = 1
TokenPriv.Attributes = SE_PRIVILEGE_ENABLED
Success = AdjustTokenPrivileges(hToken, 0, TokenPriv, 0, ByVal 0&, ByVal 0&)
CloseHandle hToken
End Sub
Private Function ReadLong(ByVal Ptr As Long) As Long
Dim Bogus As Long
RtlMoveMemory Bogus, ByVal Ptr, 4
ReadLong = Bogus
End Function
Please help me.
[edit]Added code blocks[/edit]