Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB5,VB6
Expertise: Advanced
Jul 29, 2000



Building the Right Environment to Support AI, Machine Learning and Deep Learning

GetArrayInfo - Retreive number of dimensions and the SAFEARRAY memory structure

    cElements   As Long      ' # of elements in the array dimension
    lLbound     As Long      ' lower bounds of the array dimension
End Type

    cDims       As Integer   ' Count of dimensions in this array.
    fFeatures   As Integer   ' Flags used by the SAFEARRAY routines documented 
                             ' below.
    cbElements  As Long      ' Size of an element of the array.
    cLocks      As Long      ' Number of times the array has been
                             ' locked without corresponding unlock.
    pvData      As Long      ' Pointer to the data.
    rgsabound(1 To 60) As SAFEARRAYBOUND   ' One bound for each dimension.
    ' An array can have max 60 dimensions, only the first cDims items will be 
    ' used
    ' note that rgsabound elements are in reverse order,
    '  e.g. for a 2-dimensional
    ' array, rgsabound(1) holds info about columns, and rgsabound(2) about rows
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal bytes As Long)
Private Const VT_BYREF = &H4000&

' Fills a SAFEARRAY structure for the supplied array.
' The information contained in the SAFEARRAY structure allows
' the caller to identify the number of dimensions and the
' number of elements for each dimension (among other things).
' Element information for each dimension is stored in a
' one-based sub-array of SAFEARRAYBOUND structures (rgsabound).
'   TheArray        The array to get information on.
'   ArrayInfo       The output SAFEARRAY structure.
'   RETURNS         The number of dimensions of the array
'                   or zero if the array isn't dimensioned

Function GetArrayInfo(TheArray As Variant, ArrayInfo As SAFEARRAY) As Boolean
    Dim lp As Long         ' work pointer variable
    Dim VType As Integer   ' the VARTYPE member of the VARIANT structure

    ' Exit if no array supplied
    If Not IsArray(TheArray) Then Exit Function

    With ArrayInfo
        ' Get the VARTYPE value from the first 2 bytes of the VARIANT structure
        CopyMemory VType, TheArray, 2

        ' Get the pointer to the array descriptor (SAFEARRAY structure)
        ' NOTE: A Variant's descriptor, padding & union take up 8 bytes.
        CopyMemory lp, ByVal VarPtr(TheArray) + 8, 4

        ' Test if lp is a pointer or a pointer to a pointer.
        If (VType And VT_BYREF) <> 0 Then
            ' Get real pointer to the array descriptor (SAFEARRAY structure)
            CopyMemory lp, ByVal lp, 4
        End If

        ' Fill the SAFEARRAY structure with the array info
        ' NOTE: The fixed part of the SAFEARRAY structure is 16 bytes.
        CopyMemory ArrayInfo.cDims, ByVal lp, 16

        ' Ensure the array has been dimensioned before getting SAFEARRAYBOUND 
        ' Information
        If ArrayInfo.cDims > 0 Then
            ' Fill the SAFEARRAYBOUND structures with the array info
            CopyMemory .rgsabound(1), ByVal lp + 16, _
                ArrayInfo.cDims * Len(.rgsabound(1))

            ' So caller knows there is information available for the array in 
            ' output SAFEARRAY
            GetArrayInfo = ArrayInfo.cDims
        End If

    End With

End Function

Monte Hansen
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date