' 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 LPCOLESTR, len As DWord)
		init(s, len)
	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

	Function Clone() As BString
		Return New BString(bs, Length)
	End Function

	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 = SysStringLen(bs)
	End Function

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

	Sub Operator []=(i As SIZE_T, c As OLECHAR)
		If i > Length Then
			Throw New System.ArgumentOutOfRangeException("i - BString.Operator [] (set)")
		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(r) 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) As Boolean
		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 s <> 0 Then
			Dim lenBS = MultiByteToWideChar(CP_ACP, 0, s, len As Long, 0, 0)
			bs = SysAllocStringLen(0, lenBS)
			If bs <> 0 Then
				MultiByteToWideChar(CP_ACP, 0, s, len As Long, bs, lenBS)
			End If
		End If
	End Sub

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

	Sub reset(newBS As BSTR)
		Dim old = InterlockedExchangePointer(ByVal VarPtr(bs) As *VoidPtr, 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(ByVal VarPtr(src) As *VoidPtr, 0)
	End Function
End Class

End Namespace 'COM
End Namespace 'ActiveBasic