' com/vbobject.ab

#ifndef _COM_VBIBJECT_AB
#define _COM_VBIBJECT_AB

#include <com/variant.ab>

Class VBObject
Public
	Sub VBObject()
		pdisp = 0
	End Sub

	Sub VBObject(className As String)
		VBObject(ToWCStr(className))
	End Sub

	Sub VBObject(className As PCWSTR)
		pdisp = 0
		Dim clsid As CLSID
		Dim hr = _System_CLSIDFromString(className, clsid)
		Dim hr2 = CoCreateInstance(clsid, 0, CLSCTX_ALL, IID_IDispatch, pdisp)
	End Sub

	Sub VBObject(ByRef obj As VBObject)
		pdisp = obj.pdisp
		pdisp->AddRef()
	End Sub

	Sub Operator =(ByRef obj As VBObject)
		~VBObject()
		VBObject(obj)
	End Sub

	Sub ~VBObject()
		Clear()
	End Sub

	Sub Clear()
		If pdisp <> 0 Then
			pdisp->Release()
			pdisp = 0
		End If
	End Sub

	Function Operator [](name As PCWSTR) As DispatchCaller
		Return GetCaller(name)
	End Function

	Function Operator [](name As String) As DispatchCaller
		Return GetCaller(ToWCStr(name))
	End Function

	Function Equals(y As VBObject) As Boolean
		Dim punkX = GetUnknown()
		Dim punkY = y.GetUnknown()
		Equals = (punkX == punkY)
		punkX->Release()
		punkY->Release()
	End Function
/*
	Override Function GetHashCode() As Long
		Dim punk = GetUnknown()
		GetHashCode = _System_HashFromPtr(punk)
		punk->Release()
	End Function
*/
	Function Operator ==(y As VBObject) As Boolean
		Return Equals(y)
	End Function

	Function Operator <>(y As VBObject) As Boolean
		Return Not Equals(y)
	End Function

	Sub Assign(p As *IDispatch)
		Clear()
		VBObject.Copy(pdisp, p)
	End Sub

	Function GetDispatch() As *IDispatch
		VBObject.Copy(GetDispatch, pdisp)
	End Function

	Sub Attach(ByRef p As *IDispatch)
		Clear()
		VBObject.Move(pdisp, p)
	End Sub

	Sub Detach() As *IDispatch
		VBObject.Move(Detach, pdisp)
	End Sub
Private
	Function GetCaller(name As PCWSTR) As DispatchCaller
		Dim dispid As DISPID
		Dim hr = pdisp->GetIDsOfNames(GUID_NULL, VarPtr(name), 1, LOCALE_USER_DEFAULT, VarPtr(dispid))
		Return New DispatchCaller(pdisp, dispid)
	End Function

	Function GetUnknown() As *IUnknown
		If FAILDED(pdisp->QueryInterface(IID_Unknown, GetUnknown)) Then
			GetUnknown = 0
		End If
	End Function

	pdisp As *IDispatch

	Static Sub Copy(ByRef dst As *IDispatch, ByVal src As *IDispatch)
		dst = src
		dst->AddRef()
	End Sub

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

