[RESUELTO] CopyMem Array VarTypes

Iniciado por Miseryk, 9 Mayo 2013, 21:45 PM

0 Miembros y 1 Visitante están viendo este tema.

Miseryk

Estaba tratando de mover memoria entre arrays.

Hice este ejemplo, tal vez puedan mejorarlo y/o ayudame con Variant :P

Código (vb) [Seleccionar]

Modulo:
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
       (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Form:
Private Sub Form_Load()
Dim ESI(3 To 6) As Variant
Dim EDI(3 To 6) As Variant

ESI(3) = "asdasdasdasdsd12312331231asdasd" '255 '32767 '2147483647
ESI(4) = ESI(3)
ESI(5) = ESI(3)
ESI(6) = ESI(3)

EDI(3) = 0
EDI(4) = EDI(3)
EDI(5) = EDI(3)
EDI(6) = EDI(3)

CopyMemory EDI(LBound(EDI)), ESI(LBound(ESI)), GetSizeArray(ESI)

Dim i As Byte

For i = LBound(ESI) To UBound(ESI)
   MsgBox i & ": " & (ESI(i) = EDI(i)) & vbCrLf & "&H" & Hex(VarPtr(ESI(i)))
Next i

End
End Sub

Private Function GetSizeArray(ByRef vArray)
Dim BaseBytes As Byte

'MsgBox TypeName(vArray)

Select Case TypeName(vArray)
   Case "Byte()"
       BaseBytes = 1
   Case "Boolean()", "Integer()"
       BaseBytes = 2
   Case "Long()", "Single()"
       BaseBytes = 4
   Case "Double()", "Currency()", "Date()"
       BaseBytes = 8
   Case "Variant()"
       BaseBytes = 0 'DUNNO
   Case "String()"
       BaseBytes = 4 'ReadMem del VarPtr está el Address al string con su len 4 bytes antes
End Select

GetSizeArray = BaseBytes * (UBound(vArray) - LBound(vArray) + 1)
End Function


Edit:
Se podría tomar como un reto *-)
Can you see it?
The worst is over
The monsters in my head are scared of love
Fallen people listen up! It's never too late to change our luck
So, don't let them steal your light
Don't let them break your stride
There is light on the other side
And you'll see all the raindrops falling behind
Make it out tonight
it's a revolution

CL!!!

Psyke1

Mírate esto:

http://msdn.microsoft.com/en-us/library/aa263420(v=vs.60).aspx

DoEvents! :P

Miseryk

Ya la había visto esa página, pero no funciona como dice ahí, ya que el string son 4 bytes, porque hace referencia a un puntero y no a la longitud del mismo, con hacer mov eax, [strvar] está moviendo el puntero del str hacia eax, lo mismo que hace StrPtr supongo.
Can you see it?
The worst is over
The monsters in my head are scared of love
Fallen people listen up! It's never too late to change our luck
So, don't let them steal your light
Don't let them break your stride
There is light on the other side
And you'll see all the raindrops falling behind
Make it out tonight
it's a revolution

CL!!!


Karcrack

Los VARIANT siguen esta estructura:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx

Las cadenas son BSTR:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms221069(v=vs.85).aspx
Y para obtener el puntero a su estructura real debes usar StrPtr().

Los tipos que utiliza VB6 en memoria se conocen como OLETypes. Internamente VB6 hace uso de funciones de OLEAUT32 para trabajar con ellos. Aquí tienes más información sobre éstos:
http://www.roblocher.com/whitepapers/oletypes.aspx

Saludos

Miseryk

#5
Gracias por su ayuda, creo que así está bien:

Modulo:
Código (vb) [Seleccionar]

Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Public Const PAGE_EXECUTE_READWRITE As Long = &H40&

Public Function GetMem(ByVal lpAddr As Long, ByVal pData As Long, ByVal dlen As Long) As Boolean
Dim lngOldProtect   As Long

