vb6中正在处理的重复文件名 [英] duplicate filename in process in vb6

问题描述

我使用下面的代码获取过程中打开的文件的列表，此代码可以正常工作，但有时此代码在当前过程中获得重复的文件名.例如，如果在媒体播放器中打开了视频文件abc.mpg和def.mpg文件如果我关闭abc.mpg文件，则在km播放器中打开.此代码仍显示abc.mpg文件正在运行.
这是我的代码

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
      ' 16 bytes.
       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()

     ' The following method obtains all the handles on the system
     ' followed by an array of SYSTEM_HANDLE_INFORMATION structs
     ' that can be used to obtain information.

     ' Need to be admin on XP
     ' Need to be admin and elevated on vista and above.
     ' Need to have SE_DEBUG_PRIVS

     ' Use DUPLICATE_CLOSE_SOURCE to close the handle to the remote
     ' process and local process when passed to DuplicateHandle.

     Dim lpBufferHandles   As Long
     Dim Length            As Long
     Dim ret               As Long
     Dim n                 As Long

     ' 256 byte offset
     Length = &H100
       ' Allocate block of memory
     lpBufferHandles = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Length)
       ' Check if valid buffer
     If lpBufferHandles = 0 Then
       Exit Sub
     End If

     ' Obtain the size required for SystemHandleInformation class
     While (NtQuerySystemInformation(SystemHandleInformation, lpBufferHandles, Length, ret) = STATUS_INFO_LENGTH_MISMATCH)
       Length = Length * 2
       ' free memory
       HeapFree GetProcessHeap, 0, lpBufferHandles
       ' allocate memory
       lpBufferHandles = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Length)
     Wend

     ' Check if valid buffer
     If lpBufferHandles = 0 Then
       Exit Sub
     End If

     ' The number of system handles first 4 bytes.
     m_cHandles = ReadLong(lpBufferHandles)
     ' Resize array to system handle count.
     ReDim HandleInfo(m_cHandles) As SYSTEM_HANDLE_INFORMATION
     ' Initialize memory
     RtlZeroMemory HandleInfo(0), LenB(HandleInfo(0)) * m_cHandles
     ' Copy the information into the array
     RtlMoveMemory HandleInfo(0), ByVal lpBufferHandles + 4, LenB(HandleInfo(0)) * m_cHandles
     ' free memory
     HeapFree GetProcessHeap, 0, lpBufferHandles

     ' Get information from the SYSTEM_HANDLE_INFORMATION arrays
       For n = 0 To m_cHandles - 1
     ' Check if the object is a type FILE.
       If HandleInfo(n).ObjectTypeNumber = 28 Then ' 26 for Win2K
     ' Get real process handle.
         OpenProcessForHandle HandleInfo(n).ProcessID
     ' Have to duplicate the file handle so it's valid in our process context.

         DuplicateHandle hProcess, HandleInfo(n).Handle, GetCurrentProcess, hHandle, 0, 0, DUPLICATE_SAME_ACCESS

     ' Checksum
         If hHandle <> 0 Then
     ' Get DOS path,filename and process name.
           szName = GetObjectName(hHandle)
           szAppName = GetProcessName(hProcess)
     ' // TODO: SOME FILTERING GOES HERE. if szName Like "pewpew" Then return results.
           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
   ''                Dim hdup As Long
   ''                Call DuplicateHandle(hProcess, HandleInfo(n).Handle, GetCurrentProcess, hdup, DUPLICATE_SAME_ACCESS, 0, DUPLICATE_CLOSE_SOURCE)
   ''                If hdup > 0 Then
   ''                    CloseHandle (hdup)
   ''                End If
               End If
           End If
       '//
     ' Free handle
           CloseHandle hHandle

         End If
       End If
     Next n

   End Sub
   Private Function GetObjectName(ByVal dwHandle As Long) As String

   ' This method gets a filename from a file handle. Only if the file
   ' in question is atleast one byte. If a file is zero bytes
   ' it can't be mapped and the function fails. Choose to use this method
   ' instead of NtQueryObject because it's more stable and typically if
   ' the file is zero bytes it's used by an application that the user
   ' doesn't care about.

     Dim hFileMap        As Long
     Dim pMem            As Long
     Dim cbLength        As Long
     Dim bName(8192)     As Byte

     ' Create a file mapping in our process.
     hFileMap = CreateFileMappingW(dwHandle, 0, PAGE_READONLY, 0, 1, 0)

     ' Check valid handle
     If hFileMap = 0 Then
       Exit Function
     End If

     ' Map the file into memory
     pMem = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 1)

     ' Check valid memory pointer to file.
     If pMem = 0 Then
       CloseHandle hFileMap
       Exit Function
     End If

     ' Obtain the name from the mapped file.
     cbLength = GetMappedFileNameW(GetCurrentProcess, pMem, VarPtr(bName(0)), 8192)

     ' Check buffer for valid data.
     If cbLength <> 0 Then
       GetObjectName = Left$(bName, cbLength)
     Else
       GetObjectName = vbNullString
     End If

     ' free handles free mapping
     CloseHandle hFileMap
     UnmapViewOfFile pMem
     ' free memory
     Erase bName

   End Function

   Private Function GetProcessName(ByVal dwProcess As Long) As String

   ' The method obtains the process name associated with the real
   ' process handle.

     Dim bProcess(8192)  As Byte
     Dim cbLength        As Long

     cbLength = GetModuleFileNameExW(dwProcess, 0, VarPtr(bProcess(0)), 8192)

     ' check return buffer length
     If cbLength <> 0 Then
         GetProcessName = Left$(bProcess, cbLength)
       Else
         GetProcessName = vbNullString
     End If

     ' free memory
     Erase bProcess

   End Function


   Private Sub OpenProcessForHandle(ByVal ProcessID As Long)

   ' The method obtains a real process handle that can be used
   ' to get additional information about a process.
   ' If the PID is the same don't open the handle again. Only
   ' open the handle if the PID has changed.

     Dim LastPID   As Long

     If ProcessID <> LastPID Then
     ' free handle
       CloseHandle hProcess
     ' get real process handle.
       hProcess = OpenProcess( _
         PROCESS_ALL_ACCESS, _
         0, _
         ProcessID)
       ' checksum
       LastPID = ProcessID

     End If

   End Sub

   Public Sub SeDebugPrivilege()

   ' The following method gives SE_DEBUG_PRIVS.

       Dim Success     As Long
       Dim hToken      As Long
       Dim TokenPriv   As TOKEN_PRIVILEGES
   ' Do work.
       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
   ' Helper function reads 4 bytes from memory address.
     Dim Bogus As Long
     RtlMoveMemory Bogus, ByVal Ptr, 4
     ReadLong = Bogus
   End Function

