PDA

View Full Version : [SOLVED] Wrapper for RtlMoveMemory



Paul_Hossler
11-03-2014, 07:54 PM
I was trying to modularize RtlMoveMemory so that I could pass 2 arrays to my wrapper function and it could do the validity checking and if it was safe, then let it copy the bytes

If I call CopyMemory inline, then it works

If I pass the 2 arrays to my function then Excel bombs out on the CopyMemory statement in the function

The VarPtr's before and after have different values, which I don't understand; I'd have thought that the standard ByRef call would pass the address of the array, and the CopyMemory inside the function would work with that.

What AM I missing???

Win7 64 bit and Excel 2010 32 bit




Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Sub test2()
Dim a1(1 To 100) As Long, a2(1 To 400) As Byte

Dim i As Long, j As Long

For i = 1 To 100
a1(i) = 10 * I
Next i
Debug.Print VarPtr(a1(1)), VarPtr(a2(1))
'Excel bombs out with this one. Order is Source then Destination
MsgBox ArrayCopy(a1, a2)

'completes OK with this. Order is Destination then Source
' Call CopyMemory(a2(1), a1(1), 400)


For i = 1 To 400
Debug.Print i, a2(i)
Next i
Stop
End Sub

Function ArrayCopy(Src As Variant, Dest As Variant) As Boolean
Dim iLenSrc As Long, iLenDest As Long
Debug.Print VarPtr(Src(LBound(Src))), VarPtr(Dest(LBound(Dest)))
On Error GoTo ErrHandler

If Not IsArray(Src) Then Call Err.Raise(vbObjectError + 1, "ArrayCopy", "Source is not an array")
If Not IsArray(Dest) Then Call Err.Raise(vbObjectError + 2, "ArrayCopy", "Destination is not an array")

iLenSrc = (UBound(Src) - LBound(Src) + 1) * pvtElementLen(Src)
If iLenSrc = 0 Then Call Err.Raise(vbObjectError + 3, "ArrayCopy", "Source array has elements that cannot be copied")

iLenDest = (UBound(Dest) - LBound(Dest) + 1) * pvtElementLen(Dest)
If iLenDest = 0 Then Call Err.Raise(vbObjectError + 4, "ArrayCopy", "Destination array has elements that cannot be copied")
If iLenSrc <> iLenDest Then Call Err.Raise(vbObjectError + 5, "ArrayCopy", "Source and Destnation arrays do not have the same number of bytes")

Stop

Call CopyMemory(Dest(LBound(Dest)), Src(LBound(Src)), iLenSrc)
ArrayCopy = True

Exit Function
ErrHandler:
With Err
Call MsgBox(.Description & " (Error #" & (.Number - vbObjectError) & ")", vbCritical + vbOKOnly, "Error - " & .Source)
End With

On Error GoTo 0

ArrayCopy = False
End Function

Private Function pvtElementLen(A As Variant) As Long
Select Case VarType(A) - vbArray
Case vbByte: pvtElementLen = 1
Case vbInteger: pvtElementLen = 2
Case vbLong: pvtElementLen = 4
Case vbSingle: pvtElementLen = 4
Case vbDouble: pvtElementLen = 8
Case vbCurrency: pvtElementLen = 8
Case vbDate: pvtElementLen = 8
Case vbDecimal: pvtElementLen = 12
Case Else: pvtElementLen = 0
End Select
End Function

Aflatoon
11-04-2014, 03:12 AM
The problem is that when you pass the arrays they get stored in internal Variant variables (if your function took arguments of the same type as the passed arrays, the code would work as is) and those are what your VarPtr points to. In order to get pointers back to the real arrays, you need to perform a few more steps:


Function ArrayCopy(Src, Dest) As Boolean Dim iLenSrc As Long
Dim iLenDest As Long
Dim n1 As Long
Dim n2 As Long


On Error GoTo ErrHandler


If Not IsArray(Src) Then Call Err.Raise(vbObjectError + 1, "ArrayCopy", "Source is not an array")
If Not IsArray(Dest) Then Call Err.Raise(vbObjectError + 2, "ArrayCopy", "Destination is not an array")


iLenSrc = (UBound(Src) - LBound(Src) + 1) * pvtElementLen(Src)
If iLenSrc = 0 Then Call Err.Raise(vbObjectError + 3, "ArrayCopy", "Source array has elements that cannot be copied")


