' 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