' 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