carray.cls

VB 加密----------能够加密解密控件

' </pre>
Public Sub CopyEx(ByRef SourceArray As Variant, ByVal SourceIndex As Long, ByRef DestinationArray As Variant, ByVal DestinationIndex As Long, ByVal Count As Long, Optional ByVal AddressOfCopier As Long = 0)
    Call InternalCopy(SourceArray, DestinationArray, Count, AddressOfCopier, SourceIndex, DestinationIndex)
End Sub

''
' Initializes a new array of the specified type in up to 3 dimensions.
'
' @param ArrayType The data type the array represents.
' @param length1 The number of elements in the first dimension.
' @param length2 The number of elements in the second dimension.
' @param length3 The number of elements in the third dimension.
' @returns An array of the specified type with the specified dimensions.
' @remarks If a length is zero, then an empty array is returned, not a Null array.
' If one length is defined as zero, then all other defined lengths must be zero.
' This does not mean that lenghts 2 and 3 need to be set to zero if only an empty
' one-dimensional array is being created.
' <p>Elements of a size that are a multiple of 4 will not create a new array
' when being returned. All other datatype sizes will cause a new array
' to be created. The array must also be assigned at the end of the code
' so VB can optimize returning the Variant datatype and not copy it when possible.</p>
'
Public Function CreateInstance(ByVal ArrayType As ciArrayTypes, Optional ByVal length1 As Long = 0, Optional ByRef length2 As Variant, Optional ByRef length3 As Variant) As Variant
    Dim bounds(2)   As SafeArrayBound
    Dim Rank        As Long
    Dim Length      As Long
    
    Rank = 1
    If length1 < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "length1", length1)
    bounds(2).cElements = length1
    
    If Not IsMissing(length2) Then
        Rank = 2
        Length = length2
        If Length < 0 Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "length2", length2)
        If Length = 0 And bounds(2).cElements <> 0 Then _
            Throw Cor.NewArgumentException("If defining one dimension as 0, then all other defined dimensions must be 0.", "length2")
        
        bounds(1).cElements = Length
    End If
    If Not IsMissing(length3) Then
        If Rank <> 2 Then Throw Cor.NewArgumentException("Cannot specifiy dimension without dimension 2.", "length3")
        Rank = 3
        Length = length3
        If Length < 0 Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "length3", length3)
        If Length = 0 And bounds(1).cElements <> 0 Then _
            Throw Cor.NewArgumentException("If defining one dimension as 0, then all other defined dimensions must be 0.", "length2")
        
        bounds(0).cElements = Length
    End If
        
    Dim Ret As Variant
    VariantType(Ret) = ArrayType Or vbArray
    MemLong(VarPtr(Ret) + VARIANTDATA_OFFSET) = SafeArrayCreate(ArrayType, Rank, bounds(3 - Rank))
    
    ' Elements of a size that are a multiple of 4 will not create a new array
    ' when being returned. All other datatype sizes will cause a new array
    ' to be created. The array must also be assigned at the end of the code
    ' so VB can optimize returning the Variant datatype and not copy it when possible.
    CreateInstance = Ret
End Function

''
' Creates an array of values.
'
' @param arraytype The target datatype of the resultant array and the values to be converted to.
' @param arrayelements The values to be put into the new array.
' @return An array of the specified datatype and containing the array elements with conversion.
' Or an empty array if no elements are defined.
' <p>Elements of a size that are a multiple of 4 will not create a new array
' when being returned. All other datatype sizes will cause a new array
' to be created.</p>
'
Public Function NewArray(ByVal ArrayType As ciArrayTypes, ParamArray ArrayElements() As Variant) As Variant
    Dim args() As Variant
    
    Call Helper.Swap4(ByVal ArrPtr(args), ByVal Helper.DerefEBP(16))
    NewArray = InternalNewArray(ArrayType, args)
End Function

