Here are several functions which retrieves the value or data located at the memory address specified by the given pointer. These functions perform the inverse operation of VarPtr, StrPtr and ObjPtr. Rather than using the ubiquitous CopyMemory, alternative APIs are presented instead.
The API declarations:
The pointer dereferencing functions:
Sample usage:
References:
SysReAllocString function at MSDN
Hidden Gems for Free by Michel Rutten
[Benchmark] CopyMemory vs. __vbaCopyBytes by Henrik Ilgen
Using The Native Functions in VBs Runtime DLL by Voodoo Attack!!
The API declarations:
Code:
Private Declare Function ObjSetAddRef Lib "msvbvm60.dll" Alias "__vbaObjSetAddref" (ByRef ObjDest As Object, ByVal Ptr2Obj As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Private Declare Sub CopyBytes Lib "msvbvm60.dll" Alias "__vbaCopyBytes" (ByVal ByteLen As Long, ByVal Destination As Long, ByVal Source As Long)
Private Declare Sub GetMem1 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Byte)
Private Declare Sub GetMem2 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Integer)
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Long)
Private Declare Sub GetMem8 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByRef RetVal As Currency)
Code:
'Retrieves the Byte value from the specified memory address
Public Function GetBytFromPtr(ByVal Ptr As Long) As Byte
GetMem1 Ptr, GetBytFromPtr
End Function
'Retrieves the Integer value from the specified memory address
Public Function GetIntFromPtr(ByVal Ptr As Long) As Integer
GetMem2 Ptr, GetIntFromPtr
End Function
'Retrieves the Long value from the specified memory address
Public Function GetLngFromPtr(ByVal Ptr As Long) As Long
GetMem4 Ptr, GetLngFromPtr
End Function
'Retrieves the Currency value from the specified memory address
Public Function GetCurFromPtr(ByVal Ptr As Long) As Currency
GetMem8 Ptr, GetCurFromPtr
End Function
'Returns a copy of a null-terminated Unicode string (LPWSTR/LPCWSTR)
Public Function GetStrFromPtr(ByVal Ptr As Long) As String
SysReAllocString VarPtr(GetStrFromPtr), Ptr
End Function
'Returns an object from the given pointer
Public Function GetObjFromPtr(ByVal Ptr As Long) As Object
ObjSetAddRef GetObjFromPtr, Ptr
End Function
'Returns a copy of a UDT given a pointer (replace As UDT with any desired Type)
Public Function GetUDTFromPtr(ByVal Ptr As Long) As UDT
CopyBytes LenB(GetUDTFromPtr), VarPtr(GetUDTFromPtr), Ptr
End Function
Code:
Private Type UDT 'Len LenB
'---------
Byt As Byte ' 1 4 <-- padded to fill 32 bits
Bln As Boolean ' 2 2
Int As Integer ' 2 2
Lng As Long ' 4 4
Obj As Object ' 4 4
Sng As Single ' 4 4
Str As String ' 4 4
Cur As Currency ' 8 8
Dtm As Date ' 8 8
Dbl As Double ' 8 8
Vnt As Variant ' 16 16
FLS As String * 40 ' 40 80 <-- Unicode in memory; ANSI when written to disk
'---------
End Type '101 144
Code:
Public Sub DerefPtrs() 'Call from Debug window
Dim U As UDT
Debug.Print
Debug.Print "GetBytFromPtr = " & GetBytFromPtr(VarPtr(CByte(&HAD)))
Debug.Print "GetIntFromPtr = " & GetIntFromPtr(VarPtr(&HEAD))
Debug.Print "GetLngFromPtr = " & GetLngFromPtr(VarPtr(&HADC0FFEE))
Debug.Print "GetCurFromPtr = " & GetCurFromPtr(VarPtr(1234567890.1234@))
Debug.Print "GetStrFromPtr = """ & GetStrFromPtr(StrPtr(App.Title)) & """"
Debug.Print "GetObjFromPtr = """ & GetObjFromPtr(ObjPtr(App)).Path & """"
Debug.Print
With U
.Byt = &HFF
.Bln = True
.Int = &H7FFF
.Lng = &H7FFFFFFF
Set .Obj = Forms
.Sng = 3.402823E+38!
.Str = "The Quick Brown Fox Jumps Over The Lazy Dog"
.Cur = 922337203685477.5807@
.Dtm = Now
.Dbl = 4.94065645841247E-324
.Vnt = CDec(7.92281625142643E+27)
.FLS = "Jackdaws Love My Big Sphinx Of Quartz..."
End With
With GetUDTFromPtr(VarPtr(U))
Debug.Print "Byt = " & .Byt
Debug.Print "Bln = " & .Bln
Debug.Print "Int = " & .Int
Debug.Print "Lng = " & .Lng
Debug.Print "Obj = """ & TypeName(.Obj) & """"
Debug.Print "Sng = " & .Sng
Debug.Print "Str = """ & .Str & """"
Debug.Print "Cur = " & .Cur
Debug.Print "Dtm = " & .Dtm
Debug.Print "Dbl = " & .Dbl
Debug.Print "Vnt = " & .Vnt
Debug.Print "FLS = """ & .FLS & """"
End With
End Sub
References:
SysReAllocString function at MSDN
Hidden Gems for Free by Michel Rutten
[Benchmark] CopyMemory vs. __vbaCopyBytes by Henrik Ilgen
Using The Native Functions in VBs Runtime DLL by Voodoo Attack!!