iLenDest = (UBound(Dest) - LBound(Dest) + 1) * pvtElementLen(Dest)
If iLenDest = 0 Then Call Err.Raise(vbObjectError + 4, "ArrayCopy", "Destination array has elements that cannot be copied")
If iLenSrc <> iLenDest Then Call Err.Raise(vbObjectError + 5, "ArrayCopy", "Source and Destnation arrays do not have the same number of bytes")


' this will return the memory address of the internal Variant variables containing the input arrays
Debug.Print VarPtr(Src(LBound(Src))), VarPtr(Dest(LBound(Dest)))
' Now, get the real addresses of Src and Dest
' First get the location of the pointers in the Variants
CopyMemory n1, ByVal VarPtr(Src) + 8&, 4&
CopyMemory n2, ByVal VarPtr(Dest) + 8&, 4&
' Now find where that pointer points to
CopyMemory n1, ByVal n1, 4&
CopyMemory n2, ByVal n2, 4&
' And finally get the addresses where the arrays start
CopyMemory n1, ByVal n1 + 12&, 4&
CopyMemory n2, ByVal n2 + 12&, 4&


Debug.Print n1, n2


Stop


Call CopyMemory(ByVal n2, ByVal n1, iLenDest)
ArrayCopy = True


Exit Function
ErrHandler:
With Err
Call MsgBox(.Description & " (Error #" & (.Number - vbObjectError) & ")", vbCritical + vbOKOnly, "Error - " & .Source)
End With


On Error GoTo 0


ArrayCopy = False
End Function

Paul_Hossler
11-04-2014, 08:05 AM
Ahh -- I just figured that the default ByRef would take care of that somehow :banghead:




if your function took arguments of the same type as the passed arrays, the code would work as is)


It used to until I decided to 'improve' it to make it more general-purpose :doh:


Since you pointed me in the right direction, I was looking to Google a VBA reference that actually has the memory structure of variables (the simple ones -- Long, etc. -- are easy)

Have a link or reference?



FYI and FWIW -- this is my current working version

I still want to make it 64 bit safe, and to allow less than a full copy (if len Src <= len Dest then copy), so that'll give me something to do




Function ArrayCopy(ByRef Src As Variant, ByRef Dest As Variant) As Boolean
Const iOffsetOfPointer As Long = 8
Const iOffsetOfStructure As Long = 12

Dim iLenSrc As Long, iLenDest As Long
Dim ptrSrc As Long, ptrDest As Long
On Error GoTo ErrHandler

If Not IsArray(Src) Then Call Err.Raise(vbObjectError + 1, "ArrayCopy", "Source is not an array")
If Not IsArray(Dest) Then Call Err.Raise(vbObjectError + 2, "ArrayCopy", "Destination is not an array")

iLenSrc = (UBound(Src) - LBound(Src) + 1) * pvtElementLen(Src)
If iLenSrc = 0 Then Call Err.Raise(vbObjectError + 3, "ArrayCopy", "Source array has elements that cannot be copied")

iLenDest = (UBound(Dest) - LBound(Dest) + 1) * pvtElementLen(Dest)
If iLenDest = 0 Then Call Err.Raise(vbObjectError + 4, "ArrayCopy", "Destination array has elements that cannot be copied")
If iLenSrc <> iLenDest Then Call Err.Raise(vbObjectError + 5, "ArrayCopy", "Source and Destnation arrays do not have the same number of bytes")

' Now, get the real addresses of Src and Dest
' First get the location of the pointers in the Variants
Call CopyMemory(ptrSrc, ByVal VarPtr(Src) + iOffsetOfPointer, Len(ptrSrc))
Call CopyMemory(ptrDest, ByVal VarPtr(Dest) + iOffsetOfPointer, Len(ptrDest))

' Now find where that pointer points to
Call CopyMemory(ptrSrc, ByVal ptrSrc, Len(ptrSrc))
Call CopyMemory(ptrDest, ByVal ptrDest, Len(ptrDest))

' And finally get the addresses where the arrays start
Call CopyMemory(ptrSrc, ByVal ptrSrc + iOffsetOfStructure, Len(ptrSrc))
Call CopyMemory(ptrDest, ByVal ptrDest + iOffsetOfStructure, Len(ptrDest))

'copy the bytes
Call CopyMemory(ByVal ptrDest, ptrSrc, iLenDest)

ArrayCopy = True

