devxlogo

GetArrayInfo – Retreive number of dimensions and the SAFEARRAY memory structure

GetArrayInfo – Retreive number of dimensions and the SAFEARRAY memory structure

Type SAFEARRAYBOUND    cElements   As Long      ' # of elements in the array dimension    lLbound     As Long      ' lower bounds of the array dimensionEnd TypeType SAFEARRAY    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 rowsEnd TypePrivate 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 dimensionedFunction 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 WithEnd Function

devx-admin

Share the Post: