如何在外部程式配置記憶體

如何在外部程式配置記憶體

說明

在Win32底下，所有Process的位址都是獨立的，理論上是沒辦法再外部程式上配置記憶體的，但對於某些程式的需求(如共享記憶體，Global Hook)，系統還是會在外部程式配置一塊記憶體

註：行程間要共享記憶體或是交換資料一定得透過記憶體映射檔去做(包括用SendMessage 使用WM_COPYDATA來傳資料底層都有用記憶體映射檔)
記憶體映射檔在9x以及NT環境下有所不同，在9x系統下，記憶體映射檔在每個Process都在相同位址，而且每個Process都可以直接存取該塊記憶體，但在NT下卻不是這樣，NT下當某個Process開啟記憶體映射檔時該記憶體只映射到呼叫的Process的行程空間中並不會存在其他Process的行程空間當另一個行程B也開啟此記憶體映射檔時系統才會將該記憶體映射到行程B 這和9x系統有相當大的不同 NT底下有更獨立的位址空間

因此如果是在9x的系統要再外部程式配置記憶體有2種方式

透過記憶體映射檔(無論對方行程同不同意都能配置)
透過Global Hook去注射行程然後配置記憶體(這必須透過DLL去做但VB沒辦法做出標準的DLL檔這個方法並不是用於VB)

同樣的方式在NT底下

透過記憶體映射檔(這必須對方行程同意的情況才能配置)
透過Global Hook去注射行程然後配置記憶體(這必須透過DLL去做但VB沒辦法做出標準的DLL檔這個方法並不是用於VB)

這下子VB在NT下不就不能神不知鬼不覺得再外部程式配置記一體了對吧?

當然不是在NT下有提供一個API:VirtualAllocEx可以讓你再任一行程上配置記憶體,使用完後再用VirtualFreeEx釋放掉該空間即可

此配置程式我已經把他包裝成物件模組應該蠻容易使用的

程式

'以下程式在物件類別模組
Option Explicit

Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      ' Maintenance string for PSS usage
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes As Any, 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 UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_ALWAYS = 4
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const SECTION_MAP_WRITE = &H2
Private Const FILE_MAP_WRITE = SECTION_MAP_WRITE
Private Const PAGE_READWRITE As Long = &H4
Private Const MEM_HANDLE As Long = &HFFFFFFFF

Private Declare Function CoCreateGuid Lib "ole32.dll" (lpGUID As Any) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (lpGUID As Any, ByVal lpStr As String, ByVal lSize As Long) As Long

'紀錄物件中所有配置的記憶體當成是結束時如有未釋放的可自動釋放掉
Private Type FileMap
    iCount As Integer
    AddressOfFileMap() As Long
    hFileMap() As Long
    tProcessID() As Long
    iIndex As Integer
End Type

Dim UseMap As FileMap

'Process 參數
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H20&
Private Const PROCESS_QUERY_INFORMATION = 1024

'記憶體型態
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_FREE = &H10000
Private Const MEM_PRIVATE = &H20000
Private Const MEM_MAPPED = &H40000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const MEM_4MB_PAGES = &H80000000
Private Const SEC_IMAGE = &H1000000
Private Const MEM_IMAGE = SEC_IMAGE

'記憶體保護狀態
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_READONLY = &H2
'Private Const PAGE_READWRITE = &H4
Private Const PAGE_WRITECOPY = &H8
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_EXECUTE_WRITECOPY = &H80
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOCACHE = &H200
Public IsNt As Boolean

Private Function GetGuidID() As String
Dim pGuid(16) As Byte
Dim s As String
s = String(255, " ")
CoCreateGuid pGuid(0)
StringFromGUID2 pGuid(0), s, 255
s = Trim(s)
GetGuidID = StrConv(s, vbFromUnicode)
End Function

Public Function RemortMemoryAlloc(ByVal ProcessID As Long, Size As Long) As Long

UseMap.iIndex = UseMap.iIndex + 1
If UseMap.iIndex > UseMap.iCount Then
    UseMap.iCount = UseMap.iIndex
    ReDim Preserve UseMap.hFileMap(1 To UseMap.iIndex)
    ReDim Preserve UseMap.AddressOfFileMap(1 To UseMap.iIndex)
    ReDim Preserve UseMap.tProcessID(1 To UseMap.iIndex)
End If

UseMap.tProcessID(UseMap.iIndex) = ProcessID

If IsNt Then
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    UseMap.hFileMap(UseMap.iIndex) = 0
    UseMap.AddressOfFileMap(UseMap.iIndex) = VirtualAllocEx(hProcess, ByVal 0, Size, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
    CloseHandle hProcess
Else
    UseMap.hFileMap(UseMap.iIndex) = CreateFileMapping(MEM_HANDLE, ByVal 0&, PAGE_READWRITE, 0&, Size, GetGuidID)
    UseMap.AddressOfFileMap(UseMap.iIndex) = MapViewOfFile(UseMap.hFileMap(UseMap.iCount), FILE_MAP_WRITE, 0, 0, 0)
End If

RemortMemoryAlloc = UseMap.AddressOfFileMap(UseMap.iIndex)
End Function

Public Function RemortMemoryRemove(ByVal ProcessID As Long, ByVal hAddress As Long) As Long
Dim hFileMap As Long

Dim i As Long

For i = 1 To UseMap.iIndex
    If UseMap.AddressOfFileMap(i) = hAddress Then
        Exit For
    End If
Next

If i > UseMap.iIndex Then
    MsgBox "位址錯誤"
    Exit Function
Else
    UseMap.AddressOfFileMap(i) = UseMap.AddressOfFileMap(UseMap.iIndex)
    hFileMap = UseMap.hFileMap(i)
    UseMap.hFileMap(i) = UseMap.hFileMap(UseMap.iIndex)
    UseMap.tProcessID(i) = UseMap.tProcessID(UseMap.iIndex)
    UseMap.iIndex = UseMap.iIndex - 1
End If

If IsNt Then
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    RemortMemoryRemove = VirtualFreeEx(hProcess, hAddress, 0, MEM_RELEASE)
    CloseHandle hProcess
Else
    UnmapViewOfFile hAddress
    RemortMemoryRemove = CloseHandle(hFileMap)

End If
End Function

Private Sub Class_Initialize()
Dim OSVER As OSVERSIONINFO

OSVER.dwOSVersionInfoSize = Len(OSVER)
Call GetVersionEx(OSVER)
If OSVER.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
    IsNt = False
ElseIf OSVER.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    IsNt = True
End If
End Sub

Private Sub Class_Terminate()
Dim hFileMap As Long, i As Long
'釋放掉未釋放的記憶體
If IsNt Then
    Dim hProcess As Long
    For i = 1 To UseMap.iIndex
        hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, UseMap.tProcessID(i))
        Call VirtualFreeEx(hProcess, UseMap.AddressOfFileMap(i), 0, MEM_RELEASE)
        CloseHandle hProcess
    Next
Else
    For i = 1 To UseMap.iIndex
        UnmapViewOfFile UseMap.AddressOfFileMap(i)
        Call CloseHandle(UseMap.hFileMap(i))
    Next
End If
Erase UseMap.AddressOfFileMap
Erase UseMap.hFileMap
Erase UseMap.tProcessID
End Sub

使用範例可以參考如何取得桌面圖示的座標

文件出處

Honey

整理時間

2002'5,20.


	VB心得筆記歡迎各位的指教,如果您有任何文章或資料願意提供給我們的,請來信到VBNote


	如果對本站有任何建議,歡迎來信給Honey,我們會盡快給您答覆