source: Include/Classes/System/String.ab@ 221

' Classes/System/String.ab

#require <basic/function.sbp>

#ifdef __STRING_IS_NOT_ALWAYS_UNICODE
TypeDef StrChar = Char
#ifndef UNICODE
#define __STRING_IS_NOT_UNICODE
#endif
#else
TypeDef StrChar = WCHAR
#ifndef UNICODE
#define __STRING_UNICODE_WINDOWS_ANSI
#endif
#endif

Class String
'   Inherits IComparable, ICloneable, IConvertible, IEnumerable

    m_Length As Long
Public
    Chars As *StrChar

    Sub String()
        Chars = _System_malloc(SizeOf (StrChar))
        Chars[0] = 0
        m_Length = 0
    End Sub

    Sub String(initStr As PCSTR)
        Assign(initStr)
    End Sub

    Sub String(initStr As PCSTR, length As Long)
        Assign(initStr, length)
    End Sub

    Sub String(initStr As PCWSTR)
        Assign(initStr)
    End Sub

    Sub String(initStr As PCWSTR, length As Long)
        Assign(initStr, length)
    End Sub

    Sub String(ByRef initStr As String)
        Assign(initStr)
    End Sub

    Sub String(length As Long)
        ReSize(length)
    End Sub

    Sub String(initChar As StrChar, length As Long)
        ReSize(length, initChar)
    End Sub

    Sub ~String()
        _System_free(Chars)
        Chars = 0
#ifdef _DEBUG
        m_Length = 0
#endif
    End Sub

    Const Function Length() As Long
        Return m_Length
    End Function

    Function Operator() As *StrChar
        Return Chars
    End Function

/*  Sub Operator = (ByRef objString As String)
        Assign(objString.Chars, objString.m_Length)
    End Sub

    Sub Operator = (text As *Byte)
        Assign(text As PCTSTR)
    End Sub

    Sub Operator = (text As PCSTR)
        Assign(text)
    End Sub

    Sub Operator = (text As PCWSTR)
        Assign(text)
    End Sub*/

    Const Function Operator [] (n As Long) As StrChar
#ifdef _DEBUG
        If n > Length Then
            'Throw ArgumentOutOfRangeException
            Debug
        End If
#endif
        Return Chars[n]
    End Function

    Sub Operator []= (n As Long, c As StrChar)
#ifdef _DEBUG
        If n >= Length Then
            'Throw ArgumentOutOfRangeException
            Debug
        End If
#endif
        Chars[n] = c
    End Sub

