[VB6] Dereferencing Pointers sans CopyMemory-VBForums
Results 1 to 2 of 2

Thread: [VB6] Dereferencing Pointers sans CopyMemory

  1. #1

    Thread Starter
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    3,142

    Arrow [VB6] Dereferencing Pointers sans CopyMemory

    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:

    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)
    
    The pointer dereferencing functions:

    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
    
    
    Sample usage:

    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!!
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  2. #2
    Hyperactive Member
    Join Date
    Jan 2010
    Posts
    362

    Re: [VB6] Dereferencing Pointers sans CopyMemory

    Thanks for sharing this.
    Last edited by Jonney; Jan 30th, 2013 at 12:05 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.