mStruct:
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:
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 :P, pero se puede agregar "soporte" con otros tipos de variables facilmente :)
Suerte :-*
Al final lo conseguiste :)
A ver si con lo que te dije se puede extener a cualquier estructura ;)
.
Solo para acompletar un poco te dejo esto que me arme hace tiempo para lo del SafeArray... 1D 2D, 3D.. ND:
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!¡.
Cita de: Karcrack en 28 Noviembre 2010, 21:50 PM
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 :-X