/*  Const Function Operator + (text As *Byte) As String
        Return Concat(text As PCTSTR, lstrlen(text))
    End Function*/

    Const Function Operator + (text As PCSTR) As String
        Return Concat(text, lstrlenA(text))
    End Function

    Const Function Operator + (text As PCWSTR) As String
        Return Concat(text, lstrlenW(text))
    End Function

    Const Function Operator + (objString As String) As String
        Return Concat(objString.Chars, objString.m_Length)
    End Function

    Const Function Operator & (text As PCSTR) As String
        Dim tempString = This + text
        Return tempString
    End Function

    Const Function Operator & (text As PCWSTR) As String
        Dim tempString = This + text
        Return tempString
    End Function

    Const Function Operator & (objString As String) As String
        Dim tempString = This + objString
        Return tempString
    End Function

    Const Function Operator == (objString As String) As Boolean
        Return String.Compare(This, objString) = 0
    End Function

    Const Function Operator == (text As *StrChar) As Long
        Return _System_StrCmp(This.Chars, text) = 0
    End Function

    Const Function Operator <> (objString As String) As Boolean
        Return String.Compare(This, objString) <> 0
    End Function

    Const Function Operator <> (text As *StrChar) As Boolean
        Return _System_StrCmp(This.Chars, text) <> 0
    End Function

    Const Function Operator < (objString As String) As Boolean
        Return String.Compare(This, objString) < 0
    End Function

    Const Function Operator < (text As *StrChar) As Boolean
        Return _System_StrCmp(This.Chars, text) < 0
    End Function

    Const Function Operator > (objString As String) As Boolean
        Return String.Compare(This, objString) > 0
    End Function

    Const Function Operator > (text As *StrChar) As Boolean
        Return _System_StrCmp(This.Chars, text) > 0
    End Function

    Const Function Operator <= (objString As String) As Boolean
        Return String.Compare(This, objString) <= 0
    End Function

    Const Function Operator <= (text As *StrChar) As Boolean
        Return _System_StrCmp(This.Chars, text) <= 0
    End Function

    Const Function Operator >= (objString As String) As Boolean
        Return String.Compare(This, objString) >= 0
    End Function

    Const Function Operator >= (text As *StrChar) As Boolean
        Return _System_StrCmp(This.Chars, text) >= 0
    End Function

    Static Function Compare(x As String, y As String) As Long
        Return CompareOrdinal(x, y)
    End Function

    Static Function Compare(x As String, indexX As Long, y As String, indexY As Long, length As Long) As Long
        Return CompareOrdinal(x, indexX, y, indexY, length)
    End Function

    Static Function CompareOrdinal(x As String, y As String) As Long
        Return _System_StrCmp(x.Chars, y.Chars)
    End Function

    Static Function CompareOrdinal(x As String, indexX As Long, y As String, indexY As Long, length As Long) As Long
        If x = Nothing Then
            If y = Nothing Then
                Return 0
            Else
                Return -1
            End If
        ElseIf y = Nothing Then
            Return 1
        End If
        Return _System_StrCmpN(VarPtr(x.Chars[indexX]), VarPtr(y.Chars[indexY]), length)
    End Function

    Function CompareTo(y As String) As Long
        Return String.Compare(This, y)
    End Function

    Function CompareTo(y As Object) As Long
        Dim s = y As String
'       If y is not String Then
'           Throw New ArgumentException
'       End If
        Return CompareTo(y)
    End Function

    Const Function StrPtr() As *StrChar
        Return Chars
    End Function

    Sub ReSize(allocLength As Long)
        If allocLength < 0 Then Exit Sub
        If allocLength > m_Length Then
            Dim oldLength As Long
            oldLength = m_Length
            If AllocStringBuffer(allocLength) <> 0 Then
                ZeroMemory(VarPtr(Chars[oldLength]), SizeOf (StrChar) * (m_Length - oldLength + 1))
            End If
        Else
            m_Length = allocLength
            Chars[m_Length] = 0
        End If
    End Sub

    Sub ReSize(allocLength As Long, c As StrChar)
        If allocLength < 0 Then
            Exit Sub
        ElseIf allocLength > m_Length Then
            Dim oldLength As Long
            oldLength = m_Length
            If AllocStringBuffer(allocLength) <> 0 Then
                Dim p = VarPtr(Chars[oldLength]) As *StrChar
                Dim fillLen = m_Length - oldLength
                Dim i As Long
                For i = 0 To ELM(fillLen)
                    p[i] = c
                Next
            End If
        Else
            m_Length = allocLength
        End If
        Chars[m_Length] = 0
    End Sub

    Sub Assign(text As PCSTR, textLengthA As Long)
#ifdef __STRING_IS_NOT_UNICODE
        AssignFromStrChar(text, textLengthA)
#else
        Dim textLengthW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, 0, 0)
        If AllocStringBuffer(textLengthW) <> 0 Then
            MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, Chars, textLengthW)
            Chars[textLengthW] = 0
        End If
#endif
    End Sub

    Sub Assign(text As PCWSTR, textLengthW As Long)
#ifdef __STRING_IS_NOT_UNICODE
        Dim textLengthA = WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, 0, 0, 0, 0)
        If AllocStringBuffer(textLengthA) <> 0 Then
            WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, Chars, textLengthA, 0, 0)
            Chars[textLengthA] = 0
        End If
#else
        AssignFromStrChar(text, textLengthW)
