source: trunk/ab5.0/ablib/src/com/bstring.ab@ 506

' com/bstring.ab

Namespace ActiveBasic
Namespace COM

Class BString
    Implements System.IDisposable ', System.ICloneable
Public
    Sub BString()
        bs = 0
    End Sub

    Sub BString(len As DWord)
        bs = SysAllocStringLen(0, len)
    End Sub

    Sub BString(s As BString)
        If Not IsNothing(s) Then
            bs = copy(s.bs)
        End If
    End Sub

    Sub BString(s As LPCOLESTR, len As DWord)
        If s <> 0 Then
            bs = SysAllocStringLen(s, len)
        End If
    End Sub

    Sub BString(s As String)
        If Not IsNothing(s) Then
            Init(s.StrPtr, s.Length As DWord)
        End If
    End Sub

    Static Function FromBStr(bs As BSTR) As BString
        FromBStr = New BString(bs, SysStringLen(bs))
    End Function

    Static Function FromCStr(s As PCWSTR) As BString
        If s <> 0 Then
            FromCStr = New BString(s, lstrlenW(s))
        Else
            FromCStr = New BString
        End If
    End Function

    Static Function FromCStr(s As PCWSTR, len As DWord) As BString
        If s <> 0 Then
            FromCStr = New BString(s, len)
        Else
            FromCStr = New BString
        End If
    End Function

    Static Function FromCStr(s As PCSTR) As BString
        Dim dst As PCWSTR
        Dim lenW = GetStr(s, dst)
        FromCStr = FromCStr(s, lenW)
    End Function

    Static Function FromCStr(s As PCSTR, len As DWord) As BString
        Dim dst As PCWSTR
        Dim lenW = GetStr(s, len, dst)
        FromCStr = FromCStr(s, lenW)
    End Function

    Sub ~BString()
        Clear()
    End Sub

    Const Function Copy() As BSTR
        Copy = copy(bs)
    End Function

    /*Override*/ Function Clone() As BString
        Return New BString(This)
    End Function

    /*Override*/ Sub Dispose()
        Clear()
    End Sub

    Sub Clear()
        reset(0)
    End Sub

    Sub Attach(ByRef bstr As BSTR)
        reset(move(bstr))
    End Sub

    Function Detach() As BSTR
        Detach = move(bs)
    End Function

    Function BStr() As BSTR
        BStr = bs
    End Function

    Static Function Attach(bs As BSTR) As BString
        Attach = New BString
        Attach.Attach(bs)
    End Function

    Const Function Length() As DWord
        Length = GetDWord(bs As VoidPtr - SizeOf (DWord)) 'SysStringLen(bs)
    End Function

    Const Function Operator [](i As SIZE_T) As OLECHAR
        If i > Length Then
            Throw New ArgumentOutOfRangeException("i")
        End If
        Return bs[i]
    End Function

    Sub Operator []=(i As SIZE_T, c As OLECHAR)
        If i > Length Then
            Throw New ArgumentOutOfRangeException("i")
        End If
        bs[i] = c
    End Sub

    Override Function ToString() As String
        Return New String(bs As PCWSTR, Length As Long)
    End Function

    Override Function GetHashCode() As Long
        Return _System_GetHashFromWordArray(bs, Length)
    End Function

    Override Function Equals(o As Object) As Boolean
        If Not IsNothing(o) Then
            If This.GetType().Equals(o.GetType()) Then
                Equals(o As BString)
            End If
        End If
    End Function

    Const Function Equals(s As BString) As Boolean
        Equals = Compare(This, s) = 0
    End Function

    Static Function Compare(l As BString, r As BString) As Long
        If IsNullOrEmpty(l) Then
            If IsNullOrEmpty(r) Then
                Compare = 0
            Else
                Compare = -1
            End If
        Else
            If IsNullOrEmpty(bsr) Then
                Compare = 1
            Else
                Compare = Strings.ChrCmp(l.bs, l.Length As SIZE_T, r.bs, r.Length As SIZE_T)
            End If
        End If
    End Function

    Static Function IsNullOrEmpty(s As BString)
        If IsNothing(s) Then
            IsNullOrEmpty = True
        ElseIf s.bs = 0 Then
            IsNullOrEmpty = True
        ElseIf s.Length = 0 Then
            IsNullOrEmpty = True
        Else
            IsNullOrEmpty = False
        End If
    End Function

    Function Operator ==(s As BString) As Boolean
        Return Compare(This, s) = 0
    End Function

    Function Operator <>(s As BString) As Boolean
        Return Compare(This, s) <> 0
    End Function

    Function Operator <(s As BString) As Boolean
        Return Compare(This, s) < 0
    End Function

    Function Operator <=(s As BString) As Boolean
        Return Compare(This, s) <= 0
    End Function

    Function Operator >(s As BString) As Boolean
        Return Compare(This, s) > 0
    End Function

    Function Operator >=(s As BString) As Boolean
        Return Compare(This, s) >= 0
    End Function

Private
    bs As BSTR

    Sub init(s As PCSTR, len As DWord)
        If <> 0 Then
            Dim lenBS = MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, 0, 0)
            bs = SysAllocStringLen(0, lenBS)
            If bs <> 0 Then
                MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, bs, lenBS)
            End If
        End If
    End Sub

    Sub reset(newBS As BSTR)
        Dim old = InterlockedExchangePointer(bs, newBS)
        SysFreeString(old)
    End Sub

    Static Function copy(src As BSTR) As BSTR
        copy = SysAllocStringLen(src, SysStringLen(src))
    End Function

    Static Function move(ByRef src As BSTR) As BSTR
        move = InterlockedExchangePointer(src, 0)
    End Function
End Class

End Namespace 'COM
End Namespace 'ActiveBasic