Class DispatchCaller
Public
	Sub DispatchCaller()
	End Sub
	Sub DispatchCaller(pDispatch As *IDispatch, dispatchId As DISPID)
		pdisp = pDispatch
		pdisp->AddRef()
		dispid = dispatchId
	End Sub

	Sub DispatchCaller(ByRef dc As DispatchCaller)
		pdisp = dc.pdisp
		pdisp->AddRef()
		dispid = dc.dispid
	End Sub

	Sub Operator =(ByRef dc As DispatchCaller)
		Dispose()
		DispatchCaller(dc)
	End Sub

	Sub Dispose()
		If pdisp <> 0 Then
			pdisp->Release()
			pdisp = 0
		End If
	End Sub

	Sub ~DispatchCaller()
		Dispose()
	End Sub

	Function Prop() As Variant
		Dim dispParams As DISPPARAMS
		With dispParams
			.rgvarg = 0
			.rgdispidNamedArgs = 0
			.cArgs = 0
			.cNamedArgs = 0
		End With
		Dim ret As VARIANT
		Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, dispParams, ret, 0, 0)
		Dispose()
		Dim v = New Variant
		v.Attach(ret)
		Return v
	End Function

	Sub Prop(ByRef arg As Variant)
		Prop(ByVal arg.PtrToVariant)
	End Sub

	Sub Prop(ByRef arg As VARIANT)
		Dim dispParams As DISPPARAMS
		With dispParams
			.rgvarg = VarPtr(arg)
			.rgdispidNamedArgs = 0
			.cArgs = 1
			.cNamedArgs = 1
		End With
		Dim ret As VARIANT
		Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYPUT, dispParams, ret, ByVal 0, 0)
		Dispose()
	End Sub

	Sub PropRef(ByRef arg As Variant)
		PropRef(arg.PtrToVariant)
	End Sub

	Sub PropRef(ByRef arg As VARIANT)
		Dim dispParams As DISPPARAMS
		With dispParams
			.rgvarg = 1
			.rgdispidNamedArgs = 0
			.cArgs = VarPtr(arg)
			.cNamedArgs = 0
		End With
		Dim ret As VARIANT
		Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYPUTREF, dispParams, ret, ByVal 0, 0)
		Dispose()
	End Sub

	Function Call(cArgs As Long, args As *VARIANT) As Variant
		Dim dispParams As DISPPARAMS
		With dispParams
			.rgvarg = args
			.rgdispidNamedArgs = 0
			.cArgs = cArgs
			.cNamedArgs = 0
		End With
		Dim ret As VARIANT
		Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, dispParams, ret, ByVal 0, 0)
		Dispose()
		Dim v = New Variant
		v.Attach(ret)
		Return v
	End Function

'	Function Call(cArgs As Long, args As *Variant) As Variant
'	End Function

	Function Call() As Variant
		Return Call(0, 0)
	End Function

	Function Call(arg1 As Variant) As Variant
		Return Call(1, arg1.PtrToVariant)
	End Function

	Function Call(ByRef arg1 As Variant, ByRef arg2 As Variant) As Variant
		Dim arg[1] As VARIANT
		
		Return Call(2, VarPtr(arg1) As *VARIANT)
	End Function

Private
	pdisp As *IDispatch
	dispid As DISPID
End Class
/*
Function CreateObject(className As PCWSTR) As VBObject
	Return New VBObject(className)
End Function

Function CreateObject(className As String) As VBObject
	Return New VBObject(ToWCStr(className))
End Function

#ifdef _WIN32_DCOM
Function CreateObject(className As PCWSTR, serverName As PCWSTR) As VBObject
	Dim clsid As CLSID
	Dim si As COSERVERINFO
	Dim context As DWord
    If /*Server = 0 OrElse* / Server[0] = 0 Then
        context = CLSCTX_SERVER
    Else
        context = CLSCTX_REMOTE_SERVER
        si.pwszName = serverName
    End If

	Dim hr = _System_CLSIDFromString(className, clsid)

	Dim mqi As MULTI_QI
	mqi.pIID = VarPtr(IID_IUnknown)
	hr = CoCreateInstanceEx(clsid, 0, context, si, 1, VarPtr(mqi))
	If SUCCEEDED(hr) Then
		Dim obj As VBObject
		obj.Attach(mqi.pItf As IDispatch)
		Return obj
	Else
		'Throw
		Return Nothing
	End If
End Function	

Function CreateObject(className As String, serverName As String) As VBObject
	Return CreateObject(ToWCStr(className), ToWCStr(serverName))
End Function
#endif
*/
Function _System_CLSIDFromString(pwString As PCWSTR, ByRef guid As GUID) As HRESULT
	If pwString[0] = &h007b As WCHAR Then
        ' 1文字目が { ならクラスIDの文字列表現と見なしCLSIDFromStringで変換。
        _System_CLSIDFromString = CLSIDFromString(pwString, guid)
    Else
        _System_CLSIDFromString = CLSIDFromProgID(pwString, guid)
    End If
End Function

#endif '_COM_VBIBJECT_AB