Yeah, you're quite right. Trying to do anything but view is difficult. I've been experiencing some pretty nasty crashes.
Printable View
Yeah, you're quite right. Trying to do anything but view is difficult. I've been experiencing some pretty nasty crashes.
You should be able to completely update and view the array contents in either array. If you are experiencing crashes, ensure you have the dimension bound descriptions correct. I purposely showed an example where the rows & columns were different values so you can see in what order the safearray members need to be added. Also note any other restrictions/warnings I mentioned in that previous post.
I have used these hacks for years. As an example, I have a routine that can receive an array of bytes, any LBound, any dimensions. I then hack the array to create an overlay that is zero bound, 1 or 2 dims as needed, to make looping easier and not dependent on the user supplied LBounds/dimensions. After updating the array, I simply remove the hack.
Yes, sorry I wasn't clear enough. They were brilliant for manipulation, copying, etc. I even managed a simple sort. But then I tried to use it as part of a function, and it didn't like it. You did warn me...
It's a terrible shame these don't work for strings by the way. Why is that? I know the elements are pointers in that case. But why should that make a difference?
Oddly, they work for variant strings, i.e. arrays of variants carrying strings
You can pass either array to a function. No crashes should occur and can't stess enough, the array cannot be resized while hacked.
Regarding strings.... VarPtrArray doesn't work with strings, but like all things there is almost always a workaround and here it is for strings.
More warnings.... This is about the only exception where the VarType of the two arrays will not be the same. One is String and the other is Long. Also, because the t array are longs, you cannot view the string contents. So t(1) = StrPtr(s(x,y)), but if needed for array manipulation, that is possible as shown in the example, swapping two strings.
Warning as usual: Memory hacks are always crash-potential if not done exactly correct.Code:Dim s() As String, t() As Long
Dim SA As SafeArray, ptr As Long
ReDim s(0 To 1, 0 To 4)
s(0, 0) = "LaVolpe"
s(1, 0) = "Visual Basic"
Debug.Print s(0, 0), s(1, 0)
' convert 2D string to 1D Long
With SA
.cbElements = 4
.cDims = 1
.pvData = VarPtr(s(0, 0))
.rgSABound(0).cElements = 10
.rgSABound(0).lLbound = 1
End With
CopyMemory ByVal VarPtrArray(t()), VarPtr(SA), 4&
ptr = t(2)
t(2) = t(1)
t(1) = ptr
CopyMemory ByVal VarPtrArray(t()), 0&, 4&
Debug.Print s(0, 0), s(1, 0)
You're a legend. I'm going to spend a bit of time looking at this tomorrow. But I get the feeling I'm going to use it a huge amount in some of the general utility stuff I write. Thank you so much for sharing it. The only thing I need to do to complete the picture is get it to work for a string array pointed to by a variant, like the ones we were talking about earlier. I thought I might be able to do this by passing the VarPtrArray function altogether. This was my attempt:
but it didn't actually do anything.Code:Sub Test()
'Define an array of doubles
Dim Dbl(1 To 4, 1 To 1) As Double
Dbl(1, 1) = 545.5432552
Dbl(2, 1) = 89042.42
Dbl(3, 1) = 545.5432552
Dbl(4, 1) = 1
'And parse it to a variant-taking procedure
Parse Dbl
End Sub
Sub Parse(v As Variant)
Dim vPtr As Long
'Let vPtr be the location of the [long] pointer in the variant
CopyMemory vPtr, ByVal VarPtr(v) + 8&, 4&
'Find out where that pointer is pointing to:
CopyMemory vPtr, ByVal vPtr, 4&
'...and this is where we put the overlay, so
Dim SA As SafeArray
With SA 'define new array description
.cbElements = 8 'bytes per array item
.cDims = 1 '1D array
.pvData = vPtr + 12 'location of 1st array element
.rgSABound(0).cElements = 200 ' 200 items
.rgSABound(0).lLbound = 1
End With
CopyMemory vPtr, VarPtr(SA), 4& ' set overlay
'Do funky stuff...
CopyMemory vPtr, 0&, 4& ' release overlay
End Sub
You're lucky it didn't crash... You need an uninitialized array for the hack to work, you are missing that...
Think of VarPtrArray as VarPtr for arrays. Really, that's all it is.Code:Sub Parse(v As Variant)
Dim tArray() As Double ' < added, same VarType as passed array
Dim vPtr As Long
'Let vPtr be the location of the [long] pointer in the variant
CopyMemory vPtr, ByVal VarPtr(v) + 8&, 4&
'Find out where that pointer is pointing to:
CopyMemory vPtr, ByVal vPtr, 4&
'...and this is where we put the overlay, so
Dim SA As SafeArray
With SA 'define new array description
.cbElements = 8 'bytes per array item
.cDims = 1 '1D array
' .pvData = vPtr + 12 'location of 1st array element
CopyMemory .pvData, ByVal vPtr+12, 4&
.rgSABound(0).cElements = 200 ' << don't default to 200, it must be same as total elements in passed array
.rgSABound(0).lLbound = 1
End With
' >>> fixed the CopyMemory calls
CopyMemory ByVal VarPtrArray(tArray), VarPtr(SA), 4& ' set overlay
'Do funky stuff... with tArray
CopyMemory ByVal VarPtrArray(tArray), 0&, 4& ' release overlay
End Sub
Edited: oops, you had .pvData incorrect, fixed now.
Right, right. By the way, I can't quite work out why it's not problematic to have two variables--i.e. the start of the t() and a() arrays--pointing to the same bit of memory. Isn't that a bit dodgy?
It is very dodgy, same problem if you had 2 variables pointing to the same string for the same reasons: If one gets erased/released, the other is now pointing to unused memory and when code tries to access the array item -- access violation. That is why the hack should be employed when needed and removed immediately when done.
So why not just save it in a temporary variable somewhere, ZeroMemory it after copying it across to t(), and then replace it when you're done (zeroing t)?
Why? 1 reason: speed. There is no equal-sized array created, no CopyMemory of xxx bytes per array element.
If speed isn't a concern, the safest way is to copy the array using NewArray()=OldArray(). But that doesn't support transposing arrays, so the safest is to create a new array with the desired dimensions and loop thru the OldArray, one item at a time and adding it to the NewArray().
But if different bounds are needed (transposing) and looping is undesirable, then copying with CopyMemory as we discussed in previous posts is probably the ticket. Of course if the array items were pointers (i.e., string/object arrays or variant arrays that contain strings/objects), you'd have to use ZeroMemory else you could simply Erase the array.
Sorry, that wasn't quite what I meant. I meant: isn't it dodgy to have just the 4 bytes copied in the following line
shared? If so, why not ZeroMemory the first 4 bytes of a() and then put them back afterwards. Wouldn't that make the whole thing a bit more stable? I guess not or someone would have done it. But it seems like it would.Code:CopyMemory ByVal VarPtrArray(tArray), VarPtr(SA), 4& ' set overlay
No, here you are messing with pointers not 4 bytes from the SA structure. The 4 bytes (Long) is the pointer to the SA variable in your code. The VarPtrArray of the Array points to a SafeArray structure. An unitialized array has a VarPtrArray value of zero, much like a null string has a StrPtr of zero. What that line is doing is overwriting the zero pointer with a pointer to the SA structure in the code. Therefore, VB thinks the array is initialized. As long as hack is in play, the uninitialized array acts like a sized, filled array.
Since the array is not really initialized and it definitely contains no data. When the hack is removed the zero is reapplied to the VarPtrArray location and VB now thinks the array is uninitialized and won't try to clear the array later.
Hi again. I think I know what you mean. What I was trying to suggest was: why not do it like this?
Isn't this safer? Or have I done something stupid?Code:Option Explicit
Private Type SABnd
nElmts As Long
nLBnd As Long
End Type
Private Type SafeArray 'http://msdn.microsoft.com/en-us/library/ms221482.aspx
nDims As Integer 'ArrayPtr +0: number of dimensions
fFlags As Integer ' +2: see link
nBytes As Long ' +4: number of bytes per array item
nLocks As Long ' +8: whether or not array is locked
nPtr As Long ' +12: pointer to first element in array
nBnds(0 To 1) As SABnd ' +16: pointer to last dim's count & LBound structure
End Type ' stored in right to left order
Sub faf()
Dim a() As Double, t() As Double
Dim SA As SafeArray
Dim x As Long, y As Long, c As Long
ReDim a(1 To 200, 1 To 1) ' size & populate actual data
For x = 1 To 200
c = c + 1
a(x, 1) = c * 2
Next x
With SA 'define new array description
.nBytes = 8 '4 bytes per array item
.nDims = 1 'Make 1D array
.nPtr = VarPtr(a(1, 1)) 'location of 1st array element
.nBnds(0).nElmts = 200 '200 items
.nBnds(0).nLBnd = 1 'LBound
End With
Dim Tmp As Long
'Store a's settings in Tmp
CopyMemory Tmp, ByVal VarPtrArray(a()), 4&
'Now zero a's and overlay t's
ZeroMemory ByVal VarPtrArray(a()), 4&
CopyMemory ByVal VarPtrArray(t()), VarPtr(SA), 4&
'Do all sorts of stuff with t here
'.................................
'Now zero t's and restore a's
ZeroMemory ByVal VarPtrArray(t()), 4&
CopyMemory ByVal VarPtrArray(a()), Tmp, 4&
ZeroMemory Tmp, 4&
End Sub
You can experiment, but I'd recommend against trying to swap SafeArray pointers. The SafeArray structure is more complicated than that. Depending on what the array contains, there can also be up to 16 bytes in front of that structure that are used to further describe the array & depends on the Features/Flags member of the structure. Might want to dig deeper into the link I provided.
And ZeroMemory does not release memory, it only fills the memory with zeros. So, you'd be leaking the bytes used by the structure.
Something else: How would you go about using some of the flags described here?
I don't understand the codes they use, e.g. FADF_BSTR 0x0100
The 0x0100 is a hex value, in vb it is &H100. So you could delcare:
Const FADF_BSTR As Long = &H100.
Flags are combined by using OR. X Or Y Or Z
A specific flag can be extracted to see if it exists:
If (Flags And FADF_BSTR) = FADF_BSTR then the flag is set else it is not.
Here is a project I wrote on PSC that attempted to help people better understand safearrays.
Wow. I shall read this with great interest. Thanks. By the way, if I can work out hnow to apply it, can that BSTR flag be used to help with the string conversion you coded for me above (where t() is set to longs)? Finally, what's "leaking" exactly?
The string example? Not sure, never attempted it. Strings/Objects are different obviously because of the pointers. Might consider handling arrays of pointers using previous methods of copying the array.
^^ Edited: I doubt you can do it. I told the safearray structure it contained strings by using the correct flags and also added the required data in the 1st 4 bytes before the SA structure. Since the overlay was declared as Long, vb still returns the strptr, not the string. Unfortunately, I know of no way to get the VarPtrArray of an uninitialized String array. I only know how to get the SA pointer for an initialized array, but the overlay requires the pointer to that pointer which is what VarPtrArray returns. I do recall that it is possible by creating a typelib -- saw it once on MSDN. At that point, I personally decided, it wasn't worth the trouble. I only mention it so you have some ideas of where to search if you get super curious.
Leaking. Ignore that, I misread what your example was doing.
Having 2 arrays pointing to the same .pvData is dodgy only if you resize either array. BTW: Using ZeroMemory for 4 bytes is same as CopyMemory dest, 0&, 4&
What you are doing isn't incorrect, but really not needed. No point in storing the value of VarPtrArray(a()), overwriting zero, then restoring the pointer. If your code attempted to access a() afterwards, you'd get an error because VB thinks the array is uninitialized. If both arrays are referencing the same data, you wouldn't get the error.
One more note that I made in previous posts. I strongly recommended keeping the VarTypes of both arrays the same. That is a good suggestion, however, there is one exception that works well for most VarTypes. If the overlay array is declared as Byte, then it becomes more or less universal. Here is another real-world example. In many projects I process pixel data from images. Sometimes the pixel data is an array of longs and sometimes bytes, depending on the need. Well if the array is Longs and I sent that array to a function that requires a byte array, I hack the long array, overlay with a byte array, do the manipulation needed, then remove the hack.
Right. I might have a quick go at doing everything with Byte arrays later then--once I've got things working with specific ones. By the way, how do you suggest best implementing all this? Suppose I've got a load of functions that work on 1d arrays. Obviously I don't want to put all sorts of overlay code at the start and end of each of them. So how best to implement this? A function?
What do you think, for instance, about the below? Is it dangerous, inefficient, or what? (I've made the input and output of the OverlayStr function variant because I want to build it up so it can handle strings, doubles, and genuine variants).
Edit: Actually, it's far from safe, so don't run it without saving your work! But I'm not sure quite why...
Code:Option Explicit
Public pLB1 As Long, pUB1 As Long
Public pLB2 As Long, pUB2 As Long
Public pnElmts As Long
Private Type SABnd
nElmts As Long
nLBnd As Long
End Type
Private Type SafeArr 'http://msdn.microsoft.com/en-us/library/ms221482.aspx
nDims As Integer 'ArrayPtr +0: number of dimensions
fFlags As Integer ' +2: see link
nBytes As Long ' +4: number of bytes per array item
nLocks As Long ' +8: whether or not array is locked
nPtrTo1stElmt As Long ' +12: pointer to first element in array
nBnds(0 To 1) As SABnd ' +16: pointer to last dim's count & LBound structure
End Type ' stored in right to left order
Sub SetBndVars(v As Variant)
pLB2 = -1: pUB2 = -1
pLB1 = LBound(v, 1): pUB1 = UBound(v, 1)
On Error Resume Next
pLB2 = LBound(v, 2): pUB2 = UBound(v, 2)
On Error GoTo 0
If pLB1 < pUB1 Or pLB2 = -1 Then
pnElmts = pUB1 - pLB1 + 1
Else
pnElmts = pUB2 - pLB2 + 1
End If
End Sub
Sub TestStr()
Dim s() As String
ReDim s(0 To 10, 1 To 1)
Dim i As Long
For i = 0 To 10
s(i, 1) = "ZZZZZZZZ"
Next i
Dim sRes() As String
sRes = OverlayStr(s)
End Sub
Function OverlayStr(v As Variant) As Variant
SetBndVars v
Dim LngOverlay() As Long
Dim vPtr As Long
'Let vPtr be the location of the [long] pointer in the variant
CopyMemory vPtr, ByVal VarPtr(v) + 8&, 4&
'Find out where that pointer is pointing to:
CopyMemory vPtr, ByVal vPtr, 4&
'...and this is where we put the overlay, so
Dim SA As SafeArr
With SA 'i.e. the new array description
.nBytes = 4 'bytes per array item
.nDims = 1 'number of dimensions
CopyMemory .nPtrTo1stElmt, ByVal vPtr + 12&, 4& 'location of 1st element in array
.nBnds(0).nElmts = pnElmts
.nBnds(0).nLBnd = 1
End With
CopyMemory ByVal VarPtrArray(LngOverlay), VarPtr(SA), 4&
Dim s() As String
ReDim s(1 To UBound(LngOverlay))
CopyMemory ByVal VarPtr(s(1)), LngOverlay(1), 4& * UBound(LngOverlay)
OverlayStr = s
CopyMemory ByVal VarPtrArray(LngOverlay), 0&, 4& ' release overlay
ZeroMemory ByVal vPtr + 12&, 4& * UBound(s)
End Function
Edited: You snuck a new post in on me while I was typing this response. Applies to post #80.
Are you still talking about transposing?
If so, there are some initial problems.
1. Using the hacks, your overlay should be same vartype, therefore, you'd need a bunch of unitialized arrays of various vartypes in the routine. Or create separate routines for specific vartype arrays.
2. If using a byte array as an overlay, then you'd have to use a variable for tracking position while moving x number of bytes, within the array. The tracking position is incremented/decremented depending on the vartype.
3. Previously discussed methods may be a better solution to transpose arrays; less headaches, less chance for errors.
4. Permanent transposition is quite a bit more difficult with overlays.
Overlays have their purpose. It is a handy way to transpose, temporarily, as you are attempting. Overlays can also be placed on other memory too, like DIB sections and strings. Overlays are a neat trick to convert a long array to byte temporarily. There are other real-world applications for overlays. But they are somewhat restricted as you are discovering -- use when needed, don't force its usage.
P.S. Here is an updated SafeArray project I never posted on PSC.
The reason your most recent post is unsafe is simple:
After the OverlayStr function returns, both s() & sRes() are filled, but both arrays are referencing the same string pointers, you can test this:
Debug.Print StrPtr(s(0,1)), StrPtr(sres(1))
So, as mentioned before, when VB destroys one array, it clears the strings. And when it goes to destroy the other array, the pointers are pointing to unused memory - crash! ZeroMemory one of the arrays.
Right, right. Can I do this as part of the function? I've had a go by correcting the original post. Is this any better? It certainly seems to be.
Yes, I modified your code a bit and added a function I use to get size of passed array.
Code:Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
Public pLB1 As Long, pUB1 As Long
Public pLB2 As Long, pUB2 As Long
Public pnElmts As Long
Private Type SABnd
nElmts As Long
nLBnd As Long
End Type
Private Type SafeArr 'http://msdn.microsoft.com/en-us/library/ms221482.aspx
nDims As Integer 'ArrayPtr +0: number of dimensions
fFlags As Integer ' +2: see link
nBytes As Long ' +4: number of bytes per array item
nLocks As Long ' +8: whether or not array is locked
nPtrTo1stElmt As Long ' +12: pointer to first element in array
nBnds(0 To 1) As SABnd ' +16: pointer to last dim's count & LBound structure
End Type ' stored in right to left order
Private Sub Command1_Click()
Dim s() As String
ReDim s(0 To 10, 1 To 1)
Dim i As Long
For i = 0 To 10
s(i, 1) = String(i + 1, "Z")
Next i
Dim sRes() As String
sRes = OverlayStr(s)
Erase s()
End Sub
Function OverlayStr(v As Variant) As Variant
Dim vPtr As Long, lSize As Long
Dim s() As String
'Let vPtr be the location of the [long] pointer in the variant
CopyMemory vPtr, ByVal VarPtr(v) + 8&, 4&
'Find out where that pointer is pointing to:
CopyMemory vPtr, ByVal vPtr, 4&
'...and this is where we put the overlay, so
lSize = ParseArrayProps(vPtr, 0&, vPtr)
ReDim s(1 To lSize)
CopyMemory ByVal VarPtr(s(1)), ByVal vPtr, 4& * lSize
ZeroMemory ByVal vPtr, lSize * 4&
OverlayStr = s()
End Function
Private Function ParseArrayProps(ByVal arrayPtr As Long, _
Optional Dimensions As Long, _
Optional FirstElementPtr As Long) As Long
' Function returns the overall size of the array or returns zero
' if the array is uninitialized or contains no elements
' Parameters
' ArrayPtr :: the address to the array's safearray structure
' Dimensions [out] :: number of dimensions for the array
' FirstElementPtr [out] :: basically VarPtr(first element of array)
Dim tSA As SafeArr
Dim lBounds() As Long
Dim X As Long, totalSize As Long
If arrayPtr = 0& Then Exit Function ' uninitialized array
CopyMemory ByVal VarPtr(tSA), ByVal arrayPtr, 16& ' safe array structure minus bounds info
Dimensions = tSA.nDims
FirstElementPtr = tSA.nPtrTo1stElmt
ReDim lBounds(1 To 2, 1 To Dimensions)
CopyMemory lBounds(1, 1), ByVal arrayPtr + 16&, Dimensions * 8&
totalSize = 1
For X = 1 To Dimensions
totalSize = totalSize * lBounds(1, X)
Next
ParseArrayProps = totalSize
End Function
I've deleted this post, as I'm taking a different approach now.
So I'm taking the following approach now, which seems to be working, and is making my coding a lot easier. So thanks tons for sharing this method.
Problem is, sometimes I want to parse arrays to functions by referencing them directly in Excel, e.g.Code:Option Explicit
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(pbDest As Any, pSource As Any, ByVal iLen As Long)
Public Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" _
(pbDest As Any, ByVal iLen As Long)
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" _
(ByRef Ptr() As Any) As Long
Public Type SABnd
nElmts As Long
nLBnd As Long
End Type
Public Type SafeArr 'http://msdn.microsoft.com/en-us/library/ms221482.aspx
nDims As Integer 'ArrayPtr +0: number of dimensions
fFlags As Integer ' +2: see link
nBytes As Long ' +4: number of bytes per array item
nLocks As Long ' +8: whether or not array is locked
nPtrTo1stElmt As Long ' +12: pointer to first element in array
nBnds(1 To 2) As SABnd ' +16: pointer to last dim's count & LBound structure
End Type ' stored in right to left order
Public Type Bnds
Elmts As Long
LB As Long
End Type
Public pOverlaySA As SafeArr
Public pInputSA As SafeArr
Public pPtrWiVar As Long
Public pInputRows As Bnds
Public pInputCols As Bnds
Public pnSize As Long
'User inputs
Public pbFull As Boolean
Public piCol As Long
Public pbDes As Boolean
'Internal parameter
Public pnLBIns As Long
'Stored from input
Public pnColLen As Long
Sub SetArrVars(ByRef vIn As Variant)
'Find the location of the underlying array
CopyMemory pPtrWiVar, ByVal VarPtr(vIn) + 8&, 4&
CopyMemory pPtrWiVar, ByVal pPtrWiVar, 4&
If pPtrWiVar = 0& Then Exit Sub
'Write its SafeArray structure to pInputSA
CopyMemory ByVal VarPtr(pInputSA), ByVal pPtrWiVar, 16&
'...and extract various data from it
If pInputSA.nDims = 1 Then
CopyMemory pInputRows, ByVal pPtrWiVar + 16&, 8&
pnSize = pInputRows.Elmts
Else
CopyMemory pInputCols, ByVal pPtrWiVar + 16&, 8&
CopyMemory pInputRows, ByVal pPtrWiVar + 24&, 8&
pnSize = pInputRows.Elmts * pInputCols.Elmts
End If
End Sub
Sub SetOverlayVars(ByRef vIn As Variant)
SetArrVars vIn
If pPtrWiVar = 0& Then Exit Sub
'Assign an pOverlaySA
With pOverlaySA
.nPtrTo1stElmt = pInputSA.nPtrTo1stElmt 'Make it point to the same array
.nBytes = pInputSA.nBytes 'Keep its number of bytes the same
.nDims = 1 'Make it 1d
.nBnds(1).nElmts = pnSize 'Make its no of elements the same
.nBnds(1).nLBnd = 1 'Make its lower bound 1
End With
End Sub
Public Sub InvArr(ByRef vIn() As Variant, Optional L As Long = -1, _
Optional R As Long = -1)
'Routine: to invert an array
SetOverlayVars vIn
Dim v() As Variant 'which will be the overlay
CopyMemory ByVal VarPtrArray(v), VarPtr(pOverlaySA), 4& 'set the overlay
Dim nStep
Dim nTmp(1 To 4) As Long
Dim i As Long, j As Long
If pInputSA.nDims = 1 Then nStep = pnSize Else nStep = pInputBnds(1, 2)
For i = 1 To pnSize Step nStep
For j = 1 To nStep \ 2
CopyMemory nTmp(1), ByVal VarPtr(v(i + j - 1)), 16&
CopyMemory ByVal VarPtr(v(i + j - 1)), _
ByVal VarPtr(v(i + nStep - j)), 16&
CopyMemory ByVal VarPtr(v(i + nStep - j)), nTmp(1), 16&
Next j
Next i
CopyMemory ByVal VarPtrArray(v), 0&, 4& 'remove the overlay
End Sub
and to do this I have to have my function in the formCode:v = SomeFn(Sheet1.UsedRange.Value)
as opposed toCode:Function SomeFn(vIn as Variant)
in which case I'm not sure where to find the relevant SafeArray structure, as it seems to error using the kind of routines I've used above.Code:Function SomeFn(vIn() as Variant)
P.S. Annoyingly, I haven't been able to view the zip file you sent me as I don't have VB. (I'm not too sure what VB is, to be honest. But all I have here is Excel and therefore VBA)
Function SomeFn(vIn as Variant)
Use the above if you are passing an array that can be of any vartype, including variants. Retrieve the SafeArray structure as shown in most recent posts.
Function SomeFn(vIn() as Variant)
Use above only if you are passing an array of Variants. You don't really need the safearray structure pointer. But if you did want it, use one of these two approaches:
Code:Private Function SafeArrayPointer(ByVal arrayvarptr As Long) As Long
' pass to this function: VarPtrArray(Array())
If arrayvarptr Then CopyMemory SafeArrayPointer, ByVal arrayvarptr, 4&
End Function
' this one looks wierd, but it works. The Debug.Assert is needed in VB to prevent potential
' errors resulting in a Not Not operation. How it works, I don't have the details. I also
' don't use this method very often, if at all -- nothing wrong with it that I know of.
Private Function SafeArrayPointer2(ByVal NotArrayPtr As Long) As Long
' pass to this function: Not Array()
SafeArrayPointer2 = Not NotArrayPtr
Debug.Assert App.hInstance
End Function
It seems to be the other way round with me. Using the code I posted above, for instance, the following works fine
but this crashes:Code:Sub TestDiffArrs()
Dim v() As Variant
v = Sheet1.UsedRange.Value
SetArrVars v
End Sub
Code:Sub TestDiffArrs()
Dim v As Variant
v = Sheet1.UsedRange.Value
SetArrVars v
End Sub
The reason you are crashing is probably because you removed the safety check I added in post #49. Check to see if the passed value is VT_BYREF. If it isn't, then you will crash when your code is expecting a pointer to a pointer, but what you got, instead, was just a pointer.
When you pass V as declared as an array, you will get VT_BYREF. But if not, you probably won't, even though V still contains an array.
Here is a simple test of what I am discussing. You will notice that each v and vv are passed to two different functions: one that returns an array of variants, and another that returns a variant array. Only when vv is declared as an array is it passed to the TestThis function with VT_BYREF:
Code:Private Sub Command1_Click()
Dim v As Variant
Dim vv() As Variant
v = ReturnVArray
testthis v
v = ReturnVArray2
testthis v
vv = ReturnVArray2
testthis vv
vv = ReturnVArray
testthis vv
End Sub
Private Function ReturnVArray() As Variant
Dim t() As Variant
ReDim t(0 To 1)
t(0) = 2009
ReturnVArray = t
End Function
Private Function ReturnVArray2() As Variant()
Dim t() As Variant
ReDim t(0 To 5)
t(0) = Me.Icon
ReturnVArray2 = t
End Function
Private Sub TestThis(v As Variant)
Dim vType As Long
CopyMemory vType, ByVal VarPtr(v), 2&
Debug.Print vType, UBound(v)
' if vType > 8300 then it is also VT_BYREF: (vType And &H4000)
End Sub
I see, I think. Which sorts out what I was trying to do. But I think it would be helpful (for me!) if I tried to explain what I've picked up from all this, and you (if you have the time) can tell me where/why I'm getting the wrong end of things. (P.S. I've got no background in any of this, so please bear with me if some of my lingo is a bit confused: it makes sense to me at least).
Variants are 16-byte variables. They tend to be made up of 4 longs. The 1st long specifies what kind of data the variant holds. And, if it's small enough, the 3rd and 4th long (i.e. the last 8 bytes) actually hold that data, e.g. a double. If the data is big, however--e.g. a string--then the 3rd long will be a pointer to the location of that string, i.e. to where it sits in the computer's memory.
Arrays are a different type of variable altogether. They start with something called a SafeArray structure. This can be of different sizes in different arrays (depending on its number of dimensions and stuff like that). We get info from by defining an appropriately sized Type (or Types) and then copying bits of the SafeArray structure into it (or them).
When arrays are parsed, they can be parsed in different ways. One way is as an array of variants. In such cases, the 3rd long of the variant points to the location where the array begins, i.e. to the location of the array's SafeArray structure. In such cases, we can work out where the SA is located as follows.
Other times, however, arrays are passed differently, i.e. as variant arrays. (To receive an array in this form, a routine needs to be of the form "Routine(vIn as Variant)" as opposed to "Routine(vIn() as Variant)"). In such cases, the 3rd long of the variant points, not to the location of the underlying array, but to a pointer that points to that location. If arrays are parsed in this way, then the first two bytes of the variant holding them are equal to 24588 (I don't know why, but I couldn't get your VarType-based way of identifying them to work). This means we need to get the location of the relevant SafeArray as follows.Code:Dim nLocOfSA as Long
CopyMemory nLocOfSA, ByVal VarPtr(vIn) + 8&, 4&
(noting that we use ByVal here because we want to refer, not to the memory stored at that location, but to the value of the pointer) meaning a routine that will cater for both ways in which an array can be parsed can be put together as follows:Code:CopyMemory nLocOf1stPtr, ByVal VarPtr(vIn) + 8&, 4&
CopyMemory nLocOfSA, ByVal nLocOf1stPtr, 4&
Is this vaguely along the right lines? And how does the VarPtrArray call fit into this? I can't quite work out what it does.Code:nVarType = CopyMemory vType, ByVal VarPtr(v), 2&
CopyMemory nPtr, ByVal VarPtr(vIn) + 8&, 4&
If nVarType = 24588 Then CopyMemory nPtr, ByVal nPtr, 4&
You are more in-tune than not. Great reference, suggest bookmarking it
Variants can be considered not as 4 longs, but 2 integers, long, double-ish (8 bytes)
: 1st integer: VarType
: 2nd integer & Long: Not sure exactly what they are used for
: Double-ish: Depends on VarType
-- numeric: Byte, Long, Double, Currency, etc, then contains actual value
-- object reference, string, array: ObjPtr, StrPtr, SafeArray Ptr respectively
-- If VarType contains flag &H4000 (16384) then the pointer is a pointer to a pointer
To see if a pointer to a pointer is in play
When would you expect a pointer to pointer scenario? You can't be sure, so it is always best to test. If you have control over the variable (i.e., being passed to your code from within your code), then if the function uses a variant parameter ByRef and an array is passed, you should get VT_BYREF. However if variant parameter is ByVal then no VT_BYREF 'cause array is a copy now. There are various scenarios, so I wouldn't hardcode expectations of getting a pointer to pointer or just a pointer -- test always if it matters.Code:Const VT_BYREF As Long = &H4000
CopyMemory vType, ByVal VarPtr(VariantVar), 2&
If (vType And VT_BYREF) Then ' pointer to a pointer else not
Now what is 24588? You should learn a little about how flags are stored in a Long variable (i.e., ORing, bitshifting, etc). This is what 24588 really is, using both Hex/Decimal annotation
&H4000 = (16384) = VT_BYREF
&H2000 = (8192) = vbArray
&H000C = (12) = vbVariant
----------------------------
&H600C = (24588) = VT_BYREF Or vbArray Or vbVariant
So, the vartype indicates the Variant has pointer to pointer (VT_BYREF), and that far pointer is a safearray pointer (vbArray) and that array contains variant entries (vbVariant)
VarPtrArray is extremely useful when wanting or needing to apply array overlays as discussed previously, by showing the memory location of pointer to the array's safearray pointer. It can also be used to get the safearray pointer, but this can also be done without the API as shown in post 88.
I know you don't have VB, but if you unzip the safearray project I gave you, copy & paste the code (open files in Notepad) into VBA, you'd at least be able to follow the code. In reality, if you simply add a listbox and textboxes, you should be able to create the form in VBA so you can play with the code. That project can help you better understand what the SafeArray/Variant can contain, along with the links I provided earlier.
Thanks. Makes sense. Thanks for the link too. A really good read. As well as explaining a lot of stuff to me, it alerted me to the fact that I've incorrectly been treating Variants as being made up of 4 4-byte sections as opposed to a 2-, a 6-, and an 8-byte section. In fact, on occasion, I've prepared Variants to take, say, strings by using something like CopyMemory ByVal VarType(vIn(1)), 8&, 4&, which is clearly wrong. And, if I understand the article correctly (which is a fairly questionable assumption, but anyway...), then I only got away with this because the Variant fills from left to right, and longs, like integers, are in little-endian format. (Though this could be a completely bogus explanation that I've convinced myself works).
Regarding the flags stuff you wrote, I thought this was making sense to me. But then I didn't understand why you wrote
as opposed toCode:&H600C = (24588) = VT_BYREF Or vbArray Or vbVariant
at the end, so perhaps I don't understand it after all. I've been looking through your project too. I haven't really investigated UserForms, but I'll do some googling and see how easy it is (for me) to make a VBA version of what you've done.Code:&H600C = (24588) = VT_BYREF And vbArray And vbVariant
Thanks again, James.
Here is a link to Wikipedia that describes Or And Not XOR pretty well I think. After reading you will see that OR is correct and AND is not correct.
You could also test the equation in the immediate window.
So I thought I was starting to get my head round all this, and then I tried the following
and Excel crashed. I can't immediately (or even over a long period of time for that matter) see what's wrong here.Code:Sub Trial
Dim vStr as variant
vStr = "This,That,The other"
Dim v as variant
v = fFlip(split(vStr, ","))
end fub
function fFlip(byref vIn as variant) as variant
dim sTmp() as string
redim sTmp(0 to 2, 0 to 0)
copymemory byval VarPtr(sTmp(0, 0)), byval varptr(vIn(0)), 12
end function
Reference post 49
When using CopyMemory, you can't go wrong by checking what vartype exists in passed variant.
Because of the vartype contained, you need to get the StrPtrs from the SafeArray structureCode:Dim I as Integer
CopyMemory I, ByVal VarPtr(vIn), 2&
' I, in this case, returns 8200: vbArray + vbString
In post 49, I also mentioned that in these cases, VarPtr(vIn(0)) actually points to another solo Variant that is used/re-used for each string in the passed array. So you will see that VarPtr(vIn(0))=VarPtr(vIn(1))=VarPtr(vIn(2)), etc. You are crashing because the the 12 bytes you are copying are 12 of the 16 bytes from that reusable Variant. They are not StrPtrs. When sTmp() items are referenced, the values you copied into them are not StrPtrs and system is crashing when trying to resolve what it believes are pointers but are really not.
Partial proof and depends on how the array items are referenced in the line of execution:
Again, review Post 49.Code:' all return the same value
Debug.Print VarPtr(vIn(0))
Debug.Print VarPtr(vIn(1))
Debug.Print VarPtr(vIn(2))
' all return different values, but they are each variants, that contain strings. They are not strings
Debug.Print VarPtr(vIn(0)); VarPtr(vIn(1)); VarPtr(vIn(2))
Also, even if it did work, you'd probably crash anyway, cause you'd have two arrays that would be referencing the same StrPtrs. That's a big no-no. One array would have to zeroed out.
Right, thanks. I got/remembered the stuff about pointers pointing to other pointers and not having two variables pointing to the same place and so on. I just misunderstood (and still don't fully understand) the flag-related stuff--e.g. (VarType(v) And Not vbArray)--you were talking about, so I was doing the wrong checks on the variables I was parsing (the stuff I posted was very abbreviated to show the crash: I should probably have posted the whole thing). Anyway, I think I know what I'm doing now (though I still need to read up on flags). Meanwhile, I'm having some problems getting the pointer for the first element of a non-parsed array. That is, suppose I do something like
so the first element of vTmp could be vTmp(0, 0) or vTmp(1) or vTmp(2, 4, 6) depending on prior conditions. Is there an easy way of finding the pointer to its first element, so I can doCode:dim vTmp() as variant
if X then redim vTmp(like this) else redim vTmp(some other way)
I tried using the functions in your post of Aug 3rd, 2009 02:20 PM, but couldn't get the answers I was after from them.Code:CopyMemory byval Ptr,....
It's OK. I think I was being an idiot. I can do it like this right?
Code:Private Function PtrTo1stElmt(ByVal VPArr As Long) As Long 'where VPArr = VarPtrArr(vArr())
Dim SAPtr As Long
If VPArr Then CopyMemory SAPtr, ByVal VPArr, 4&
CopyMemory PtrTo1stElmt, ByVal SAPtr + 12&, 4&
End Function
Looks ok to me, assuming vArr contains an array and is not VT_BYREF.
I believe I stressed this often and will stress it one more time. If you are going to hack/navigate from a Variant, always check the 1st 2 bytes of the Variant with CopyMemory, not VB's VarType() function. VB's function doesn't tell you if the Variant is VT_BYREF or not. If it is VT_BYREF, you have a pointer to a pointer to the safearray (refresh your memory from previous posts if needed). Based on the contents of the Variant, apply the correct code for navigating/hacking its content/pointer.
Right. Though I should be fairly safe (I think) as VarPtrArr won't accept a VT_BYREF. Or at least it won't the way I'm trying to do it. I don't know if this is because I've declared it strangely. But it's actually quite helpful.Code:Looks ok to me, assuming vArr contains an array and is not VT_BYREF.
By the way, if I'm using a function or routine to find pointers for me, then I always want to parse ByVal: else my pointers won't be valid when I return to the main routine. Is that right?
Two things.
1. VarPtrArr? What is that, do you mean VarPtrArray API? Or did you mean VarPtr(Variant) when Variant holds an array? From your last post, I assumed VarPtrArray when I replied last.
2. I also assume you meant pass ByVal, not parse ByVal. And I don't know what you are passing; you didn't explain that. Pointers are only invalid when what they point to are released.
If you are building an array to be returned and used CopyMemory to copy the pointers from one array to the other array, you'll have 2 arrays referencing same pointers and don't want to do that. In that case, one array must be zeroed out before either array is modified further, including going out of scope, resizing, editing, erasing.
If you are building an array from another array using simple VB, then there is no fear regarding duplicate pointers: i.e., MyArray(x) = MyOldArray(2,0). This is because MyArray(x) is now a copy (and a different pointer if a string) or if an object then MyArra(x) had its reference count incremented.
Tweaked your function with comments
And final note about VarPtrArray(). It really isn't necessary to use the API unless you need the SafeArray pointer of an uninitialized array; otherwise the function a bit overkill. If VarPtrArray() can't be used with VT_BYREF, then simply use this instead: VarPtr(someArray). But if you are passing VPArr as a result from getting it via the memory address at VarPtr(variantWithArray)+8 {check for VT_BYREF with those), then the function is useful.Code:Private Function PtrTo1stElmt(ByVal VPArr As Long) As Long 'where VPArr = VarPtrArray(vArr())
Dim SAPtr As Long
If VPArr Then
CopyMemory SAPtr, ByVal VPArr, 4&
' Don't try to use CopyMemory on SAPtr if it is zero. If passing VarPtrArray(uninitializedArray()), it will be zero
If SAPtr Then CopyMemory PtrTo1stElmt, ByVal SAPtr + 12&, 4&
End If
End Function
OK. So here's where I'm at with a sort of Transpose substitute, a function that will "flip" a column/row to a true 1d array and vice-versa. If you can spare the time to look through it, I'd be grateful for any improvements/safeguards you can suggest:
Code:Option Explicit
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(pbDest As Any, pSource As Any, ByVal iLen As Long)
Public Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" _
(pbDest As Any, ByVal iLen As Long)
Public Declare Function VarPtrArr Lib "msvbvm60.dll" Alias "VarPtr" _
(ByRef Ptr() As Any) As Long
Private Type SABnds
Elmts As Long
LB As Long
End Type
Private Type SA 'http://msdn.microsoft.com/en-us/library/ms221482.aspx
nDims As Integer 'ArrPtr +0: number of dimensions
fFlags As Integer ' +2: see link
nBytes As Long ' +4: number of bytes per array item
nLocks As Long ' +8: whether or not array is locked
nPtrTo1stElmt As Long ' +12: pointer to first element in array
nBnds(1 To 2) As SABnds ' +16: pointer to last dim's count & LBound structure
End Type ' stored in Right to Left order
Public Function fFlip(ByRef vIn As Variant, _
Optional bVer As Boolean = True) As Variant
Dim vInPtrToSA As Long, vInSA As SA, vInRows As SABnds, vInCols As SABnds
vInPtrToSA = PtrToSA(vIn) 'Locate vIn's SA structure
CopyMemory ByVal VarPtr(vInSA), ByVal vInPtrToSA, 16& 'Load it up to vInSA
Dim nSize As Long
If vInSA.nDims = 1 Then 'The array is 1d, so the first
CopyMemory vInRows, ByVal vInPtrToSA + 16&, 8& '8 bytes (since the SA end
nSize = vInRows.Elmts 'fills from R to L) details
Else 'the array's row dims.
CopyMemory vInCols, ByVal vInPtrToSA + 16&, 8& 'Otherwise, it details column
CopyMemory vInRows, ByVal vInPtrToSA + 24&, 8& 'dims and the next 8 bytes
nSize = vInRows.Elmts * vInCols.Elmts 'detail rows
End If
Dim vTmp As Variant 'Prepare a temporary array
vTmp = vIn 'to store the output
If vInSA.nDims = 1 Then 'vIn is 1d, so make
ReDim vTmp(vInRows.LB To (vInRows.LB + vInRows.Elmts) - 1, _
vInRows.LB To vInRows.LB) 'the output vertical
ElseIf vInCols.Elmts = 1 Then 'vIn is vertical, so...
ReDim vTmp(vInRows.LB To vInRows.LB + vInRows.Elmts - 1)
ElseIf vInRows.Elmts = 1 Then 'vIn is horizontal, so...
If bVer Then '(by default) make the output
ReDim vTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1, _
vInRows.LB To vInRows.LB) 'vertical; if specified
Else 'otherwise, make it 1d
ReDim vTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1)
End If
End If
CopyMemory ByVal PtrTo1stElmt(vTmp), _
ByVal vInSA.nPtrTo1stElmt, vInSA.nBytes * nSize 'Copy the contents to vTmp
fFlip = vTmp 'Assign the function output
ZeroMemory ByVal PtrTo1stElmt(vTmp), vInSA.nBytes * nSize 'Zero the (double-pointed)
End Function 'vTmp
Private Function PtrTo1stElmt(ByRef vIn As Variant) As Long 'Check there's an SA Ptr
If PtrToSA(vIn) Then CopyMemory PtrTo1stElmt, _
ByVal PtrToSA(vIn) + 12&, 4& 'Its 12th byte is then the
End Function 'location of the 1st elmt.
Private Function PtrToSA(ByRef vIn As Variant) As Long
Dim nVarType As Integer
If (VarType(vIn) And vbARRAY) Then 'The input is an array, so:
CopyMemory nVarType, ByVal VarPtr(vIn), 2& 'Determine its type, and
CopyMemory PtrToSA, ByVal VarPtr(vIn) + 8&, 4& 'Find out where it points.
If (nVarType And VT_BYREF) Then 'the array points to a ptr,
CopyMemory PtrToSA, ByVal PtrToSA, 4& 'so find out where THAT
End If 'pointer points to.
End If
End Function
I suppose setting vTmp = vIn is a grossly inefficient move since I just get rid of all the copied data. But otherwise I have to declare different arrays for all sorts of different datatypes and so on, which seems a bit clumsy.
Ok, had some time to look over the code and validate some things...
Though it may work for you, you probably can improve on it a bit.
The line "vTmp = vIn" copies the passed array. VB is allocating memory for each item (string, object, etc).
The lines "ReDim vTmp" is creating a new array, all with null strings, if array contained strings.
The line "fFlip = vTmp" copies the passed array. VB is allocating memory for each item (string, object, etc).
So by the time you get thru that function, you have created 3 other arrays, 2 copies, 1 new one. I'd like to offer better solutions, but at the moment am tied up with another project of mine. If I had the time, I'd definitely look into the SafeArrayXXXX APIs (i.e., SafeArrayAllocateDescriptorEx, SafeArrayCreateEx, etc). I think the most efficient way to do this may not even be with CopyMemory, but rather creating a new SafeArray using APIs, assigning the SafeArray to the passed array (rewriting pointers) and then destroying the old SafeArray, again using APIs like SafeArrayDestroyDescriptor. In that way, you are not even messing with the source data at all.
How about this then (the difference being the last few lines)? Course, this only works for arrays of variants now.
This seems to work, and at least gets rid of one of the copies. Regarding the SafeArrayXXXX functions, do you know of any decent links that explain them? My googling hasn't turned up much.Code:Public Function fFlip(ByRef vIn As Variant, _
Optional bVer As Boolean = True) As Variant
Dim vInPtrToSA As Long
Dim vInSA As SA, vInRows As SABnds, vInCols As SABnds
vInPtrToSA = PtrToSA(vIn) 'Locate vIn's SA structure
CopyMemory ByVal VarPtr(vInSA), ByVal vInPtrToSA, 16& 'Load it up to vInSA
Dim nSize As Long
If vInSA.nDims = 1 Then 'The array is 1d, so the first
CopyMemory vInRows, ByVal vInPtrToSA + 16&, 8& '8 bytes (since the SA end
nSize = vInRows.Elmts 'fills from R to L) details
Else 'the array's row dims.
CopyMemory vInCols, ByVal vInPtrToSA + 16&, 8& 'Otherwise, it details column
CopyMemory vInRows, ByVal vInPtrToSA + 24&, 8& 'dims and the next 8 bytes
nSize = vInRows.Elmts * vInCols.Elmts 'detail rows
End If
Dim vTmp() As Variant 'Prepare a temporary array
If vInSA.nDims = 1 Then '..vIn is 1d, so make
ReDim vTmp(vInRows.LB To (vInRows.LB + vInRows.Elmts) - 1, _
vInRows.LB To vInRows.LB) 'the output vertical
ElseIf vInCols.Elmts = 1 Then '..vIn is vertical, so:
ReDim vTmp(vInRows.LB To vInRows.LB + vInRows.Elmts - 1)
ElseIf vInRows.Elmts = 1 Then 'vIn is horizontal, so
If bVer Then '(by default) make the output
ReDim vTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1, _
vInRows.LB To vInRows.LB) 'vertical; if specified
Else 'otherwise, make it 1d
ReDim vTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1)
End If
End If
CopyMemory ByVal PtrToSA(vTmp) + 12&, _
ByVal PtrToSA(vIn) + 12&, 4& 'Point vTmp to vIn's data
fFlip = vTmp 'Assign the function output
Dim vTmpDims As Integer
CopyMemory vTmpDims, ByVal PtrToSA(vTmp), 2&
ZeroMemory ByVal PtrToSA(vTmp), 16& + (8 * vTmpDims)
End Function
Here is the MSDN page. Look at the left hand side to navigate to the various APIs.
http://msdn.microsoft.com/en-us/library/ms221145.aspx
Here are the API's declaration pulled from the API Viewer
Code:Private Declare Sub SafeArrayAccessData Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef ppvData As Any)
Private Declare Sub SafeArrayAllocData Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32.dll" (ByVal cDims As Long, ByRef ppsaOut As SAFEARRAY)
Private Declare Sub SafeArrayAllocDescriptorEx Lib "oleaut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef ppsaOut As SAFEARRAY)
Private Declare Sub SafeArrayCopy Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef ppsaOut As SAFEARRAY)
Private Declare Sub SafeArrayCopyData Lib "oleaut32.dll" (ByRef psaSource As SAFEARRAY, ByRef psaTarget As SAFEARRAY)
Private Declare Function SafeArrayCreate Lib "oleaut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As Long
Private Declare Function SafeArrayCreateEx Lib "oleaut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND, ByRef pvExtra As Any) As Long
Private Declare Function SafeArrayCreateVector Lib "oleaut32.dll" (ByVal vt As Integer, ByVal lLbound As Long, ByVal cElements As Long) As Long
Private Declare Function SafeArrayCreateVectorEx Lib "oleaut32.dll" (ByVal vt As Integer, ByVal lLbound As Long, ByVal cElements As Long, ByRef pvExtra As Any) As Long
Private Declare Sub SafeArrayDestroy Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
Private Declare Sub SafeArrayDestroyData Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
Private Declare Sub SafeArrayDestroyDescriptor Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef psa As SAFEARRAY) As Long
Private Declare Sub SafeArrayGetElement Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef rgIndices As Long, ByRef pv As Any)
Private Declare Function SafeArrayGetElemsize Lib "oleaut32.dll" (ByRef psa As SAFEARRAY) As Long
Private Declare Sub SafeArrayGetIID Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef pguid As GUID)
Private Declare Sub SafeArrayGetLBound Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByVal nDim As Long, ByRef plLbound As Long)
Private Declare Sub SafeArrayGetRecordInfo Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef prinfo As Long)
Private Declare Sub SafeArrayGetUBound Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByVal nDim As Long, ByRef plUbound As Long)
Private Declare Sub SafeArrayGetVartype Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef pvt As Integer)
Private Declare Sub SafeArrayLock Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
Private Declare Sub SafeArrayPtrOfIndex Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef rgIndices As Long, ByRef ppvData As Any)
Private Declare Sub SafeArrayPutElement Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef rgIndices As Long, ByRef pv As Any)
Private Declare Sub SafeArrayRedim Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef psaboundNew As SAFEARRAYBOUND)
Private Declare Sub SafeArraySetIID Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByVal guid As Long)
Private Declare Sub SafeArraySetRecordInfo Lib "oleaut32.dll" (ByRef psa As SAFEARRAY, ByRef prinfo As Long)
Private Declare Sub SafeArrayUnaccessData Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
Private Declare Sub SafeArrayUnlock Lib "oleaut32.dll" (ByRef psa As SAFEARRAY)
I've extended the above to strings as follows
But I think you're right about using the SafeArray API calls. The reason my code has to be so tedious is because I don't know how to create SafeArrays from scratch. By the way, I couldn't get the link you sent to work. I find this with a lot of Microsoft's links. Is it because I'm using Safari?Code:Public Function fFlip(ByRef vIn As Variant, _
Optional bVer As Boolean = True) As Variant
Dim vInPtrToSA As Long
Dim vInSA As SA, vInRows As SABnds, vInCols As SABnds
vInPtrToSA = PtrToSA(vIn) 'Locate vIn's SA structure
CopyMemory ByVal VarPtr(vInSA), ByVal vInPtrToSA, 16& 'Load it up to vInSA
Dim nSize As Long
If vInSA.nDims = 1 Then 'The array is 1d, so the first
CopyMemory vInRows, ByVal vInPtrToSA + 16&, 8& '8 bytes (since the SA end
nSize = vInRows.Elmts 'fills from R to L) details
Else 'the array's row dims.
CopyMemory vInCols, ByVal vInPtrToSA + 16&, 8& 'Otherwise, it details column
CopyMemory vInRows, ByVal vInPtrToSA + 24&, 8& 'dims and the next 8 bytes
nSize = vInRows.Elmts * vInCols.Elmts 'detail rows
End If
If vInSA.nBytes = 16 Then
Dim vTmp As Variant 'Dimension a temporary array
If vInSA.nDims = 1 Then '..vIn is 1d, so make
ReDim vTmp(vInRows.LB To (vInRows.LB + vInRows.Elmts) - 1, _
vInRows.LB To vInRows.LB) 'the output vertical
ElseIf vInCols.Elmts = 1 Then '..vIn is vertical, so:
ReDim vTmp(vInRows.LB To vInRows.LB + vInRows.Elmts - 1)
ElseIf vInRows.Elmts = 1 Then 'vIn is horizontal, so
If bVer Then '(by default) make the output
ReDim vTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1, _
vInRows.LB To vInRows.LB) 'vertical; if specified
Else 'otherwise, make it 1d
ReDim vTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1)
End If
End If
CopyMemory ByVal PtrToSA(vTmp) + 12&, _
ByVal vInPtrToSA + 12&, 4& 'Point vTmp to vIn's data
fFlip = vTmp 'Assign the function output
Dim vTmpDims As Integer
CopyMemory vTmpDims, ByVal PtrToSA(vTmp), 2&
ZeroMemory ByVal PtrToSA(vTmp), 16& + (8 * vTmpDims)
ElseIf vInSA.nBytes = 4 Then
Dim sTmp() As String 'Dimension a temporary array
If vInSA.nDims = 1 Then '..vIn is 1d, so make
ReDim sTmp(vInRows.LB To (vInRows.LB + vInRows.Elmts) - 1, _
vInRows.LB To vInRows.LB) 'the output vertical
ElseIf vInCols.Elmts = 1 Then '..vIn is vertical, so:
ReDim sTmp(vInRows.LB To vInRows.LB + vInRows.Elmts - 1)
ElseIf vInRows.Elmts = 1 Then 'vIn is horizontal, so
If bVer Then '(by default) make the output
ReDim sTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1, _
vInRows.LB To vInRows.LB) 'vertical; if specified
Else 'otherwise, make it 1d
ReDim sTmp(vInCols.LB To vInCols.LB + vInCols.Elmts - 1)
End If
End If
CopyMemory ByVal PtrToSA(sTmp) + 12&, _
ByVal vInPtrToSA + 12&, 4& 'Point sTmp to vIn's data
fFlip = RetAsByRef(sTmp) 'Return sTmp as a ByRef
Dim sTmpDims As Integer
CopyMemory sTmpDims, ByVal PtrToSA(sTmp), 2&
ZeroMemory ByVal PtrToSA(sTmp), 16& + (8 * sTmpDims)
End If
End Function
Function RetAsByRef(vIn As Variant) As Variant
RetAsByRef = vIn
End Function
Hmmm, there's some stuff embedded into that link. recommend typing in vs clicking it?
James, had some time to kill.
Try this in a new project. Recommend playing with it in a new project until you think you've got it. Note that I did tweak some of the API declarations...
I think you can follow the comments. I haven't tested this thoroughly. I don't know what will happen when you pass the array via variants -- probably nothing should happen, but... I'll let you do the crashing ;)
If you have any issues, write back and I'll follow up this weekend.
The below works with numerical vartypes (i.e., long, byte, integer, etc). Haven't tried it with dates, strings, or variants
P.S. I've never used those SafeArray APIs before, self-teaching myself too.Code:Option Explicit
Private Declare Function SafeArrayCreateEx Lib "oleaut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND, ByRef pvExtra As Any) As Long
Private Declare Sub SafeArrayDestroyDescriptor Lib "oleaut32.dll" (ByRef psa As Any)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
Private Type SAFEARRAYBOUND
Elmts As Long
LB As Long
End Type
Private Sub Command1_Click()
Dim b() As Long
Dim x As Long, y As Long
' we start with a 2D array, 20 total elements
' Don't modify array size; for quick example, the 20 elements are hardcoded in the flipIt routine
ReDim b(1 To 2, 1 To 10)
For y = 1 To 10
For x = 1 To 2
b(x, y) = Int(Rnd * 2009) ' fill it with rnd values
Debug.Print b(x, y);
Next
Next: Debug.Print
If flipIt(b()) Then
' test it out, do we really have a 1D array now?
For x = 0 To 19
Debug.Print b(x);
Next: Debug.Print
End If
End Sub
Private Function flipIt(inData() As Long) As Boolean
Dim sab As SAFEARRAYBOUND
Dim ptrNew As Long, ptrOld As Long
'for the new array, how many elements do we want?
'make a 1D array with 20 elements {{ hardcoded here; obviously it should be calculated }}
sab.Elmts = 20
'next line says content is 4 bytes per element (vbLong), 1 dimension, and pass the bounds
' must change vbLong, as needed, to other variable types in VB's enumeration: vbVarType
' i.e., vbByte, vbString, vbVariant, etc
ptrNew = SafeArrayCreateEx(vbLong, 1, sab, ByVal 0&)
If ptrNew Then ' success?
' get safe array pointer to the current array
CopyMemory ptrOld, ByVal VarPtrArray(inData), 4&
' copy the pvData from the old array to the new array
CopyMemory ByVal ptrNew + 12, ByVal ptrOld + 12, 4&
' destroy the old safearray structure -- do not reference array() here!!!!
Call SafeArrayDestroyDescriptor(ByVal ptrOld)
' now replace old safearray pointer with the new safearray pointer
CopyMemory ByVal VarPtrArray(inData), ptrNew, 4&
flipIt = True
End If
End Function
Edited: I just tried with strings and crashed. Strings are different and need to think on it.
This is really slick. Thanks a lot. I was wondering if I could get it to work with strings by treating them as longs (similar to how you did the overlay workaround), but haven't had any joy as yet. Will let you know if I do.
String arrays are always different. VB stores strings as unicode but when passing the array to VarPtrArray, it returns the temp ANSI safearray vs the one you really want. In order to get the VArPtrArray for strings, you need to reference a TLB to your project
1. Here's the msdn doc pertaining to the subject matter
http://support.microsoft.com/kb/199824
2. Here is the link for a compiled TLB you can add to your code's references
http://www.xbeat.net/vbspeed/download/TLB_VBVM6Lib.zip
Within that zip is just the TLB file. To get, for strings, what you would normally expect with VarPtrArray.
Code:VBVM6Lib.StrArrPtr(stringArray())
Using the TLB that I mentioned in my previous reply, strings are now doable.
Here is a generic sample routine that should work for common vartypes (string & numeric), not tested with variants/objects.
The only difference is that arrays of strings and non-strings use different methods to grab the varptr of the array itself. Commented in the code.
Edited: Tweaked vType variable again, to positively use what was passed. Commented in codeCode:Option Explicit
Private Declare Function SafeArrayCreateEx Lib "oleaut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As Any, ByRef pvExtra As Any) As Long
Private Declare Function SafeArrayDestroyDescriptor Lib "oleaut32.dll" (ByRef psa As Any) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
Private Type SAFEARRAYBOUND
Elmts As Long
LB As Long
End Type
Private Sub Command1_Click()
Dim b() As String
Dim x As Long, y As Long
Dim l() As Long
' we start with a 2D array, 20 total elements
ReDim b(1 To 2, 1 To 10)
For y = 1 To 10
For x = 1 To 2
b(x, y) = Chr$(Int(Rnd * 27) + 65) ' fill it with rnd values
Debug.Print b(x, y);
Next
Next: Debug.Print
' use VBVM6Lib.StrArrPtr for strings
' use VBVM6Lib.ArrPtr or VB's VarPtrArray for non-strings
' do 1D flip
If flipIt(StrArrPtr(b())) Then
' test it out, do we really have a 1D array now?
For x = LBound(b) To UBound(b)
Debug.Print b(x);
Next: Debug.Print
End If
' do 2D flip
If flipIt(StrArrPtr(b())) Then
' test it out, do we really have a 2D array now?
For y = LBound(b, 2) To UBound(b, 2)
For x = LBound(b, 1) To UBound(b, 1)
Debug.Print b(x, y);
Next
Next: Debug.Print
End If
End Sub
Private Function flipIt(arrayPtr As Long) As Boolean
Dim sab(0 To 1) As SAFEARRAYBOUND, nrDims As Integer
Dim ptrNew As Long, vType As Long, ptrOld As Long
If arrayPtr = 0& Then Exit Function
' get safe array pointer to the current array
CopyMemory ptrOld, ByVal arrayPtr, 4&
' determine the proper variant type/subtype from the passed pointer
CopyMemory vType, ByVal ptrOld + 2, 2&
If (vType And 128) = 128 Then ' specific variant type defined; this is what we want
CopyMemory vType, ByVal ptrOld - 4, 4&
Else
Exit Function ' passed value is invalid or possibly contains data types not prepared to handle
End If
' grab nr of dimensions/
CopyMemory nrDims, ByVal ptrOld, 2&
If nrDims = 1 Then
CopyMemory sab(0), ByVal ptrOld + 16, 8&
sab(1).Elmts = sab(0).Elmts
sab(0).Elmts = 1
nrDims = 2
ElseIf nrDims = 2 Then
CopyMemory sab(0), ByVal ptrOld + 16, 16&
sab(0).Elmts = sab(0).Elmts * sab(1).Elmts
sab(0).LB = sab(1).LB
nrDims = 1
Else
Exit Function
End If
' create the array descriptor
ptrNew = SafeArrayCreateEx(vType, nrDims, ByVal VarPtr(sab(0)), ByVal 0&)
If ptrNew Then ' success?
' copy the pvData from the old array to the new array
CopyMemory ByVal ptrNew + 12, ByVal ptrOld + 12, 4&
' destroy the old safearray structure -- do not reference array() here!!!!
' note: this api does NOT destroy the data; only the descriptor
Call SafeArrayDestroyDescriptor(ByVal ptrOld) ' returns zero if successful
' now replace old safearray pointer with the new safearray pointer
CopyMemory ByVal arrayPtr, ptrNew, 4&
flipIt = True
End If
End Function
Edited yet again. The API SafeArrayDestroyDescriptor is function vs sub (as defined in the API Viewer). Changed the declaration
This looks brilliant. Thanks. I'll play around with it this weekend once I get to a computer that will let me download the relevant files (my work-lap-top blocks downloads).
P.S. I tested the previous version with variants and it works perfectly.
Hmmm. The FlipIt function gives me a compile error at the line
saying "User-defined type may not be passed ByVal". So I tried declaring SafeArrayCreateEx as always being ByVal in the first place, and even saving sab(0)'s pointer in a separate variable and then using that, but it still gives me the same error.Code:ptrNew = SafeArrCreateEx(vType, nrDims, ByVal VarPtr(sab(0)), ByVal 0&)
Edit: Ah hang on: didn't realise you'd declared it differently second time round...
Works perfectly. Thank you so much. A quick question then, if I may. Is there any way of installing the .tlb programatically? I need to get the function to run on other people's machines as well as mine (quite a lot of them in fact).
In VB6, a referenced TLB is compiled into the executable, no need to distribute it.
You are using VBA though, correct? You can do this via code.
Search this forum for LoadTypeLib & RegisterTypeLib
Here is one example (scroll down near bottom of page). Pull what you need out of it
Here is an actual app + souce code
I'm afraid I'm not getting anywhere with this. I can't see anything at the bottom of the first link you sent. The second link tells me what to pass to the first arg of the LoadTypeLib function, but I'm not sure what to do with the object bit of it. I've tried all sorts of things, but I can't find a way of defining the .tlb file as an object.
Edit: In fact, I think the following gets the pointer to the Library
Code:Dim sLib as string, nOK as long, PtrTLB as long
sLib = "D:\Documents and Settings\Desktop\VBVM6Lib.tlb"
nOK = LoadTypeLib(StrPtr(sLib), PtrTLB)
LoadTypeLib is used in conjunction with RegisterTypeLib. The two together could be used to ensure the tlb is registered.
I am very weak with VBA as I mentioned in the beginning. This may be the correct time to revisit the MS Office/VBA section of the forum and post a question regarding how to register and dynamically add a TLB to an Excel project/macro? Apologize for sounding ingorant here, but I don't know exactly what you are using your code in. And even if I did, I probably don't have your answer. Sorry, I got you this far, but don't think I can help you further along.
I know. And I'm extremely grateful for all your time and effort. I'll persevere with the Library stuff and, meanwhile, see if I can get a generalised version of the Flip thing working.Quote:
Originally Posted by LaVolpe