#endif
    End Sub

    Sub Assign(ByRef objString As String)
        Assign(objString.Chars, objString.m_Length)
    End Sub

    Sub Assign(text As PCSTR)
        If text Then
            Assign(text, lstrlenA(text))
        Else
            If Chars <> 0 Then
                Chars[0] = 0
            End If
            m_Length = 0
        End If
    End Sub

    Sub Assign(text As PCWSTR)
        If text Then
            Assign(text, lstrlenW(text))
        Else
            If Chars <> 0 Then
                Chars[0] = 0
            End If
            m_Length = 0
        End If
    End Sub

    Sub Append(text As *StrChar, textLength As Long)
        Dim prevLen As Long
        prevLen = m_Length
        If AllocStringBuffer(m_Length + textLength) <> 0 Then
            memcpy(VarPtr(Chars[prevLen]), text, SizeOf (StrChar) * textLength)
            Chars[m_Length] = 0
        End If
    End Sub

    Sub Append(text As *StrChar)
        Append(text, lstrlen(text))
    End Sub

    Sub Append(ByRef str As String)
        Append(str.Chars, str.m_Length)
    End Sub

    Const Function Clone() As String
        Return This
    End Function
Private
    Static Function ConcatStrChar(text1 As *StrChar, text1Length As Long, text2 As *StrChar, text2Length As Long) As String
        ConcatStrChar = New String()
        With ConcatStrChar
            .AllocStringBuffer(text1Length + text2Length)
            memcpy(.Chars, text1, SizeOf (StrChar) * text1Length)
            memcpy(VarPtr(.Chars[text1Length]), text2, SizeOf (StrChar) * text2Length)
            .Chars[text1Length + text2Length] = 0
        End With
    End Function
Public
    Const Function Concat(text As PCSTR, len As Long) As String
#ifdef __STRING_IS_NOT_UNICODE
        Return ConcatStrChar(This.Chars, m_Length, text, len)
#else
        With Concat
            Dim lenW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, 0, 0)
            .AllocStringBuffer(m_Length + lenW)
            memcpy(.Chars, This.Chars, m_Length)
            MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenW)
            .Chars[m_Length + lenW] = 0
        End With
#endif
    End Function

    Const Function Concat(text As PCWSTR, len As Long) As String
#ifdef __STRING_IS_NOT_UNICODE
        With Concat
            Dim lenA = MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, 0, 0, 0, 0)
            .AllocStringBuffer(m_Length + lenA)
            memcpy(.Chars, This.Chars, m_Length)
            MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenA, 0, 0)
            .Chars[m_Length + lenA] = 0
        End With
#else
        Return ConcatStrChar(This.Chars, m_Length, text, len)
