cstring.cls

在线ZIP在线ZIP在线ZIP在线ZIP在线ZIP在线ZIP

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CString"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Const NONE = 0
Const STRINGTYPE = 1
Const INTEGERTYPE = 2
Const LONGTYPE = 3
Const FLOATTYPE = 4
Const CHARPERCENT = 5

Private m_szValue As String


Public Property Get Value() As String
Attribute Value.VB_UserMemId = 0
Attribute Value.VB_MemberFlags = "200"
    Value = m_szValue
    
End Property

Public Property Let Value(ByVal vData As String)
    m_szValue = CStr(vData)
    
End Property

Public Property Get Length() As Long
    Length = Len(m_szValue)
End Property

Public Sub Append(ByVal szString As String)
    If TypeName(szString) <> "CString" And TypeName(szString) <> "String" Then
        Err.Raise 93, "CString", "Appending object must be a String or CString."
        Exit Sub
    End If

    m_szValue = m_szValue & szString
    
End Sub

Public Function CountSubstring(ByVal strFind As String) As Long
    Dim strInput As String
    strInput = m_szValue
    CountSubstring = (Len(strInput) - Len(InterfaceReplace(strInput, strFind, ""))) / Len(strFind)
    
End Function

Public Function Compare(ByVal szString As String)
    
    Dim nValue As Long
    Dim nValue2 As Long
    Dim i
    
    If TypeName(szString) <> "CString" And TypeName(szString) <> "String" Then
        Err.Raise 93, "CString", "Comparing object must be a String or CString."
        Exit Function
    End If
    
    If Not Len(szString) = 0 And Not Len(m_szValue) = 0 Then
        For i = 1 To Len(m_szValue)
            nValue = nValue + CLng(Asc(VBA.Mid(m_szValue, i, 1)))
        Next
        For i = 1 To Len(szString)
            nValue2 = nValue2 + CLng(Asc(VBA.Mid(szString, i, 1)))
        Next
    End If
    
    If nValue - nValue2 < 0 Then
        Compare = -1
    ElseIf nValue - nValue2 > 0 Then
        Compare = 1
    Else
        Compare = 0
    End If
    
End Function

Public Function CompareNoCase(ByVal szString As String)
    
    Dim szMax As String
    Dim szMax2 As String
    Dim i
    
    Dim nValue As Long
    Dim nValue2 As Long
        
    If TypeName(szString) <> "CString" And TypeName(szString) <> "String" Then
        Err.Raise 93, "CString", "Comparing object must be a String or CString."
        Exit Function
    End If
    
    szMax = UCase(m_szValue)
    szMax2 = UCase(szString)
    
    
    If Not Len(szString) = 0 And Not Len(m_szValue) = 0 Then
        For i = 1 To Len(m_szValue)
            nValue = nValue + CLng(Asc(VBA.Mid(szMax, i, 1)))
        Next
        For i = 1 To Len(szString)
            nValue2 = nValue2 + CLng(Asc(VBA.Mid(szMax2, i, 1)))
        Next
    End If
    
    If nValue - nValue2 < 0 Then
        CompareNoCase = -1
    ElseIf nValue - nValue2 > 0 Then
        CompareNoCase = 1
    Else
        CompareNoCase = 0
    End If
    
End Function

Public Function Equals(ByVal szString As Variant) As Boolean
    If TypeName(szString) <> "CString" And TypeName(szString) <> "String" Then
        Err.Raise 93, "CString", "Equalizing object must be a String or CString."
        Exit Function
    End If
    
    Equals = (szString = m_szValue)
    
End Function

Public Function EqualsNoCase(ByVal szString As Variant) As Boolean
    If TypeName(szString) <> "CString" And TypeName(szString) <> "String" Then
        Err.Raise 93, "CString", "Equalizing object must be a String or CString."
        Exit Function
    End If
    
    EqualsNoCase = (LCase(szString) = LCase(m_szValue))
    
End Function


Public Function GetAt(ByVal nWhere As Long) As String
    If nWhere > Len(m_szValue) Then GetAt = ""
    GetAt = VBA.Mid(m_szValue, nWhere, 1)
        
End Function

