【其它源码】【转载】VB.NET的指针操作模块
转载来源：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
页:
[1]