#endif
    End Function

    Static Function Concat(x As String, y As String) As String
        If x = Nothing Then
            Return y
        Else
            Return x.Concat(objString.Chars, objString.m_Length)
        End If
    End Function

    Static Function Concat(x As Object, y As Object) As String
        Return String.Concat(x.ToString, y.ToString)
    End Function

    Const Function Contains(objString As String) As Boolean
        Return IndexOf(objString, 0, m_Length) >= 0
    End Function

    Const Function Contains(lpszText As *StrChar) As Boolean
        Return IndexOf(lpszText, 0, m_Length) >= 0
    End Function

    Const Function IndexOf(lpszText As *StrChar) As Long
        Return IndexOf(lpszText, 0, m_Length)
    End Function

    Const Function IndexOf(lpszText As *StrChar, startIndex As Long) As Long
        Return IndexOf(lpszText, startIndex, m_Length - startIndex)
    End Function

    Const Function IndexOf(lpszText As *StrChar, startIndex As Long, count As Long) As Long
        Dim length = lstrlen(lpszText)

        If startIndex < 0 Then Return -1
        If count < 1 Or count + startIndex > m_Length Then Return -1
        If length > m_Length Then Return -1

        If length = 0 Then Return startIndex

        Dim i As Long, j As Long
        For i = startIndex To startIndex + count - 1
            For j = 0 To length - 1
                If Chars[i + j] = lpszText[j] Then
                    If j = length - 1 Then Return i
                Else
                    Exit For
                End If
            Next
        Next
        Return -1
    End Function

    Const Function LastIndexOf(lpszText As *StrChar) As Long
        Return LastIndexOf(lpszText, m_Length - 1, m_Length)
    End Function

    Const Function LastIndexOf(lpszText As *StrChar, startIndex As Long) As Long
        Return LastIndexOf(lpszText As *StrChar, startIndex, startIndex + 1)
    End Function

    Const Function LastIndexOf(lpszText As *StrChar, startIndex As Long, count As Long) As Long
        Dim length = lstrlen(lpszText)

        If startIndex < 0 Or startIndex > m_Length - 1 Then Return -1
        If count < 1 Or count > startIndex + 2 Then Return -1
        If length > m_Length Then Return -1

        If length = 0 Then Return startIndex

        Dim i As Long, j As Long
        For i = startIndex To  startIndex - count + 1 Step -1
            For j = length - 1 To 0 Step -1
                If Chars[i + j] = lpszText[j] Then
                    If j = 0 Then Return i
                Else
                    Exit For
                End If
            Next
        Next
        Return -1
    End Function

    Const Function StartsWith(lpszText As *StrChar) As Boolean
        Return IndexOf(lpszText) = 0
    End Function

    Const Function EndsWith(lpszText As *StrChar) As Boolean
        Return LastIndexOf(lpszText) = m_Length - lstrlen(lpszText)
    End Function

    Const Function Insert(startIndex As Long, text As String) As String
        Return Insert(startIndex, text.Chars, text.Length)
    End Function

    Const Function Insert(startIndex As Long, text As *StrChar) As String
        Return Insert(startIndex, text, lstrlen(text))
    End Function

    Const Function Insert(startIndex As Long, text As *StrChar, length As Long) As String
        If startIndex < 0 Or startIndex > m_Length Or length < 0 Then
            Debug 'ArgumentOutOfRangeException

        End If
        Insert.ReSize(m_Length + length)
        memcpy(Insert.Chars, Chars, SizeOf (StrChar) * startIndex)
        memcpy(VarPtr(Insert.Chars[startIndex]), text, SizeOf (StrChar) * length)
        memcpy(VarPtr(Insert.Chars[startIndex + length]), VarPtr(Chars[startIndex]), SizeOf (StrChar) * (m_Length - startIndex + 1))
    End Function

    Const Function SubString(startIndex As Long) As String
        Return SubString(startIndex, m_Length - startIndex)
    End Function

    Const Function SubString(startIndex As Long, length As Long) As String
        If startIndex < 0 Or length <= 0 Then Return ""
        If startIndex + length > m_Length Then Return ""

        Dim temp As String
        temp.AllocStringBuffer(length)
        memcpy(temp.Chars, VarPtr(Chars[startIndex]), SizeOf (StrChar) * length)
        Chars[m_Length] = 0
        Return temp
    End Function

    Const Function Remove(startIndex As Long) As String
        If startIndex < 0 Or startIndex > m_Length Then
            Debug 'ArgumentOutOfRangeException
        End If

        Remove.ReSize(startIndex)
        memcpy(Remove.Chars, This.Chars, SizeOf (StrChar) * startIndex)
    End Function

    Const Function Remove(startIndex As Long, count As Long) As String
        If startIndex < 0 Or count < 0 Or startIndex + count > m_Length Then
            Debug 'ArgumentOutOfRangeException
        End If

        Remove.ReSize(m_Length - count)
        memcpy(Remove.Chars, This.Chars, SizeOf (StrChar) * startIndex)
        memcpy(VarPtr(Remove.Chars[startIndex]), VarPtr(This.Chars[startIndex + count]), SizeOf (StrChar) * (m_Length - startIndex - count))
    End Function

    Static Function IsNullOrEmpty(s As String) As Boolean
        If s <> Nothing Then
            If s.m_Length > 0 Then
                Return True
            End If
        End If
        Return False
    End Function

    Const Function Replace(oldChar As StrChar, newChar As StrChar) As String
        Replace = Copy(This)
        With Replace
            Dim i As Long
            For i = 0 To ELM(.m_Length)
                If .Chars[i] = oldChar Then
                    .Chars[i] = newChar
                End If
            Next
        End With
    End Function

    Const Function Replace(ByRef oldStr As String, ByRef newStr As String) As String