Public Sub SetAt(ByVal nWhere As Long, ByVal sChar As String)
    sChar = VBA.Left(sChar, 1)
    
    Dim szTemp As String
    Dim i As Integer

    If nWhere > Len(m_szValue) Then
        szTemp = Space(nWhere)
        Mid(szTemp, i, Len(m_szValue)) = m_szValue
    Else
        szTemp = m_szValue
    End If
    Mid(szTemp, nWhere, 1) = sChar
            
End Sub

Public Function IsEmpty() As Boolean
    If Len(m_szValue) = 0 Then IsEmpty = True
    
End Function

Public Sub MakeEmpty()
    m_szValue = ""
End Sub

Public Function Mid(ByVal nFirst As Long, Optional ByVal nCount As Long) As String
    Mid = CStr(VBA.Mid(m_szValue, nFirst, nCount))
End Function

Public Function Left(ByVal nCount As Long) As String
    Left = CStr(VBA.Left(m_szValue, nCount))
End Function

Public Function Right(ByVal nCount As Long) As String
    Right = CStr(VBA.Right(m_szValue, nCount))
End Function

Public Function SpanIncluding(ByVal szCharSet As String) As String
    Dim szRet As String
    Dim i
    
    
    If Not Len(m_szValue) > 0 Or Not Len(szCharSet) > 0 Then
        Exit Function
    End If
    
    For i = 1 To Len(m_szValue)
        If InStr(szCharSet, VBA.Mid(m_szValue, i, 1)) <> 0 Then
            szRet = szRet & VBA.Mid(m_szValue, i, 1)
        End If
    Next
    
    SpanIncluding = szRet
    
End Function

Public Function SpanExcluding(ByVal szCharSet As String) As String
    Dim szRet As String
    Dim i
    
    If Not Len(m_szValue) > 0 Or Not Len(szCharSet) > 0 Then
        Exit Function
    End If
    
    For i = 1 To Len(m_szValue)
        If InStr(szCharSet, VBA.Mid(m_szValue, i, 1)) = 0 Then
            szRet = szRet & VBA.Mid(m_szValue, i, 1)
        End If
    Next
    
    SpanExcluding = szRet
    
End Function

Public Sub MakeUpper()
    m_szValue = UCase(m_szValue)
End Sub

Public Sub MakeLower()
    m_szValue = LCase(m_szValue)
End Sub

Public Sub MakeReverse()
    Dim szTemp As String
    Dim i
    
    If Len(m_szValue) = 0 Then Exit Sub
    
    For i = Len(m_szValue) To 1 Step -1
        szTemp = szTemp & VBA.Mid(m_szValue, i, 1)
    Next
    
    m_szValue = szTemp
    
    
End Sub

Public Sub Replace(strFind As String, strReplace As String)
    m_szValue = InterfaceReplace(m_szValue, strFind, strReplace)
End Sub

Public Sub Remove(ByVal szChar As String)
    If Len(szChar) > 1 Then szChar = VBA.Left(szChar, 1)
    
    Replace szChar, ""
    
End Sub

Public Sub Insert(ByVal nIndex As Long, ByVal szStr As String)
    Dim szLeft As String
    Dim szRight As String
    
    If nIndex > 1 And Len(m_szValue) > 0 Then
        szLeft = Left(nIndex - 1)
    Else
        szLeft = ""
    End If
    
    szRight = Right(Len(m_szValue) - nIndex + 1)
    
    m_szValue = szLeft & szStr & szRight
            
End Sub

Public Sub Delete(ByVal nIndex As Long, Optional nCount As Long = 1)
    Dim sLeft As String, sRight As String
    Dim nLen As Integer
    
    nLen = Len(m_szValue)


    If nIndex >= 0 And nIndex <= nLen Then


        If nIndex > 1 And nLen > 0 Then
            sLeft = Left(nIndex - 1)
        Else
            sLeft = ""
        End If

        If (nIndex + nCount) <= nLen Then
            sRight = VBA.Mid(m_szValue, nIndex + nCount)
        Else
            sRight = ""
        End If

        m_szValue = sLeft & sRight
        
    End If

End Sub

Public Sub TrimLeft()
    LTrim m_szValue