''
' Returns the number of elements in the specified dimension. If 0 is
' specified, this returns the total number of elements in the array.
'
' @param arr The array to retrieve the number of elements from.
' @param dimension (Optional) the specific dimension to get the number of elements.
' @return The number of elements in the specified dimension or the entire array.
'
Public Function GetLength(ByRef Arr As Variant, Optional ByVal Dimension As Long = 0) As Long
    Dim pSafeArray  As Long
    Dim Rank        As Long
    
    pSafeArray = GetArrayPointer(Arr, True)
    Rank = SafeArrayGetDim(pSafeArray)
    If Dimension > Rank Then _
        Throw Cor.NewIndexOutOfRangeException(Environment.GetResourceString(IndexOutOfRange_Dimension))
    
    pSafeArray = pSafeArray + SIZEOF_SAFEARRAY
    If Dimension < 1 Then
        ' optimize for 99% of calls
        If Rank = 1 Then
            GetLength = MemLong(pSafeArray)
            Exit Function
        End If
        
        ' calculate the product of all the dimension sizes.
        GetLength = 1
        Dim i As Long
        For i = pSafeArray To pSafeArray + (SIZEOF_SAFEARRAYBOUND * (Rank - 1)) Step SIZEOF_SAFEARRAYBOUND
            GetLength = GetLength * MemLong(i)
        Next i
    Else
        ' get the size of a specific dimension.
        pSafeArray = pSafeArray + (Rank - Dimension) * SIZEOF_SAFEARRAYBOUND
        GetLength = MemLong(pSafeArray)
    End If
End Function

''
' Returns the number of dimensions in the array.
'
' @param arr The array to retrieve the number of dimensions from.
' @return The number of dimension in the array.
Public Function GetRank(ByRef Arr As Variant) As Long
    GetRank = SafeArrayGetDim(GetArrayPointer(Arr, True))
End Function

''
' Returns the index of the first occurrence of a value in a one-dimensional Array or in a portion of the Array.
'
' @param arr The array to search.
' @param value The value to search for in the array.
' @param Index The index to the element in the array to begin search from.
' @param count The number of elements to search, starting from startindex.
' @param comparer An optional comparer, primarily used for User-Defined types.
' @return Value indicating the index the value was found. If a value of less that
' the lower-bounds is returned, then the value was not found in the array.
Public Function IndexOf(ByRef Arr As Variant, ByRef Value As Variant, Optional ByRef Index As Variant, Optional ByRef Count As Variant, Optional ByVal Comparer As IComparer) As Long
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr)
    
    Dim Result      As Long
    Dim ElemIndex   As Long
    Dim ElemCount   As Long
    Result = GetOptionalArrayRange(pSafeArray, Index, ElemIndex, Count, ElemCount)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Arr", ElemIndex, "Index", ElemCount, "Count", IsMissing(Index))
    
    On Error GoTo errTrap
    If Comparer Is Nothing Then
        ' if no comparer was supplied, then try some optimized routines.
        If TrySZIndexOf(pSafeArray, Value, ElemIndex, ElemCount, IndexOf) Then Exit Function
        Set Comparer = VBCorLib.Comparer.Default
    End If
    
    ' perform a search using comparer.
    Do While ElemCount > 0
        If Comparer.Compare(Arr(ElemIndex), Value) = 0 Then
            IndexOf = ElemIndex
            Exit Function
        End If
        ElemIndex = ElemIndex + 1
        ElemCount = ElemCount - 1
    Loop
    IndexOf = LBound(Arr) - 1
    Exit Function
errTrap:
    Throw Cor.NewInvalidOperationException(Environment.GetResourceString(InvalidOperation_Comparer_Arg, Err.Description))
End Function

''
' Returns if an array variable is uninitialized.
'
' @param arr The array to test for initialization.
' @return Value indicating if the array is initialized.
Public Function IsNull(ByRef Arr As Variant) As Boolean
    IsNull = (GetArrayPointer(Arr) = vbNullPtr)
End Function

''
' Returns the index of the last occurrence of a value in a one-dimensional Array or in a portion of the Array.
'
' @param arr The array to search.
' @param value The value to search for in the array.
' @param Index The index to the element in the array to begin search from.
' @param Count The number of elements to search, starting from startindex.
' @param comparer An optional comparer, primarily used for User-Defined types.
' @return Value indicating the index the value was found. If a value of less that
' the lower-bounds is returned, then the value was not found in the array.
'
Public Function LastIndexOf(ByRef Arr As Variant, ByRef Value As Variant, Optional ByRef Index As Variant, Optional ByRef Count As Variant, Optional ByVal Comparer As IComparer) As Long
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr, True)
    
    Dim Result      As Long
    Dim ElemIndex   As Long
    Dim ElemCount   As Long
    Result = GetOptionalArrayRangeReverse(pSafeArray, Index, ElemIndex, Count, ElemCount)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Arr", ElemIndex, "Index", ElemCount, "Count", IsMissing(Index))

    On Error GoTo errTrap
    If Comparer Is Nothing Then
        ' if no comparer was supplied, then try some optimized routines.
        If TrySZLastIndexOf(pSafeArray, Value, ElemIndex, ElemCount, LastIndexOf) Then Exit Function
        Set Comparer = VBCorLib.Comparer.Default
    End If
    
    ' perform a search using comparer.
    Do While ElemCount > 0
        If Comparer.Compare(Arr(ElemIndex), Value) = 0 Then
            LastIndexOf = ElemIndex
            Exit Function
        End If
        ElemIndex = ElemIndex - 1
        ElemCount = ElemCount - 1
    Loop
    LastIndexOf = LBound(Arr) - 1
    Exit Function
