[RESOLVED] Patch SafeArray header to be 0 to -1

[Elroy]

Do people feel that it's safe to patch up the SafeArray header of an undimensioned dynamic array to report 0 to -1 (similar to a string array from Split(vbNullString))?

I'm not completely positive that an undimensioned array even has a header just yet, but I'll check that.

I'm just wondering if I'm overlooking anything.

Note, I'm specifically thinking of doing this for a UDT array.

Thanks,
Elroy

[The trick]

I'm not completely positive that an undimensioned array even has a header just yet, but I'll check that.

No.

Option Explicit

Private Type tUDT
    s As String
    l As Long
End Type

Private Sub Form_Load()
    Dim d() As tUDT
    
    Debug.Print Not Not d   ' // 0
    
    ReDim d(10)
    
    Debug.Print Not Not d   ' // some SA descriptor
    
    Erase d
    
    Debug.Print Not Not d   ' // 0
    
End Sub

[Elroy]

Well darn!

I was hoping to figure out how to return a 0 to -1 UDT array.


EDIT1: And I can do it with any other array type, using a Variant to get it done.

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)

Private Function MakeZeroToNegOneArray(iType As VBA.VbVarType) As Variant
    ' Allowed: Boolean, Byte, Currency, Date, Double, Integer, Long, Single, String, Variant, Object
    If Not ((iType >= 2 And iType <= 9) Or iType = 11 Or iType = 12 Or iType = 17) Then Exit Function
    '
    Dim bb() As Byte
    Dim ppSA As Long
    Dim iBytes As Long
    '
    bb = vbNullString                                       ' We'll make a Byte type and then force-typecast it.
    MakeZeroToNegOneArray = bb                              ' Put empty array into variant.
    CopyMemory MakeZeroToNegOneArray, iType Or vbArray, 2&  ' Typecast, making sure it's still an array.
    '
    ' And now fix cbElements.
    CopyMemory ppSA, ByVal PtrAdd(VarPtr(MakeZeroToNegOneArray), 8&), 4&
    ppSA = ppSA + 4&                ' Offset pointer to cbElements.
    Select Case iType
    Case vbByte:                                  iBytes = 1&
    Case vbInteger, vbBoolean:                    iBytes = 2&
    Case vbString, vbSingle, vbLong, vbObject:    iBytes = 4&
    Case vbCurrency, vbDate, vbDouble:            iBytes = 8&
    Case vbVariant:                               iBytes = 16&
    End Select
    CopyMemory ByVal ppSA, iBytes, 4&
End Function

Public Function PtrAdd(ByVal Pointer As Long, ByVal Offset As Long) As Long
    Const SIGN_BIT As Long = &H80000000
    PtrAdd = (Pointer Xor SIGN_BIT) + Offset Xor SIGN_BIT
End Function

[The trick]

I was hoping to figure out how to return a 0 to -1 UDT array.

Option Explicit

Private Type tUdt
    s As String
    l As Long
    b As Object
End Type

Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32.dll" ( _
                    ByVal cDims As Long, _
                    ByRef ppsaOut() As tUdt)

Private Sub Form_Load()
    Dim t() As tUdt

    SafeArrayAllocDescriptor 1, t()
    
End Sub

[Elroy]

Well Trick, it amazes me how often you truly pull rabbits out of the hat.

THANK YOU!
Elroy

[wqweto]

Even better would be to declare retval as ppsaOut() As Any (parenthesis are important) for the API function to become universal empty UDT factory like this:

Option Explicit
 
Private Type tUdt
    s As String
    l As Long
    b As Object
End Type
 
Private Type tSecond
    c As tUdt
End Type
 
Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ppsaOut() As Any)
 
Private Sub Form_Load()
    Dim t() As tUdt
    Dim s() As tSecond
 
    SafeArrayAllocDescriptor 1, t
    Debug.Assert UBound(t) = -1
    SafeArrayAllocDescriptor 1, s
    Debug.Assert UBound(s) = -1
End Sub

And check out this previous thread for more ideas about creating empty arrays.

cheers,
</wqw>

[Elroy]

@Wqweto: Nice, I like it.

I also like your cleaner way of making other empty arrays:

Private Declare Function EmptyVariantArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbVariant, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Variant()
Private Declare Function EmptyStringArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbString, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As String()
Private Declare Function EmptyByteArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbByte, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Byte()
Private Declare Function EmptyLongArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbLong, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Long()
Private Declare Function EmptyDoubleArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbDouble, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Double()

It's much cleaner than the way I was doing it.

Best Regards,
Elroy

[dilettante]

Yes, I find the ability to create empty-but-valid dynamic arrays very handy. Too bad we never got any syntax for this but if I had a choice I might avoid the word Empty to avoid confusion.

