dcsimg
Login | Register   
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX

By submitting your information, you agree that devx.com may send you DevX offers via email, phone and text message, as well as email offers about other products and services that DevX believes may be of interest to you. DevX will process your information in accordance with the Quinstreet Privacy Policy.


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

WEBINAR:

On-Demand

Application Security Testing: An Integral Part of DevOps


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 dimension
End Type

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

 

 

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