请帮帮我.

[edit]Added code blocks[/edit]

Please help me.

[edit]Added code blocks[/edit]

推荐答案

(bName, cbLength) 其他 GetObjectName = vbNullString 结束 如果 ' free handles free mapping CloseHandle hFileMap UnmapViewOfFile pMem ' free memory Erase bName 结束 功能 Private Function GetProcessName(ByVal dwProcess As Long) As String ' The method obtains the process name associated with the real ' process handle. Dim bProcess(8192) As Byte Dim cbLength As Long cbLength = GetModuleFileNameExW(dwProcess, 0, VarPtr(bProcess(0)), 8192) ' check return buffer length If cbLength <> 0 然后 GetProcessName = Left

(bName, cbLength) Else GetObjectName = vbNullString End If ' free handles free mapping CloseHandle hFileMap UnmapViewOfFile pMem ' free memory Erase bName End Function Private Function GetProcessName(ByVal dwProcess As Long) As String ' The method obtains the process name associated with the real ' process handle. Dim bProcess(8192) As Byte Dim cbLength As Long cbLength = GetModuleFileNameExW(dwProcess, 0, VarPtr(bProcess(0)), 8192) ' check return buffer length If cbLength <> 0 Then GetProcessName = Left

(bProcess, cbLength) 其他 GetProcessName = vbNullString 结束 如果 ' free memory Erase bProcess 结束 功能 Private Sub OpenProcessForHandle(ByVal ProcessID As Long) ' The method obtains a real process handle that can be used ' to get additional information about a process. ' If the PID is the same don't open the handle again. Only ' open the handle if the PID has changed. Dim LastPID As Long If ProcessID <> LastPID Then ' free handle CloseHandle hProcess ' get real process handle. hProcess = OpenProcess( _ PROCESS_ALL_ACCESS, _ 0 ，_ ProcessID) ' checksum LastPID = ProcessID 结束 如果 结束 子 Public Sub SeDebugPrivilege() ' The following method gives SE_DEBUG_PRIVS. Dim Success As Long Dim hToken As Long Dim TokenPriv As TOKEN_PRIVILEGES ' Do work. 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 结束 子 Private Function ReadLong(ByVal Ptr As Long) As Long ' Helper function reads 4 bytes from memory address. Dim Bogus As Long RtlMoveMemory Bogus, ByVal Ptr, 4 ReadLong = Bogus 结束 功能

(bProcess, cbLength) Else GetProcessName = vbNullString End If ' free memory Erase bProcess End Function Private Sub OpenProcessForHandle(ByVal ProcessID As Long) ' The method obtains a real process handle that can be used ' to get additional information about a process. ' If the PID is the same don't open the handle again. Only ' open the handle if the PID has changed. Dim LastPID As Long If ProcessID <> LastPID Then ' free handle CloseHandle hProcess ' get real process handle. hProcess = OpenProcess( _ PROCESS_ALL_ACCESS, _ 0, _ ProcessID) ' checksum LastPID = ProcessID End If End Sub Public Sub SeDebugPrivilege() ' The following method gives SE_DEBUG_PRIVS. Dim Success As Long Dim hToken As Long Dim TokenPriv As TOKEN_PRIVILEGES ' Do work. 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 ' Helper function reads 4 bytes from memory address. Dim Bogus As Long RtlMoveMemory Bogus, ByVal Ptr, 4 ReadLong = Bogus End Function

请帮帮我.

[edit]Added code blocks[/edit]

Please help me.

[edit]Added code blocks[/edit]

Couldn''t it just be that the os has some delay in updating this information? Or that the media player used has a delay.
Check out sysinternals suite:
http://technet.microsoft.com/en-us/sysinternals/bb842062.aspx[^]

Have a look at the handle tool which also checks the files opened by a process:
http://technet.microsoft.com/en-us/sysinternals/bb896655[^]

祝你好运！

Couldn''t it just be that the os has some delay in updating this information? Or that the media player used has a delay.
Check out sysinternals suite:
http://technet.microsoft.com/en-us/sysinternals/bb842062.aspx[^]

Have a look at the handle tool which also checks the files opened by a process:
http://technet.microsoft.com/en-us/sysinternals/bb896655[^]

Good luck!

这篇关于vb6中正在处理的重复文件名的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！