source: Include/com/bstring.ab@ 272

' com/bstring.ab

#require <ole2.ab>
#require <oleauto.ab>

Namespace ActiveBasic
Namespace COM

Class BString
    'Inherits 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)
        Init(s.bs, s.Length)
    End Sub

    Sub BString(s As LPCOLESTR)
        bs = SysAllocString(s)
    End Sub

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

    Sub BString(s As PCSTR)
        Init(s, lstrlenA(s))
    End Sub

    Sub BString(s As PCSTR, len As DWord)
        Dim lenBS = MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, 0, 0)
        bs = SysAllocStringLen(0, lenBS)
        MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, bs, lenBS)
    End Sub

    Sub BString(s As String)
        Init(s.StrPtr, s.Length As DWord)
    End Sub

    Sub ~BString()
        Clear()
    End Sub

    Sub Assign(bstr As BString)
        Clear()
        Init(bstr, bstr.Length)
    End Sub

    Sub Assign(s As LPCOLESTR)
        Clear()
        Init(s, lstrlenW(s))
    End Sub

    Sub AssignFromBStr(bstr As BSTR)
        Clear()
        String.Copy(bs, bstr)
    End Sub

    Const Function Copy() As BSTR
        BString.Copy(Copy, bs)
    End Function

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

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

    Sub Clear()
        If bs <> 0 Then
            SysFreeString(bs)
            bs = 0
        End If
    End Sub

    Sub Attach(ByRef bstr As BSTR)
        Clear()
        BString.Move(bs, bstr)
    End Sub

    Function Detach() As BSTR
        BString.Move(Detach, bs)
    End Function

    Function BStr() As BSTR
        BStr = bs
    End Function
/*
    Static Function Assgin(bs As BSTR) As BString
        Assgin = New BString
        Assgin.Assgin(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 = SysStringLen(bs)
    End Function

    Const Function Operator [](i As SIZE_T) As OLECHAR
#ifdef _DEBUG
        If i > Length Then
            'Throw OutOfRangeException
        End If
#endif
        Return bs[i]
    End Function

    Sub Operator []=(i As SIZE_T, c As OLECHAR)
#ifdef _DEBUG
        If i > Length Then
            'Throw OutOfRangeException
        End If
#endif
        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

Private
    bs As BSTR

    Sub Init(s As PCSTR, len As DWord)
        Dim lenBS = MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, 0, 0)
        bs = SysAllocStringLen(0, lenBS)
        MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, bs, lenBS)
    End Sub

    Static Sub Copy(ByRef dst As BSTR, ByVal src As BSTR)
        dst = SysAllocStringLen(src, SysStringLen(src))
    End Sub

    Static Sub Move(ByRef dst As BSTR, ByRef src As BSTR)
        dst = src
        src = 0
    End Sub
End Class

End Namespace 'COM
End Namespace 'ActiveBasic