'       If oldStr = Nothing Then Throw ArgumentNullException
'
'       If newStr = Nothing Then
'           Return ReplaceCore(oldStr, oldStr.m_Length, "", 0)
'       Else
            Return ReplaceCore(oldStr, oldStr.m_Length, newStr, newStr.m_Length)
'       End If
    End Function

    Const Function Replace(oldStr As *StrChar, newStr As *StrChar)
        If oldStr = 0 Then Debug 'Throw ArgumentNullException
        If newStr = 0 Then newStr = ""
        Return ReplaceCore(oldStr, lstrlen(oldStr), newStr, lstrlen(newStr)) As String
    End Function

    Const Function Replace(oldStr As *StrChar, oldLen As Long, newStr As *StrChar, newLen As Long) As String
        If oldStr = 0 Then Debug 'Throw ArgumentNullException
        If newStr = 0 Then
            newStr = ""
            newLen = 0
        End If
        Return ReplaceCore(oldStr, oldLen, newStr, newLen)
    End Function

    Const Function ToLower() As String
        ToLower.ReSize(m_Length)
        Dim i As Long
        For i = 0 To ELM(m_Length)
            ToLower.Chars[i] = _System_ASCII_ToLower(Chars[i])
        Next
    End Function

    Const Function ToUpper() As String
        ToUpper.ReSize(m_Length)
        Dim i As Long
        For i = 0 To ELM(m_Length)
            ToUpper.Chars[i] = _System_ASCII_ToUpper(Chars[i])
        Next
    End Function

    Sub Swap(ByRef x As String)
        Dim tempLen As Long
        Dim tempChars As *StrChar
        tempLen = x.m_Length
        tempChars = x.Chars
        x.m_Length = This.m_Length
        x.Chars = This.Chars
        This.m_Length = tempLen
        This.Chars = tempChars
    End Sub

    Override Function ToString() As String
        Return This
    End Function

    Static Function Copy(s As String) As String
        Copy.ReSize(s.m_Length)
        memcpy(Copy.Chars, This.Chars, SizeOf (StrChar) * m_Length)
    End Function

    Override Function GetHashCode() As Long
#ifdef __STRING_IS_NOT_UNICODE
        Dim size = (m_Length + 1) >> 1
#else
        Dim size = m_Length
#endif
        Return _System_GetHashFromWordArray(Chars As *Word, size)
    End Function
Private
    ' メモリ確保に失敗すると元の文字列は失われない。（例外安全でいう強い保障）
    Function AllocStringBuffer(textLength As Long) As *StrChar
        If textLength < 0 Then
            Return 0
        ElseIf textLength > m_Length or Chars = 0 Then
            AllocStringBuffer = _System_realloc(Chars, SizeOf(StrChar) * (textLength + 1))
            If AllocStringBuffer <> 0 Then
                m_Length = textLength
                Chars = AllocStringBuffer
            End If
        Else
            m_Length = textLength
            AllocStringBuffer = Chars
        End If
    End Function

    Function ReplaceCore(oldStr As *StrChar, oldLen As Long, newStr As *StrChar, newLen As Long) As String
        If oldLen = 0 Then
            Debug 'Throw ArgumentException
        End If
        Dim tmp As String
        With tmp
            Dim current = 0 As Long
            Do
                Dim pos = IndexOf(oldStr, current)
                If pos = -1 Then
                    Exit Do
                End If
                .Append(VarPtr(Chars[current]), pos - current)
                .Append(newStr, newLen)
                current = pos + oldLen
            Loop
            .Append(VarPtr(Chars[current]), m_Length - current)
        End With
        Return tmp
    End Function

    Sub AssignFromStrChar(text As *StrChar, textLength As Long)
        If text = Chars Then Exit Sub
        If AllocStringBuffer(textLength) <> 0 Then
            memcpy(Chars, text, SizeOf (StrChar) * textLength)
            Chars[m_Length] = 0
        End If
    End Sub
End Class