[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 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)

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 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

Sample usage:

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

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!!

[Jonney]

Thanks for sharing this.