carray.cls

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

                Ret(i) = Arr(MatchedIndexes(i))
            Next i
    End Select
    
    FindAll = Ret
End Function

''
' Finds the last occurence of a matched element in the array.
'
' @param arr The array to search.
' @param AddressOfMatch A callback address of the matching criteria method.
' @return The last element in the array to match the criteria, or the
' default for the array type if no elements matched.
' @remarks <p>The function signature for the callback has a specific format.
' <pre>
' Public Function FindLastCallback(ByRef x As [Array Datatype]) As Boolean
'     '' return True if x matches your criteria.
' End Sub
' </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.Find.txt"
Public Function FindLast(ByRef Arr As Variant, ByVal AddressOfMatch As Long) As Variant
    Dim Index As Long
    
    Index = FindLastIndex(Arr, AddressOfMatch)
    If Index >= LBound(Arr) Then
        Call VariantCopyInd(FindLast, Arr(Index))
    Else
        Call AssignDefaultElementValue(Arr, FindLast)
    End If
End Function

''
' Finds the index of the last occurence of a matched element in the array.
'
' @param arr The array to search.
' @param AddressOfMatch The callback address of the matching criteria method.
' @param Index The starting index in the array to begin the backward search.
' @param Count The number of elements to search.
' @return The index of the last occurence of the matched element.
' @remarks <p>The function signature for the callback has a specific format.
' <pre>
' Public Function FindLastIndexCallback(ByRef x As [Array Datatype]) As Boolean
'     '' return True if x matches your criteria.
' End Sub
' </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.Find.txt"
Public Function FindLastIndex(ByRef Arr As Variant, ByVal AddressOfMatch As Long, Optional ByRef Index As Variant, Optional ByRef Count As Variant) As Long
    mFindDelegator.pfn = AddressOfMatch
    
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr)
    
    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))
    
    Dim ElemSize As Long
    ElemSize = SafeArrayGetElemsize(pSafeArray)
    
    Dim pElem As Long
    pElem = MemLong(pSafeArray + PVDATA_OFFSET) + (ElemIndex - LBound(Arr)) * ElemSize
    
    Dim i As Long
    For i = ElemCount To 1 Step -1
        If mFinder.Call(pElem) = True Then
            FindLastIndex = LBound(Arr) + i - 1
            Exit Function
        End If
        pElem = pElem - ElemSize
    Next i
    FindLastIndex = LBound(Arr) - 1
End Function

''
' Returns a boolean indicating if all elements in the array matched the criteria.
'
' @param arr The array to compare against the criteria.
' @param AddressOfMatch The callback address used to match the criteria.
' @Return Indication of the entire array matching the criteria or not.
' @remarks <p>The function signature for the callback has a specific format.
' <pre>
' Public Function TrueForAllCallback(ByRef x As [Array Datatype]) As Boolean
'     '' return True if x matches your criteria.
' End Sub
' </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>
'
Public Function TrueForAll(ByRef Arr As Variant, ByVal AddressOfMatch As Long) As Boolean
    mFindDelegator.pfn = AddressOfMatch
    
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr, True)
    
    Dim ElemSize As Long
    ElemSize = SafeArrayGetElemsize(pSafeArray)
    
    Dim pElem As Long
    pElem = MemLong(pSafeArray + PVDATA_OFFSET)
    
    Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        If mFinder.Call(pElem) = False Then Exit Function
        pElem = pElem + ElemSize
    Next i
    TrueForAll = True
End Function

''
' Iterates over an array passing in each element into an Action function to be performed on the element.
'
' @param Arr The array containing the elements to be processed.
' @param AddressOfAction The callback address of the function to process an array element.
' @remarks <p>The callback method must be a Sub with a single ByRef parameter of the same
' type as the array.
' <pre>
' Public Sub ActionMethod(ByRef e As [Data Type])
'     '' Perform action on e.
' End Sub
' </pre>
' The [Array Datatype] must be replaced with the datatype of the array. If the
' array is an array of Variants, then the [Array Datatype] would be a Variant, not
' any specific sub-type within the variants of the array.</p>
'
Public Sub ForEach(ByRef Arr As Variant, ByVal AddressOfAction As Long)
    mForEachDelegator.pfn = AddressOfAction
    
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr, True)
    
    Dim ElemSize As Long
    ElemSize = SafeArrayGetElemsize(pSafeArray)
    
    Dim pElem As Long
    pElem = MemLong(pSafeArray + PVDATA_OFFSET)
    
    Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        Call mForEach.Call(pElem)
        pElem = pElem + ElemSize
    Next i
End Sub