We have "Erase {arrayname}" so maybe something like "Allocate {arrayname}" or even just "Redim {arrayname}()" but since we can't expect new features or a real VB7 it's pointless to worry about.


"VB6.5" and such sort of make me gag, no reason to bow down to The Great Pretender "VB.Net" which has always been an unnecessary root in the trail to trip over.

[wqweto]

@The trick: Did you notice there is a problem with ReDim Preserved empty arrays of UDTs created with SafeArrayAllocDescriptor. Here is a repro

Option Explicit
 
Private Type tUdt
    s As String
    l As Long
    b As Object
End Type
 
Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ByRef ppsaOut() As tUdt)
Private Declare Function EmptyLongArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbLong, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Long()
 
Private Sub Form_Load()
    Dim t() As tUdt
 
    SafeArrayAllocDescriptor 1, t()
    Debug.Print LBound(t), UBound(t)    '--- 0            -1
    ReDim Preserve t(0 To 0) As tUdt
    Debug.Print LBound(t), UBound(t)    '--- 0             0
    
    '             v
    Debug.Print t(0).s                  '--- error: subscript out of range
    '             ^
    
    Dim l() As Long
    l = EmptyLongArray
    Debug.Print LBound(l), UBound(l)    '--- 0            -1
    ReDim Preserve l(0 To 0) As Long
    Debug.Print LBound(l), UBound(l)    '--- 0             0
    Debug.Print l(0)                    '--- works ok
End Sub

Yet empty scalar arrays created w/ SafeArrayCreateVector seem ok.

cheers,
</wqw>

[Elroy]

Good catch Wqweto.

That sort of makes some sense to me though. Non-typelibed UDTs are quite "baked in" to the code by the compiler. And, when using SafeArrayAllocDescriptor, the compiler never had the chance to "bake in" the UDT to the variable. And, I'm guessing a "Redim Preserve" attempts to just make changes to the existing array. In fact, the MSDN basically states that, by saying it can only add to the end of the data.

I tested a "Redim" (without Preserve) and that works fine. Apparently, using that approach, any existing Safe Array Descriptor is discarded, and a new one created, using the "baked in" UDT descriptor to get things going.

Also, for me, it's something I'd hopefully always test during alpha-testing. But it's good to be aware that it may cause an error. At least it doesn't seem to cause an IDE crash.

And, the main thing I wanted it for was the ability to do a "For i = LBound(t) to UBound(t)" and not have the loop run but not need any error checking.

Best Regards,
Elroy

[wqweto]

And, the main thing I wanted it for was the ability to do a "For i = LBound(t) to UBound(t)" and not have the loop run but not need any error checking.

This but also ReDim Preserve t(0 To UBound(t) + 1) to grow the array is very convenient. Unfortunately ReDim Preserve cannot change target array's lower bound so a dimensioned array (-1 To -1) cannot be redimensioned (0 To Size). . . (FYI, it can be used in For i = 0 to UBound(t) for your purposes above.)

Now I have to test if UBound(t) < 0 and ReDim t(0 To 0) w/o preserving which IMO makes code needlessly verbose.

cheers,
</wqw>

[The trick]

Did you notice there is a problem with ReDim Preserved empty arrays of UDTs created with SafeArrayAllocDescriptor

Yes, i see. This error occurs because SafeArrayAllocDescriptor doesn't allocate the memory for data.

[baka]

im using UDT with undimmed arrays, example:

--- " ---
Arrays As Byte/Integer/Long
Array() As ArrayUDTData

, not always the array is used, so its just empty.
when used I redim (1 to X) not 0
the "Arrays" will keep track of the amount of items.
if the arrays decreases, it will redim preserve until 1, if 0, it will Erase it.

I could use the safe array so that I can check if the array is empty or not, but i feel more "safe" with an index variable that keep track of it.
also, I use Arrays to determine the max value in the index, otherwise I need to use UBound(Array) for the purpose, this because theres a max of how many items that can be in the array.

so, it is better to use my method or something else?
for me its safety first, don't want the array to get corrupted or the program freezes, second is size, to have (usually a byte) that keep track of the size of the array will of course eat memory. without it, it will save me a bit of size. i could be using hundreds of arrays. so after a bit it will be eating a bit of memory.

[Elroy]

Well baka, as I understand it, a 0 to -1 array (i.e., one created with SafeArrayAllocDescriptor or SafeArrayCreateVector) will have a Safe Array header. Therefore, even these, ummm, zero-element-arrays will use memory. And an "erased" (or never dimensioned) array won't have these Safe Array headers.

Therefore, if you're worried about every byte of memory, you'd better use "erased" arrays, and possibly error checking to see if they're dimensioned.

Personally, I'm never that concerned with memory, and enjoy the elegance of the 0 to -1 arrays. I suppose it comes down to a personal choice.

