cstring.cls

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

    If StartIndex = 0 Or EndIndex = 0 Then Exit Function
    Trim = Mid$(s, StartIndex, EndIndex - StartIndex + 1)
End Function

''
' Joins an array or subarray of strings into a single string, separated by the <i>Delimiter</i>.
'
' @param Arr An array of strings or variants to join together.
' @param Delimiter A string inserted between each element when joining into a string.
' @param Index The starting element in <i>Arr</i> to begin joining from.
' @param Count The number of strings elements to join together.
' @return A string containing elements joined from the array separated by the delimiter.
'
Public Function Join(ByRef Arr As Variant, Optional ByRef Delimiter As Variant, Optional ByRef Index As Variant, Optional ByRef Count As Variant) As String
    Dim pSA         As Long
    Dim ElemIndex   As Long
    Dim ElemCount   As Long
    Dim lb          As Long
    Dim ub          As Long
    Dim ElemSize    As Long
    
    Select Case VarType(Arr)
        Case vbStringArray:      ElemSize = 4
        Case vbVariantArray:     ElemSize = 16
        Case Else
            Throw Cor.NewArgumentException("A String or Variant array is required.", "Arr")
    End Select
    
    pSA = GetArrayPointer(Arr, True)
    lb = LBound(Arr)
    ub = UBound(Arr)
    
    ElemIndex = GetOptionalLong(Index, lb)
    ElemCount = GetOptionalLong(Count, ub - ElemIndex + 1)
    
    Dim Result As Long
    Result = VerifyArrayRange(pSA, ElemIndex, ElemCount)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Arr", ElemIndex, "Index", ElemCount, "Count", IsMissing(Index))
    
    With mJoinSA
        .cElements = ElemCount
        .fFeatures = MemWord(pSA + FFEATURES_OFFSET)
        .pvData = MemLong(pSA + PVDATA_OFFSET) + (ElemIndex - lb) * ElemSize
    End With
    Join = VBA.Join(mJoinArray, Delimiter)
End Function

''
' Removes a substring from the string, returning a new string with the gap filled
' with the remaining characters.
'
' @param s The string to remove characters from.
' @param StartIndex The index of the first character to begin removing. This index is zero-based.
' @param Count The number of characters to be removed.
' @return A new string with the substring removed.
'
Public Function Remove(ByRef s As String, ByVal StartIndex As Long, ByVal Count As Long) As String
    Dim CharCount As Long
    CharCount = Len(s)
    
    Dim Result As Long
    Result = VerifyListRange(CharCount, StartIndex, Count)
    If Result <> NO_ERROR Then Call ThrowListRangeException(Result, StartIndex, "StartIndex", Count, "Count")
    
    Dim sp As Long
    sp = StrPtr(s)
    Remove = SysAllocStringLen(sp, CharCount - Count)
    Call CopyMemory(ByVal StrPtr(Remove) + StartIndex * 2, ByVal sp + (StartIndex + Count) * 2, (CharCount - (StartIndex + Count)) * 2)
End Function

''
' Returns the index of the first character found in the <i>OfAny<i> set of characters.
'
' @param s The string to be searched.
' @param OfAny The set of characters to search for (String or Integer() Array).
' @param Index The starting index of <i>s</i> to begin searching.
' @param Count The number of characters in <i>s</i> to search.
' @return The index of a character from the set, or -1 if none are found.
' @remarks The indexing of <i>s</i> is zero-based.
'
Public Function IndexOfAny(ByRef s As String, ByRef OfAny As Variant, Optional ByVal Index As Variant, Optional ByVal Count As Variant) As Long
    IndexOfAny = InternalIndexOfAny(s, OfAny, Index, Count, True)
End Function

