CopyMemory 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.

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

---

Problem is, sometimes I want to parse arrays to functions by referencing them directly in Excel, e.g.

Code:

---

v = SomeFn(Sheet1.UsedRange.Value)

---

and to do this I have to have my function in the form

Code:

---

Function SomeFn(vIn as Variant)

---

as opposed to

Code:

---

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.

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

Code:

---

Sub TestDiffArrs()
  Dim v() As Variant
  v = Sheet1.UsedRange.Value
  SetArrVars v
End Sub

---

but this crashes:

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.

Code:

---

Dim nLocOfSA as Long
CopyMemory nLocOfSA, ByVal VarPtr(vIn) + 8&, 4&

---

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:

---

CopyMemory nLocOf1stPtr, ByVal VarPtr(vIn) + 8&, 4&
CopyMemory nLocOfSA, ByVal nLocOf1stPtr, 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:

---

nVarType = CopyMemory vType, ByVal VarPtr(v), 2&
CopyMemory nPtr, ByVal VarPtr(vIn) + 8&, 4&
If nVarType = 24588 Then CopyMemory nPtr, ByVal nPtr, 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.

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

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

---

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.

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

Code:

---

&H600C = (24588) = VT_BYREF Or vbArray Or vbVariant

---

as opposed to

Code:

---

&H600C = (24588) = VT_BYREF And vbArray And 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.

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

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

---

and Excel crashed. I can't immediately (or even over a long period of time for that matter) see what's wrong here.

Reference post 49

When using CopyMemory, you can't go wrong by checking what vartype exists in passed variant.

Code:

---

Dim I as Integer
CopyMemory I, ByVal VarPtr(vIn), 2&
' I, in this case, returns 8200:  vbArray + vbString

---

Because of the vartype contained, you need to get the StrPtrs from the SafeArray structure

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:

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))

---

Again, review Post 49.

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

Code:

---

dim vTmp() as variant
if X then redim vTmp(like this) else redim vTmp(some other way)

---

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 do

Code:

---

CopyMemory byval Ptr,....

---

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.

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.

Code:

---

Looks ok to me, assuming vArr contains an array and is not VT_BYREF.

---

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.

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

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

---

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.

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.

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

---

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.

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

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

---

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?

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

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

---

P.S. I've never used those SafeArray APIs before, self-teaching myself too.

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.

Code:

---

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: Tweaked vType variable again, to positively use what was passed. Commented in code
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

Code:

---

ptrNew = SafeArrCreateEx(vType, nrDims, ByVal VarPtr(sab(0)), ByVal 0&)

---

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.

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.

Quote:

---

Originally Posted by LaVolpe

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.