Código:
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
Ejemplo:
Código:
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
PD: funciona solo con arrays de bytes, ya que es lo que yo necesito , pero se puede agregar "soporte" con otros tipos de variables facilmente
Suerte