''
' Returns the index of the first character found in the <i>OfAny<i> set of characters
' searching from the end of the string.
'
' @param s The string to be searched.
' @param OfAny The set of characters to search for (String or Integer() Array).
' @param Index The starting index of <i>s</i> to begin searching.
' @param Count The number of characters in <i>s</i> to search.
' @return The index of a character from the set, or -1 if none are found.
' @remarks The indexing of <i>s</i> is zero-based.
'
Public Function LastIndexOfAny(ByRef s As String, ByRef OfAny As Variant, Optional ByVal Index As Variant, Optional ByVal Count As Variant) As Long
    LastIndexOfAny = InternalIndexOfAny(s, OfAny, Index, Count, False)
End Function

''
' Inserts a string into an existing string, returning the result.
'
' @param s The string to insert to.
' @param Index The starting position to insert the string.
' @param Value The string to be inserted.
' @return A string containing the new string created from the insertion.
' @remarks Index is zero-based.
'
Public Function Insert(ByRef s As String, ByVal Index As Long, ByRef Value As String) As String
    If Index < 0 Or Index > Len(s) Then _
        Throw Cor.NewArgumentOutOfRangeException(cString.Format("Index must be between 0 and {0}.", Len(s)), "Index", Index)
    
    Dim ValueLength As Long
    ValueLength = Len(Value)
    
    If ValueLength = 0 Then
        Insert = s
        Exit Function
    End If
    
    Dim PtrS As Long
    PtrS = StrPtr(s)
    
    Insert = Space$(ValueLength + Len(s))
    
    Dim ptrInsert As Long
    ptrInsert = StrPtr(Insert)
    
    ValueLength = ValueLength * 2
    Index = Index * 2
    Call CopyMemory(ByVal ptrInsert, ByVal PtrS, Index)
    Call CopyMemory(ByVal ptrInsert + Index, ByVal StrPtr(Value), ValueLength)
    Call CopyMemory(ByVal ptrInsert + Index + ValueLength, ByVal PtrS + Index, LenB(Insert) - (Index + ValueLength))
End Function

Public Function CharCount(ByRef s As String, ByVal Char As Variant) As Long
    Dim Ch As Integer
    Select Case VarType(Char)
        Case vbLong, vbInteger, vbByte: Ch = Char
        Case vbString:                  Ch = AscW(Char)
        Case Else:                      Throw Cor.NewArgumentException("Invalid Char type.", "Char")
    End Select
    
    mString.SA.pvData = StrPtr(s)
    mString.SA.cElements = Len(s)
    
    Dim i As Long
    For i = 0 To Len(s) - 1
        If mString.Data(i) = Ch Then CharCount = CharCount + 1
    Next i
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function InternalIndexOfAny(ByRef s As String, ByRef OfAny As Variant, ByRef Index As Variant, ByRef Count As Variant, ByVal ForwardSearch As Boolean) As Long
    mString.SA.pvData = StrPtr(s)
    mString.SA.cElements = Len(s)
    
    Dim ElemIndex   As Long
    Dim ElemCount   As Long
    Dim Result      As Long
    If ForwardSearch Then
        Result = GetOptionalArrayRange(VarPtr(mString.SA), Index, ElemIndex, Count, ElemCount)
    Else
        Result = GetOptionalArrayRangeReverse(VarPtr(mString.SA), Index, ElemIndex, Count, ElemCount)
    End If
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "s", ElemIndex, "Index", ElemCount, "Count", IsMissing(Index))

    Dim Chars() As Integer
    Select Case VarType(OfAny)
        Case vbString
            mTrimChars.SA.pvData = StrPtr(OfAny)
            mTrimChars.SA.cElements = Len(OfAny)
            SAPtr(Chars) = VarPtr(mTrimChars.SA)
            
        Case vbIntegerArray
            SAPtr(Chars) = GetArrayPointer(OfAny, True)

        Case Else
            Throw Cor.NewArgumentException("A String or Integer Array is required.", "OfAny")
    End Select

    If ForwardSearch Then
        InternalIndexOfAny = FindIndexOfAny(Chars, ElemIndex, ElemIndex + ElemCount - 1, 1)
    Else
        InternalIndexOfAny = FindIndexOfAny(Chars, ElemIndex, ElemIndex - ElemCount + 1, -1)
    End If

    SAPtr(Chars) = 0
