Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As LongPtr
   
#If Win64 Then
    Public Const PTR_LENGTH As Long = 8
#Else
    Public Const PTR_LENGTH As Long = 4
#End If
 
Public Declare PtrSafe Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long)
 
Function HexPtr(ByVal Ptr As LongPtr) As String
    HexPtr = Hex$(Ptr)
    HexPtr = String$((PTR_LENGTH * 2) - Len(HexPtr), "0") & HexPtr
End Function
 
Public Function Mem_ReadHex(ByVal Ptr As LongPtr, ByVal Length As Long) As String
    Dim bBuffer() As Byte, strBytes() As String, i As Long, ub As Long, b As Byte
    ub = Length - 1
    ReDim bBuffer(ub)
    ReDim strBytes(ub)
    Mem_Copy bBuffer(0), ByVal Ptr, Length
    For i = 0 To ub
        b = bBuffer(i)
        strBytes(i) = IIf(b < 16, "0", "") & Hex$(b)
    Next
    Mem_ReadHex = Join(strBytes, "")
End Function

Sub Extract()
    
    Dim cnt As Integer
    Dim memArray() As Variant
    Dim strVar As String, ptrVar As LongPtr, ptrBSTR As LongPtr
    
    strVar = "Atomic T1005 test"
    outDir = Environ("TEMP") + "\atomic_t1005_test_output.bin"
    
    ptrVar = VarPtr(strVar)
    Mem_Copy ptrBSTR, ByVal ptrVar, PTR_LENGTH
    
    cnt = 0
    Do
        ReDim Preserve memArray(cnt)
        memArray(cnt) = Mem_ReadHex(ptrBSTR + cnt, 1)
        cnt = cnt + 1
    Loop While cnt < (Len(strVar) * 2)
    
    Open (outDir) For Binary Lock Read Write As #1
    For a = 0 To UBound(memArray)
        Put #1, , CByte("&h" & memArray(a))
    Next a
    Close
    
End Sub