Exit Function
ErrHandler:
With Err
Call MsgBox(.Description & " (Error #" & (.Number - vbObjectError) & ")", vbCritical + vbOKOnly, "Error - " & .Source)
End With

On Error GoTo 0

ArrayCopy = False
End Function



Thanks again :thumb

Aflatoon
11-04-2014, 11:10 AM
You really just need to make the declares PtrSafe I think.

Paul_Hossler
11-05-2014, 04:47 PM
The two variables in the function that represent addresses also need to use LongPtr I think



Dim ptrSrc As LongPtr, ptrDest As LongPtr


I don't have a 64 bit Office to test it on

Aflatoon
11-06-2014, 03:40 AM
Correct. It should be:

Option Explicit
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
Sub test2()
Dim a1(1 To 100) As Long, a2(1 To 400) As Byte

Dim i As Long, j As Long

For i = 1 To 100
a1(i) = 10 * i
Next i
Debug.Print VarPtr(a1(1)), VarPtr(a2(1))
'Excel bombs out with this one. Order is Source then Destination
MsgBox ArrayCopy(a1, a2)

'completes OK with this. Order is Destination then Source
' Call CopyMemory(a2(1), a1(1), 400)


For i = 1 To 400
Debug.Print i, a2(i)
Next i
Stop
End Sub
Function ArrayCopy(ByRef Src As Variant, ByRef Dest As Variant) As Boolean
Const iOffsetOfPointer As Long = 8
Const iOffsetOfStructure As Long = 12

Dim iLenSrc As Long, iLenDest As Long
#If VBA7 Then
Dim ptrSrc As LongPtr, ptrDest As LongPtr
#Else
Dim ptrSrc As Long, ptrDest As Long
#End If
On Error GoTo ErrHandler

If Not IsArray(Src) Then Call Err.Raise(vbObjectError + 1, "ArrayCopy", "Source is not an array")
If Not IsArray(Dest) Then Call Err.Raise(vbObjectError + 2, "ArrayCopy", "Destination is not an array")

iLenSrc = (UBound(Src) - LBound(Src) + 1) * pvtElementLen(Src)
If iLenSrc = 0 Then Call Err.Raise(vbObjectError + 3, "ArrayCopy", "Source array has elements that cannot be copied")

iLenDest = (UBound(Dest) - LBound(Dest) + 1) * pvtElementLen(Dest)
If iLenDest = 0 Then Call Err.Raise(vbObjectError + 4, "ArrayCopy", "Destination array has elements that cannot be copied")
If iLenSrc <> iLenDest Then Call Err.Raise(vbObjectError + 5, "ArrayCopy", "Source and Destnation arrays do not have the same number of bytes")

' Now, get the real addresses of Src and Dest
' First get the location of the pointers in the Variants
Call CopyMemory(ptrSrc, ByVal VarPtr(Src) + iOffsetOfPointer, Len(ptrSrc))
Call CopyMemory(ptrDest, ByVal VarPtr(Dest) + iOffsetOfPointer, Len(ptrDest))

' Now find where that pointer points to
Call CopyMemory(ptrSrc, ByVal ptrSrc, Len(ptrSrc))
Call CopyMemory(ptrDest, ByVal ptrDest, Len(ptrDest))

' And finally get the addresses where the arrays start
Call CopyMemory(ptrSrc, ByVal ptrSrc + iOffsetOfStructure, Len(ptrSrc))
Call CopyMemory(ptrDest, ByVal ptrDest + iOffsetOfStructure, Len(ptrDest))

'copy the bytes
Call CopyMemory(ByVal ptrDest, ptrSrc, iLenDest)

ArrayCopy = True

Exit Function
ErrHandler:
With Err
Call MsgBox(.Description & " (Error #" & (.Number - vbObjectError) & ")", vbCritical + vbOKOnly, "Error - " & .Source)
End With

On Error GoTo 0

ArrayCopy = False
End Function
Private Function pvtElementLen(A As Variant) As Long
Select Case VarType(A) - vbArray
Case vbByte: pvtElementLen = 1
Case vbInteger: pvtElementLen = 2
Case vbLong: pvtElementLen = 4
Case vbSingle: pvtElementLen = 4
Case vbDouble: pvtElementLen = 8
Case vbCurrency: pvtElementLen = 8
Case vbDate: pvtElementLen = 8
Case vbDecimal: pvtElementLen = 12
Case Else: pvtElementLen = 0
End Select
End Function