End Function

Private Function FindIndexOfAny(ByRef Chars() As Integer, ByVal StartIndex As Long, ByVal EndIndex As Long, ByVal Direction As Long) As Long
    Dim lb As Long
    lb = LBound(Chars)
    
    Dim ub As Long
    ub = UBound(Chars)
    
    Dim i As Long
    For i = StartIndex To EndIndex Step Direction
        Dim j As Long
        For j = lb To ub
            If mString.Data(i) = Chars(j) Then
                FindIndexOfAny = i
                Exit Function
            End If
        Next j
    Next i
    
    FindIndexOfAny = -1
End Function

Private Function TrimStartIndex(ByRef s As String, ByRef TrimChars() As Integer) As Long
    Dim i   As Long
    Dim lb  As Long
    Dim ub  As Long
    Dim Ch  As Integer
    Dim pos As Long
    Dim l   As Long
    
    lb = LBound(TrimChars)
    ub = UBound(TrimChars)
    l = Len(s)
    With mString
        .SA.pvData = StrPtr(s)
        .SA.cElements = Len(s)
        Do While pos < l
            Ch = .Data(pos)
            For i = lb To ub
                If Ch = TrimChars(i) Then Exit For
            Next i
            If i > ub Then Exit Do
            pos = pos + 1
        Loop
        If pos = l Then Exit Function
        TrimStartIndex = pos + 1
    End With
End Function

' This method is optimized for the default set of whitespace.
Private Function SzTrimStartIndex(ByRef s As String) As Long
    Dim i As Long
    
    With mString
        .SA.pvData = StrPtr(s)
        .SA.cElements = Len(s)
        For i = 0 To .SA.cElements - 1
            Select Case .Data(i)
                Case &H20, &HD, &H9, &HA, &HB, &HC, &HA0, &H2000, &H2001, &H2002, &H2003, &H2004, &H2005, &H2006, &H2007, &H2008, &H2009, &H200A, &H200B, &H3000, &HFEFF
                Case Else
                    SzTrimStartIndex = i + 1
                    Exit Function
            End Select
        Next i
    End With
End Function

Private Function TrimEndIndex(ByRef s As String, ByRef TrimChars() As Integer) As Long
    Dim i   As Long
    Dim lb  As Long
    Dim ub  As Long
    Dim Ch  As Integer
    Dim pos As Long
    
    lb = LBound(TrimChars)
    ub = UBound(TrimChars)
    With mString
        .SA.pvData = StrPtr(s)
        .SA.cElements = Len(s)
        
        pos = .SA.cElements - 1
        Do While pos >= 0
            Ch = .Data(pos)
            For i = lb To ub
                If Ch = TrimChars(i) Then Exit For
            Next i
            If i > ub Then Exit Do
            pos = pos - 1
        Loop
        If pos < 0 Then Exit Function
        TrimEndIndex = pos + 1
    End With
End Function

' This method is optimized for the default set of whitespace.
Private Function SzTrimEndIndex(ByRef s As String) As Long
    Dim i As Long
    
    With mString
        .SA.pvData = StrPtr(s)
        .SA.cElements = Len(s)
        For i = .SA.cElements - 1 To 0 Step -1
            Select Case .Data(i)
                Case &H20, &HD, &H9, &HA, &HB, &HC, &HA0, &H2000, &H2001, &H2002, &H2003, &H2004, &H2005, &H2006, &H2007, &H2008, &H2009, &H200A, &H200B, &H3000, &HFEFF
                Case Else
                    SzTrimEndIndex = i + 1
                    Exit Function
            End Select
        Next i
    End With
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    Set mBuilder = New StringBuilder
    Call InitWordBuffer(mString, 0, 0)
    Call InitWordBuffer(mTrimChars, 0, 0)
    
    With mJoinSA
        .cbElements = 4
        .cDims = 1
    End With
    SAPtr(mJoinArray) = VarPtr(mJoinSA)
End Sub

Private Sub Class_Terminate()
    SAPtr(mJoinArray) = 0
End Sub