[VB6] Dereferencing Pointers sans CopyMemory

[Bonnie West]

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:

Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal lpString As Long) As Long

Private Declare Function CopyBytes Lib "msvbvm60.dll" Alias "__vbaCopyBytes" (ByVal ByteLen As Long, ByVal Destination As Long, ByVal Source As Long) As Long
Private Declare Function GetMem1 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Byte) As Long
Private Declare Function GetMem2 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Integer) As Long
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Long) As Long
Private Declare Function GetMem8 Lib "msvbvm60.dll" (ByVal Addr As Long, ByRef RetVal As Currency) As Long
Private Declare Function ObjSetAddRef Lib "msvbvm60.dll" Alias "__vbaObjSetAddref" (ByRef objDest As Object, ByVal pObject As Long) As Long
Private Declare Function PutMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewVal As Long) As Long

Private Declare Function SysAllocString Lib "oleaut32.dll" (Optional ByVal pszStrPtr As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" (Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As String
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

The pointer dereferencing functions:

'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 ANSI string (LPSTR/LPCSTR) from the given pointer
Public Function GetStrFromPtrA(ByVal Ptr As Long) As String
    GetStrFromPtrA = SysAllocStringByteLen(Ptr, lstrlenA(Ptr))
End Function

'Returns a copy of a null-terminated Unicode string (LPWSTR/LPCWSTR) from the given pointer
Public Function GetStrFromPtrW(ByVal Ptr As Long) As String
    #If WantFasterWay Then
    PutMem4 VarPtr(GetStrFromPtrW), SysAllocString(Ptr)
    #Else
    SysReAllocString VarPtr(GetStrFromPtrW), Ptr
    #End If
End Function

'Returns a counted Object reference from the given pointer
Public Function GetObjFromPtr(ByVal Ptr As Long) As Object
    ObjSetAddRef GetObjFromPtr, Ptr
End Function

'Returns a shallow copy of a UDT from the given pointer (replace As UDT with the desired type)
Public Function GetUDTFromPtr(ByVal Ptr As Long) As UDT
    CopyBytes LenB(GetUDTFromPtr), VarPtr(GetUDTFromPtr), Ptr
End Function

Sample usage:

'In a standard (.BAS) module

Private Type UDT        'Len  LenB
                        '---------
    Byt As Byte         '  1     4  <-- Padded so that next member is DWORD aligned
    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

Public Sub DerefPtrs()    'Call from the Immediate Window
    Dim UDT As UDT

    Debug.Print
    Debug.Print "GetBytFromPtr = &H"; Hex$(GetBytFromPtr(VarPtr(CByte(&HAD))))
    Debug.Print "GetIntFromPtr = &H"; Hex$(GetIntFromPtr(VarPtr(&HEAD)))
    Debug.Print "GetLngFromPtr = &H"; Hex$(GetLngFromPtr(VarPtr(&HADC0FFEE)))
    Debug.Print "GetCurFromPtr = "; GetCurFromPtr(VarPtr(1234567890.1234@))
    Debug.Print "GetStrFromPtrW = """; GetStrFromPtrW(StrPtr(App.Title)); """"
    Debug.Print "GetObjFromPtr = """; GetObjFromPtr(ObjPtr(App)).Path; """"
    Debug.Print

    With UDT
        .Byt = &HFF
        .Bln = True
        .Int = &H7FFF
        .Lng = &H7FFFFFFF
         Set .Obj = New Collection
        .Sng = 3.402823E+38!
        .Str = "Cwm Fjord Bank Glyphs Vext Quiz"
        .Cur = 922337203685477.5807@
        .Dtm = Now
        .Dbl = 4.94065645841247E-324
        .Vnt = CDec(7.92281625142643E+27)
        .FLS = "Fix Problem Quickly With Galvanized Jets"
    End With

    With GetUDTFromPtr(VarPtr(UDT))
        Debug.Print "Byt = &H"; Hex$(.Byt)
        Debug.Print "Bln = "; .Bln
        Debug.Print "Int = &H"; Hex$(.Int)
        Debug.Print "Lng = &H"; Hex$(.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; """"

       'Cleanup stolen references
        PutMem4 VarPtr(.Obj), 0&
        PutMem4 VarPtr(.Str), 0&
    End With
End Sub

---

References:

• SysAllocString/SysReAllocString functions 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!!
• Functions __vbaCopyBytes and __vbaCopyBytesZero by Libor Blaheta (PDF attached below)