source: trunk/Include/com/bstring.ab@ 335

' 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)
        BString.Copy(This.bs, s.bs)
    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()
        BString.Copy(This.bs, bstr.bs)
    End Sub

    Sub Assign(s As LPCOLESTR)
        Clear()
        s = SysAllocString(s)
    End Sub

    Sub AssignFromBStr(bstr As BSTR)
        Clear()
        BString.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