- UID
- 1
- 精华
- 积分
- 76361
- 威望
- 点
- 宅币
- 个
- 贡献
- 次
- 宅之契约
- 份
- 最后登录
- 1970-1-1
- 在线时间
- 小时
|
转载来源:http://www.vbasm.com/thread-8008-1-1.html
作者:Tesla.Angela
转载请注明出处!
摘自WIN64AST源码。- Module PtrOpr
- Private Declare Function VirtualAlloc Lib "kernel32.dll" Alias "VirtualAlloc" (ByVal lpAddress As UIntPtr,
- ByVal dwSize As UInt32,
- ByVal flAllocationType As UInt32,
- ByVal flProtect As UInt32) As UIntPtr
- Private Declare Function VirtualFree Lib "kernel32.dll" Alias "VirtualFree" (ByVal lpAddress As UIntPtr,
- ByVal dwSize As UInt32,
- ByVal dwFreeType As UInt32) As Int32
- Public Declare Sub memset Lib "kernel32.dll" Alias "RtlFillMemory" (ByVal lpAddress As UIntPtr,
- ByVal dwSize As UInt32,
- ByVal bFill As Byte)
- Public Declare Sub memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As UIntPtr,
- ByVal Source As UIntPtr,
- ByVal Length As UInt32)
- Public Declare Sub memcpy1pv Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As UIntPtr,
- ByRef Source As Byte,
- Optional ByVal Length As UInt32 = 1)
- Public Declare Sub memcpy2pv Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As UIntPtr,
- ByRef Source As UInt16,
- Optional ByVal Length As UInt32 = 2)
- Public Declare Sub memcpy4pv Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As UIntPtr,
- ByRef Source As UInt32,
- Optional ByVal Length As UInt32 = 4)
- Public Declare Sub memcpy8pv Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As UIntPtr,
- ByRef Source As UInt64,
- Optional ByVal Length As UInt32 = 8)
- Public Declare Sub memcpy1vp Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Byte,
- ByVal Source As UIntPtr,
- Optional ByVal Length As UInt32 = 1)
- Public Declare Sub memcpy2vp Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As UInt16,
- ByVal Source As UIntPtr,
- Optional ByVal Length As UInt32 = 2)
- Public Declare Sub memcpy4vp Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As UInt32,
- ByVal Source As UIntPtr,
- Optional ByVal Length As UInt32 = 4)
- Public Declare Sub memcpy8vp Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As UInt64,
- ByVal Source As UIntPtr,
- Optional ByVal Length As UInt32 = 8)
- Public Function malloc(ByVal length As Long) As ULong
- Dim p As ULong
- p = VirtualAlloc(0, length, &H1000, &H40)
- memset(p, length, 0)
- Return p
- End Function
- Public Sub free(ByVal buffer As ULong)
- VirtualFree(buffer, 0, &H4000)
- End Sub
- Public Function GetPtrVal1(ByVal ptr As UIntPtr) As Byte
- Dim v As Byte = 0
- memcpy1vp(v, ptr)
- Return v
- End Function
- Public Function GetPtrVal2(ByVal ptr As UIntPtr) As UInt16
- Dim v As UInt16 = 0
- memcpy2vp(v, ptr)
- Return v
- End Function
- Public Function GetPtrVal4(ByVal ptr As UIntPtr) As UInt32
- Dim v As UInt32 = 0
- memcpy4vp(v, ptr)
- Return v
- End Function
- Public Function GetPtrVal8(ByVal ptr As UIntPtr) As UInt64
- Dim v As UInt64 = 0
- memcpy8vp(v, ptr)
- Return v
- End Function
- Public Sub SetPtrVal1(ByVal ptr As UIntPtr, ByVal v As Byte)
- memcpy1pv(ptr, v)
- End Sub
- Public Sub SetPtrVal2(ByVal ptr As UIntPtr, ByVal v As UInt16)
- memcpy2pv(ptr, v)
- End Sub
- Public Sub SetPtrVal4(ByVal ptr As UIntPtr, ByVal v As UInt32)
- memcpy4pv(ptr, v)
- End Sub
- Public Sub SetPtrVal8(ByVal ptr As UIntPtr, ByVal v As UInt64)
- memcpy8pv(ptr, v)
- End Sub
- Public Function AllocAndSetPtr1(ByVal v As Byte) As UIntPtr
- Dim p As UIntPtr = malloc(Len(v))
- SetPtrVal1(p, v)
- Return p
- End Function
- Public Function AllocAndSetPtr2(ByVal v As UInt16) As UIntPtr
- Dim p As UIntPtr = malloc(Len(v))
- SetPtrVal2(p, v)
- Return p
- End Function
- Public Function AllocAndSetPtr4(ByVal v As UInt32) As UIntPtr
- Dim p As UIntPtr = malloc(Len(v))
- SetPtrVal4(p, v)
- Return p
- End Function
- Public Function AllocAndSetPtr8(ByVal v As UInt64) As UIntPtr
- Dim p As UIntPtr = malloc(Len(v))
- SetPtrVal8(p, v)
- Return p
- End Function
- End Module
复制代码 使用范例:- Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
- Dim p As UIntPtr = malloc(1024 * 1024 * 10)
- If p.Size = 4 Then
- MsgBox("申请了10MB内存请注意内存变化", , Hex(p.ToUInt32))
- Else
- MsgBox("申请了10MB内存请注意内存变化", , Hex(p.ToUInt64))
- End If
- free(p) : MsgBox("内存已经释放请注意内存变化")
- End Sub
- Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
- Dim p As UIntPtr = AllocAndSetPtr8(&H7FFFF80012345699)
- Dim v As ULong = GetPtrVal8(p) : MsgBox(Hex(v))
- free(p)
- End Sub
复制代码 |
|