使用ZwQueryVirtualMemory枚舉進程模塊

 Public Sub PrintProcessModules(ByVal dwProcessId As Long)
    Dim ntStatus As Long
    Dim objCid As CLIENT_ID
    Dim objOa As OBJECT_ATTRIBUTES
    Dim hProcess As Long
    Dim dwVirtualAddr As Long
    Dim pName As UNICODE_STRING1
    Dim dwRet As Long
    Dim intRet As Integer
    Dim strModuleName As String
    Dim pDosHeader As IMAGE_DOS_HEADER
    Dim pNtHeaders As IMAGE_NT_HEADERS
    Dim dwImageSize As Long
    Dim MemoryBase As MEMORY_BASIC_INFORMATION
    objOa.Length = Len(objOa)
    objCid.UniqueProcess = dwProcessId
    ntStatus = NtOpenProcess(hProcess, PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, objOa, objCid)
    If hProcess = 0 Then
        hProcess = GetHandleByProcessId(dwProcessId)
        If hProcess = 0 Then
            Exit Sub
        End If
    End If
    dwVirtualAddr = &H1000
    Do While dwVirtualAddr <> &H7FFF0000
        ntStatus = ZwQueryVirtualMemory(hProcess, dwVirtualAddr, 0, VarPtr(MemoryBase), LenB(MemoryBase), dwRet)
        If NT_SUCCESS(ntStatus) Then
            If MemoryBase.AllocationBase = 0 Then
                dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize
                dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize Mod &H1000
                GoTo NextLoop
            Else
                ntStatus = ZwQueryVirtualMemory(hProcess, dwVirtualAddr, 2, VarPtr(pName), LenB(pName), dwRet)
                If NT_SUCCESS(ntStatus) Then
                    ReadProcessMemory hProcess, ByVal MemoryBase.AllocationBase, pDosHeader, LenB(pDosHeader), ByVal 0&
                    If pDosHeader.Magic <> &H5A4D Then
                        dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize
                        dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize Mod &H1000
                        GoTo NextLoop
                    End If
                    ReadProcessMemory hProcess, ByVal MemoryBase.AllocationBase + pDosHeader.lfanew, pNtHeaders, LenB(pNtHeaders), ByVal 0&
                    If pNtHeaders.Signature <> IMAGE_NT_SIGNATURE Then
                        dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize
                        dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize Mod &H1000
                        GoTo NextLoop
                    End If
                    strModuleName = Left(pName.pBuffer, InStr(pName.pBuffer, vbNullChar) - 1)
                    'Debug.Print strModuleName; MemoryBase.AllocationBase; pNtHeaders.OptionalHeader.ImageSize
                    If MemoryBase.Type = &H1000000 Then
                        Form1.List1.AddItem strModuleName & ";" & Hex(MemoryBase.AllocationBase) & ";" & Hex(pNtHeaders.OptionalHeader.ImageSize) & ";State：" & Hex(MemoryBase.State) & ";Type：" & Hex(MemoryBase.Type) & ";AllocationProtect：" & Hex(MemoryBase.AllocationProtect) & ";Protect：" & Hex(MemoryBase.Protect)
                    End If
                    'dwVirtualAddr = dwVirtualAddr + pNtHeaders.OptionalHeader.ImageSize
                    dwVirtualAddr = MemoryBase.AllocationBase + pNtHeaders.OptionalHeader.ImageSize
                    dwVirtualAddr = dwVirtualAddr + pNtHeaders.OptionalHeader.ImageSize Mod &H1000
                Else
                    dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize
                    dwVirtualAddr = dwVirtualAddr + MemoryBase.RegionSize Mod &H1000
                End If
            End If
        Else
            dwVirtualAddr = dwVirtualAddr + &H1000
        End If
NextLoop:
    Loop
    NtClose hProcess
End Sub