Foro de elhacker.net

Option Explicit

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long) As Long

Private Type SA1D_STRUCT
    Struct(23) As Byte
    bData() As Byte
    Length As Long
End Type

Private SA1D() As SA1D_STRUCT

Public Sub ByteToStruct(ByVal StructPtr As Long, ByRef bArray() As Byte)
    Dim Count As Long
    Dim i As Long
    
    Do
        ReDim Preserve SA1D(i): Call CopyMemory(SA1D(i).Length, bArray(Count), 4)
        ReDim SA1D(i).bData(SA1D(i).Length)
    
        Call CopyMemory(SA1D(i).bData(0), bArray(Count + 4), SA1D(i).Length)
        Count = Count + 4 + SA1D(i).Length: i = i + 1
    Loop Until (UBound(bArray) + 1 = Count)
    
    For i = 0 To UBound(SA1D)
        Call CopyMemory(SA1D(i).Struct(12), VarPtr(SA1D(i).bData(0)), 4) 'DataPtr
        Call CopyMemory(SA1D(i).Struct(16), SA1D(i).Length, 4) 'LBound
        Call CopyMemory(SA1D(i).Struct(0), 1, 2) 'Dims
        Call CopyMemory(SA1D(i).Struct(4), 1, 4) 'ElementSize
              
        Call CopyMemory(ByVal StructPtr + (i * 4), VarPtr(SA1D(i).Struct(0)), 4) 'SA1D Struct
    Next i
End Sub

Public Sub StructToByte(ByVal StructPtr As Long, ByRef bReturn() As Byte, ParamArray VarType() As Variant)
    Dim SafeArrayPtr As Long
    Dim ArrayLength As Long
    Dim ArrayPtr As Long
    Dim i As Long
        
    ReDim bReturn(0)
    For i = 0 To UBound(VarType)
        Select Case VarType(i)
            Case vbByte:
                'SafeArray1D Struct
                Call CopyMemory(SafeArrayPtr, ByVal StructPtr + (i * 4), 4)
                Call CopyMemory(ArrayPtr, ByVal SafeArrayPtr + 12, 4) 'DataPtr
                Call CopyMemory(ArrayLength, ByVal SafeArrayPtr + 16, 4) 'LBound
                'Data Size + Data
                ReDim Preserve bReturn(UBound(bReturn) + 4 + ArrayLength)
                Call CopyMemory(ByVal VarPtr(bReturn(UBound(bReturn) - 4 - ArrayLength)), ArrayLength, 4)
                Call CopyMemory(ByVal VarPtr(bReturn(UBound(bReturn) - ArrayLength)), ByVal ArrayPtr, ArrayLength)
        End Select
    Next i
    ReDim Preserve bReturn(UBound(bReturn) - 1)
End Sub

Private Type dd
    ss() As Byte
    jj() As Byte
    tt() As Byte
End Type

Sub Main()
    Dim told As dd
    Dim tnew As dd
    Dim bB() As Byte
    
    told.ss = StrConv("hola", vbFromUnicode)
    told.jj = StrConv("jeje", vbFromUnicode)
    told.tt = StrConv("wakawaka", vbFromUnicode)
    
    Call StructToByte(VarPtr(told), bB, vbByte, vbByte, vbByte)
    Call ByteToStruct(VarPtr(tnew), bB)
    
    MsgBox StrConv(tnew.jj, vbUnicode)
    MsgBox StrConv(tnew.ss, vbUnicode)
    MsgBox StrConv(tnew.tt, vbUnicode)
End Sub