If 0 = VirtualProtect(ByVal lpAddr, dlen, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
   Exit Function
End If

CopyMemory ByVal pData, ByVal lpAddr, dlen
VirtualProtect ByVal lpAddr, dlen, lngOldProtect, lngOldProtect

GetMem = True
End Function

Public Function PutMem(ByVal lpAddr As Long, ByVal pData As Long, ByVal dlen As Long) As Boolean
Dim lngOldProtect   As Long

If 0 = VirtualProtect(ByVal lpAddr, dlen, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
   Exit Function
End If

CopyMemory ByVal lpAddr, ByVal pData, dlen
VirtualProtect ByVal lpAddr, dlen, lngOldProtect, lngOldProtect

PutMem = True
End Function


Código (vb) [Seleccionar]

Option Explicit

'http://msdn.microsoft.com/en-us/library/aa263420(v=vs.60).aspx

'http://www.codeguru.com/vb/gen/vb_misc/algorithms/article.php/c7495/How-Visual-Basic-6-Stores-Data.htm

'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221069(v=vs.85).aspx
'http://www.roblocher.com/whitepapers/oletypes.aspx

Private Sub Form_Load()
Dim ESI(3 To 6) As Variant
Dim EDI(3 To 6) As Variant

Dim i As Byte

ESI(3) = "2NE1" '255 '32767 '2147483647
ESI(4) = "CL"
ESI(5) = "THE BADDEST FEMALE"
ESI(6) = "This is for all my bad girls around the world, Not bad meaning bad but bad meaning good u know, Let's light it up and let it burn like we don't care, Let em know how it feels damn good to be bad"

'For i = LBound(ESI) To UBound(ESI)
'    MsgBox i & ": " & (ESI(i) = EDI(i)) & vbCrLf & ESI(i) & " = " & EDI(i) & vbCrLf & "ESI: &H" & Hex(VarPtr(ESI(i))) & vbCrLf & "EDI: &H" & Hex(VarPtr(EDI(i)))
'Next i
'Stop

'Call PutMem(VarPtr(EDI(LBound(EDI))), VarPtr(ESI(LBound(ESI))), GetSizeArray(ESI))
Call PutMem(VarPtr(EDI(LBound(EDI))), VarPtr(ESI(LBound(ESI))), GetSizeArray(ESI)) '60 tmb

For i = LBound(ESI) To UBound(ESI)
   MsgBox i & ": " & (ESI(i) = EDI(i)) & vbCrLf & ESI(i) & " = " & EDI(i) & vbCrLf & "ESI: &H" & Hex(VarPtr(ESI(i))) & vbCrLf & "EDI: &H" & Hex(VarPtr(EDI(i)))
Next i
End
End Sub

Private Function GetSizeArray(ByRef vArray)
Dim BaseBytes As Byte

'MsgBox TypeName(vArray)

Select Case TypeName(vArray)
   Case "Byte()"
       BaseBytes = 1
   Case "Boolean()", "Integer()"
       BaseBytes = 2
   Case "Long()", "Single()"
       BaseBytes = 4
   Case "Double()", "Currency()", "Date()"
       BaseBytes = 8
   Case "Variant()"
       'The variant is 16 bytes large.
       'It has 2 bytes to describe the type of data it is storing, 6 reserved bytes, and 8 bytes to store the data (each block represents a byte).
       BaseBytes = 16
   Case "String()"
       BaseBytes = 4 'ReadMem del VarPtr está el Address al string con su len 4 bytes antes
End Select

GetSizeArray = BaseBytes * (UBound(vArray) - LBound(vArray) + 1)
End Function
Can you see it?
The worst is over
The monsters in my head are scared of love
Fallen people listen up! It's never too late to change our luck
So, don't let them steal your light
Don't let them break your stride
There is light on the other side
And you'll see all the raindrops falling behind
Make it out tonight
it's a revolution

CL!!!

Karcrack

No he podido probarlo porque estoy lejos del IDE, pero una recomendación es que uses VarType() en lugar de TypeName() para trabajar con constantes en lugar de cadenas :)

Miseryk

Sí, es mejor VarType, no lo hice así porque tenía pereza de crear constantes y asignarles ese número :D :D :D
Can you see it?
The worst is over
The monsters in my head are scared of love
Fallen people listen up! It's never too late to change our luck
So, don't let them steal your light
Don't let them break your stride
There is light on the other side
And you'll see all the raindrops falling behind
Make it out tonight
it's a revolution

CL!!!