Good Luck,
Elroy

[The trick]

I use the next code:

' //
' // Get number of elements in array by pointer
' //
Public Function SafeArrayElementsCount( _
                ByVal pSA As Long) As Long
    Dim tSA     As SAFEARRAY
    Dim pBound  As Long
    Dim tBound  As SAFEARRAYBOUND
    
    If pSA = 0 Then Exit Function
    
    memcpy tSA, ByVal pSA, Len(tSA)
    
    pBound = pSA + Len(tSA)
    SafeArrayElementsCount = 1
    
    Do While tSA.cDims > 0
    
        memcpy tBound, ByVal pBound, Len(tBound)
        
        SafeArrayElementsCount = SafeArrayElementsCount * tBound.cElements
        pBound = pBound + Len(tBound)
        tSA.cDims = tSA.cDims - 1
        
    Loop
                    
End Function

Usage SafeArrayElementsCount(Not Not Arr)
Moreover i use the inline-assembler function sometimes:

BITS 32

push edx

xor eax, eax
mov edx, dword [esp+8]

test edx, edx
jz EXIT

movzx ecx, word [edx]

test ecx,ecx
jz EXIT

add edx, 0x10
inc eax

CYCLE:

imul eax, dword [edx]
add edx,8

dec ecx
jne CYCLE

EXIT:

pop edx

ret 4

[VanGoghGaming]

@The trick: Did you notice there is a problem with ReDim Preserved empty arrays of UDTs created with SafeArrayAllocDescriptor. Here is a repro

Option Explicit
 
Private Type tUdt
    s As String
    l As Long
    b As Object
End Type
 
Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ByRef ppsaOut() As tUdt)
Private Declare Function EmptyLongArray Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbLong, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Long()
 
Private Sub Form_Load()
    Dim t() As tUdt
 
    SafeArrayAllocDescriptor 1, t()
    Debug.Print LBound(t), UBound(t)    '--- 0            -1
    ReDim Preserve t(0 To 0) As tUdt
    Debug.Print LBound(t), UBound(t)    '--- 0             0
    
    '             v
    Debug.Print t(0).s                  '--- error: subscript out of range
    '             ^
    
    Dim l() As Long
    l = EmptyLongArray
    Debug.Print LBound(l), UBound(l)    '--- 0            -1
    ReDim Preserve l(0 To 0) As Long
    Debug.Print LBound(l), UBound(l)    '--- 0             0
    Debug.Print l(0)                    '--- works ok
End Sub

Yet empty scalar arrays created w/ SafeArrayCreateVector seem ok.

cheers,
</wqw>

SafeArrayAllocDescriptor creates an almost empty descriptor (all members are zero except cDims which you specified in the call). If you set the cbElements member to the size of the UDT then Redim Preserve will also work above.

[Elroy]

SafeArrayAllocDescriptor creates an almost empty descriptor (all members are zero except cDims which you specified in the call). If you set the cbElements member to the size of the UDT then Redim Preserve will also work above.

Nice catch. With that, I do believe this thread is resolved.

[VanGoghGaming]

Here's a generic EmptyArray sub that works with arrays of any type:

Private Declare Function SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ppSA As LongPtr) As HRESULT

Public Function ArrPtrVar(vArray As Variant) As LongPtr
Dim vt As Integer
    If IsArray(vArray) Then
        GetMem2 ByVal VarPtr(vArray), vt: ArrPtrVar = VarPtr(vArray) + 8
        If (vt And VT_BYREF) = VT_BYREF Then GetMemPtr ByVal ArrPtrVar, ArrPtrVar
    End If
End Function

Public Sub EmptyArray(vArray As Variant)
Dim pSA As LongPtr, ppSA As LongPtr
    If IsArray(vArray) Then
        If SafeArrayAllocDescriptor(1, ppSA) = S_OK Then
            ReDim vArray(0)
            GetMemPtr ByVal ArrPtrVar(vArray), pSA
            vbaCopyBytes 24, ByVal ppSA - 16, ByVal pSA - 16
            Erase vArray
            PutMemPtr ByVal ArrPtrVar(vArray), ppSA
        End If
    End If
End Sub

Private Sub Form_Load()
Dim FormArray() As Form1, StringArray() As String

    EmptyArray FormArray
    Debug.Print UBound(FormArray)
    ReDim Preserve FormArray(5)
    Debug.Print UBound(FormArray)
    
    EmptyArray StringArray
    Debug.Print UBound(StringArray)
    ReDim Preserve StringArray(10)
    Debug.Print UBound(StringArray)

End Sub

Output:

-1 
 5 
-1 
 10

It lets VB6 set the cbElements, fFeatures, VarType and/or IID of the array descriptor automatically and just copies them into a newly created empty descriptor.