errTrap:
    Throw Cor.NewInvalidOperationException(Environment.GetResourceString(InvalidOperation_Comparer_Arg, Err.Description))
End Function

''
' Reverses the elements in a subportion of an array.
'
' @param arr The array to reverse.
' @param Index The starting element to begin reversing elements.
' @param Count The number of elements to reverse in the array.
'
Public Sub Reverse(ByRef Arr As Variant, Optional ByRef Index As Variant, Optional ByRef Count As Variant)
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr)
    
    Dim Result      As Long
    Dim ElemIndex   As Long
    Dim ElemCount   As Long
    Result = GetOptionalArrayRange(pSafeArray, Index, ElemIndex, Count, ElemCount)
    If Result <> NO_ERROR Then ThrowArrayRangeException Result, "Arr", ElemIndex, "Index", ElemCount, "Count", IsMissing(Index)
    
    Dim ElemSize As Long
    ElemSize = SafeArrayGetElemsize(pSafeArray)
    
    Dim pLowElem As Long
    pLowElem = MemLong(pSafeArray + PVDATA_OFFSET) + (ElemIndex - LBound(Arr)) * ElemSize
    
    Dim pHighElem As Long
    pHighElem = pLowElem + (ElemCount - 1) * ElemSize
    
    Select Case ElemSize
        Case 1, 2, 4, 8, 16
            Dim swapper As ISwap
            Set swapper = GetSwapper(ElemSize)
            
            Do While pLowElem < pHighElem
                Call swapper.Call(vbNullPtr, ByVal pLowElem, ByVal pHighElem)
                pLowElem = pLowElem + ElemSize
                pHighElem = pHighElem - ElemSize
            Loop
            
        Case Else
            Dim pSwapBuffer As Long
            pSwapBuffer = CoTaskMemAlloc(ElemSize)
            
            Do While pLowElem < pHighElem
                Call CopyMemory(ByVal pSwapBuffer, ByVal pLowElem, ElemSize)
                Call CopyMemory(ByVal pLowElem, ByVal pHighElem, ElemSize)
                Call CopyMemory(ByVal pHighElem, ByVal pSwapBuffer, ElemSize)
                pLowElem = pLowElem + ElemSize
                pHighElem = pHighElem - ElemSize
            Loop
            Call CoTaskMemFree(pSwapBuffer)
    End Select
End Sub

''
' Sorts an entire array. An optionally supplied comparer object can be
' used to compare special elements, such as userdefined values.
'
' @param Keys The array to sort.
' @param Comparer (Optional) An IComparer object or address of a comparer callback function.
' @remarks The Comparer parameter can be an <b>IComparer</b> object or a
' callback address to a compare function using the <b>AddressOf</b> method. The
' callback method signature is defined as follows:
' <pre>
' Public Function SortCallback(ByRef x As [Array Datatype], ByRef y As [Array Datatype]) As Long
'     '' return a negative value if x is less than y.
'     '' return a positive value if x is greater than y.
'     '' return 0 if x equals y.
' End Function
' </pre>
' The [Array Datatype] must be replaced with the datatype of the array. If the
' array is an array of Variants, then [Array Datatype] would be a Variant, not
' any specific sub-type within the variants of the array.</p>
'
' @include "..\Includes\cArray_Sort.txt"
Public Sub Sort(ByRef Keys As Variant, Optional ByVal Comparer As Variant)
    Call InternalSort(Keys, Empty, , , Comparer)
End Sub

''
' Sorts an array, or subportion, given a startindex and length. An optionally
' supplied comparer object can be used to compare special elements, such as
' userdefined values.