[SNIPPET-VB6] Guardar/Cargar Estructura

[F3B14N]

mStruct:

Código [Seleccionar] Expandir

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 [Seleccionar] Expandir

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

[Karcrack]

Al final lo conseguiste
A ver si con lo que te dije se puede extener a cualquier estructura

[BlackZeroX]

.
Solo para acompletar un poco te dejo esto que me arme hace tiempo para lo del SafeArray... 1D 2D, 3D.. ND:

Código (Vb) [Seleccionar] Expandir



Private Type SAFEARRAYBOUND
    cElements         As Long
    lLbound           As Long
End Type
Private Type SAFEARRAY_ND
    cDims             As Integer
    fFeatures         As Integer
    cbElements        As Long
    cLocks            As Long
    pvData            As Long
    Bounds()          As SAFEARRAYBOUND
End Type



Dulce Lunas!¡.

[F3B14N]

Al final lo conseguiste
A ver si con lo que te dije se puede extener a cualquier estructura

Lo intenté, te mande un PM hace unos dias con el codigo; la funcion __vbaPutOwner3 recibe directamente el valor de la primer variable de la estructura y no lo demás datos, es raro :S

Como dije, no es difícil agregarle soporte con otros tipos de variables, en unos dias lo hago y posteo