''
' Performs a binary search on a given array. A subportion of the array can
' be searched using the startindex and length parameters. A custom user
' comparer can optionally be supplied to perform special comparisons
' between elements in the array.
'
' @param arr The array to search for a specific value.
' @param value The value to search for in the array.
' @param Index The starting index in the array to begin searching.
' @param Count The number of elements to search, starting at startindex.
' @param comparer A user supplied object to compare elements within the array.
' @return The index at which the value was found.
' @remarks If the returned value is less than the lower bound of the array, then
' the value indicates where the value would have been found in the array. The
' following is how to convert the return value to the array index:<br><br>
' Lowerbound of 0:  return = Not return<br>
' Other lowerbound: return = (Not (return - lowerbound)) + lowerbound<br>
' @include "..\Includes\cArray_BinarySearch.txt"
Public Function BinarySearch(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 ElemCount   As Long
    Dim ElemIndex   As Long
    Dim Result      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 TrySZBinarySearch(pSafeArray, Value, ElemIndex, ElemCount, BinarySearch) Then Exit Function
        Set Comparer = VBCorLib.Comparer.Default
    End If
    
    ' perform a search using comparer.
    Dim MiddleIndex As Long
    Dim LowIndex    As Long
    Dim HighIndex   As Long
    
    LowIndex = ElemIndex
    HighIndex = LowIndex + ElemCount - 1
    Do While LowIndex <= HighIndex
        MiddleIndex = (LowIndex + HighIndex) \ 2
        Select Case Comparer.Compare(Arr(MiddleIndex), Value)
            Case 0
                BinarySearch = MiddleIndex
                Exit Function
            Case Is > 0
                HighIndex = MiddleIndex - 1
            Case Else
                LowIndex = MiddleIndex + 1
        End Select
    Loop
    
    Dim LowerBound As Long
    LowerBound = SafeArrayGetLBound(pSafeArray, 1)
    BinarySearch = (Not (LowIndex - LowerBound)) + LowerBound
    Exit Function
errTrap:
    Throw Cor.NewInvalidOperationException(Environment.GetResourceString(InvalidOperation_Comparer_Arg, Err.Description))
End Function

''
' Clears a portion of the elements in an array.
'
' @param arr The array to clear elements from.
' @param Index The starting element to being clearing.
' @param Count The number of elements to be cleared.
'
Public Sub Clear(ByRef Arr As Variant, ByVal Index As Long, ByVal Count As Long)
    Dim pSafeArray As Long
    pSafeArray = GetArrayPointer(Arr)
    
    Dim Result As Long
    Result = VerifyArrayRange(pSafeArray, Index, Count)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Arr", Index, "Index", Count, "Count")
    
    If Count = 0 Then Exit Sub
    
    Dim IIDOffset As Long
    Select Case VarType(Arr) And &HFF   ' knock off the vbArray bit
        Case vbObject
            IIDOffset = SIZEOF_GUID
            
        Case vbString, vbUserDefinedType
            IIDOffset = 4
            
        Case Else
            ' we can use ZeroMemory for everything else.
            Dim ElemSize As Long
            ElemSize = SafeArrayGetElemsize(pSafeArray)
            
            Dim pElem As Long
            pElem = MemLong(pSafeArray + PVDATA_OFFSET)
            
            ' optimize by zeroing out the memory directly.
            Call ZeroMemory(ByVal pElem + (Index - LBound(Arr)) * ElemSize, Count * ElemSize)
            Exit Sub
    End Select
    
    Dim SubArray As GuidSafeArray1d
    Call CopyMemory(ByVal VarPtr(SubArray.SA) - IIDOffset, ByVal pSafeArray - IIDOffset, Len(SubArray.SA) + IIDOffset)
    
    With SubArray.SA
        .fFeatures = .fFeatures Or FADF_FIXEDSIZE Or FADF_STATIC Or FADF_AUTO
        .pvData = .pvData + (Index - LBound(Arr)) * .cbElements
        .cElements = Count
    End With
    Call SafeArrayDestroyData(VarPtr(SubArray.SA))
End Sub

''
' Copies one Array to another Array and performs type casting as necessary.
'
' @param SourceArray The array from which to copy the elements.
' @param DestinationArray The array in which to place the elements.
' @param Count The number of elements to copy.
' @param AddressOfCopier A callback address to a method used to assign
' elements from the source array to the destination array.
' @remarks The AddressOfCopier method signature must be two parameters
' of ByRef for the datatypes of each of the arrays. The destination
' array element is the first parameter.
' <h4>Example</h4> This is an example of a callback method declaration.
' <pre>
' Public Sub CopyCallback(ByRef dst As String, ByRef src As MyClass)
'     dst = src.Name
' End Sub
' </pre>
Public Sub Copy(ByRef SourceArray As Variant, ByRef DestinationArray As Variant, ByVal Count As Long, Optional ByVal AddressOfCopier As Long)
    Call InternalCopy(SourceArray, DestinationArray, Count, AddressOfCopier)
End Sub

''
' Copies a section of one Array to another Array and performs type casting as necessary.
'
' @param sourcearray The array from which to copy the elements.
' @param sourceindex The starting element in the source array to begin copying from.
' @param destinationarray The array in which to place the elements.
' @param destinationindex The starting element in the destination array to place elements.
' @param Count The number of elements to copy.
' @param AddressOfCopier A callback address to a method used to assign
' elements from the source array to the destination array.
' @remarks The AddressOfCopier method signature must be two parameters
' of ByRef for the datatypes of each of the arrays. The destination
' array element is the first parameter.
' <h4>Example</h4> This is an example of a callback method declaration.
' <pre>
' Public Sub CopyCallback(ByRef dst As String, ByRef src As MyClass)
'     dst = src.Name
' End Sub