Index: trunk/ab5.0/ablib/src/com/vbobject.ab
===================================================================
--- trunk/ab5.0/ablib/src/com/vbobject.ab	(revision 506)
+++ trunk/ab5.0/ablib/src/com/vbobject.ab	(revision 709)
@@ -6,55 +6,35 @@
 Namespace COM
 
-Class VBObject
+Class VBObjectBase
+	Implements System.IDisposable, System.IEquatable<VBObjectBase>
 Public
-	Sub VBObject()
-		pdisp = 0
-	End Sub
-
-	Sub VBObject(className As String, pOuter As *IUnknown, clsContext As DWord)
-		VBObject(ToWCStr(className), pOuter, clsContext)
-	End Sub
-
-	Sub VBObject(className As PCSTR, pOuter As *IUnknown, clsContext As DWord)
-		VBObject(ToWCStr(className), pOuter, clsContext)
-	End Sub
-
-	Sub VBObject(className As PCWSTR, pOuter As *IUnknown, clsContext As DWord)
-		pdisp = 0
-		Dim clsid As CLSID
-		Dim hr = _System_CLSIDFromString(className, clsid)
-		VBObject(clsid, pOuter, clsContext)
-	End Sub
-
-	Sub VBObject(ByRef clsid As CLSID, pOuter As *IUnknown, clsContext As DWord)
-		Dim hr = CoCreateInstance(clsid, pOuter, clsContext, IID_IDispatch, pdisp)
-	End Sub
-
-	Sub VBObject(ByRef obj As VBObject)
-		pdisp = obj.pdisp
-		pdisp->AddRef()
-	End Sub
-
-	Sub ~VBObject()
-		Clear()
+	Sub VBObjectBase()
+		disp = Nothing
+	End Sub
+
+	Sub VBObjectBase(dispObj As IDispatch)
+		copy(disp, dispObj)
+	End Sub
+
+	Sub ~VBObjectBase()
+		Dispose()
 	End Sub
 
 	Sub Clear()
-		If pdisp <> 0 Then
-			pdisp->Release()
-			pdisp = 0
+		Dispose()
+	End Sub
+
+	Virtual Sub Dispose()
+		If ObjPtr(disp) <> 0 Then
+			disp.Release()
+			disp = Nothing
 		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
-		Return _System_COMReferenceEquals(pdisp, y.pdisp)
+'	Override Function Equals(y As Object) As Boolean
+'	End Function
+
+	Virtual Function Equals(y As VBObjectBase) As Boolean
+		Return Detail.COMReferenceEquals(This.Dispatch, y.Dispatch)
 	End Function
 /*
@@ -65,78 +45,108 @@
 	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)
+
+	Function Copy() As IDispatch
+		copy(Copy, disp)
+	End Function
+
+	Sub Attach(ByRef y As IDispatch)
+'		Clear()
+'		move(pdisp, y)
+	End Sub
+
+	Function Detach() As IDispatch
+		move(Detach, disp)
+	End Function
+
+	Function Dispatch() As IDispatch
+		Dispatch = disp
+	End Function
+Protected
+
+	Sub attach(ByRef y As IDispatch)
 		Clear()
-		VBObject.Copy(pdisp, p)
-	End Sub
-
-	Function Copy() As *IDispatch
-		VBObject.Copy(GetDispatch, pdisp)
-	End Function
-
-	Sub Attach(ByRef p As *IDispatch)
-		Clear()
-		VBObject.Move(pdisp, p)
-	End Sub
-
-	Function Detach() As *IDispatch
-		VBObject.Move(Detach, pdisp)
-	End Function
-
-	Function Dispatch() As *IDispatch
-		Dispatch = pdisp
-	End Function
+		move(disp, y)
+	End Sub
+
+Private
+	disp As IDispatch
+
+	Static Sub copy(ByRef dst As IDispatch, ByVal src As IDispatch)
+		dst = src
+		If ObjPtr(src) <> 0 Then
+			src.AddRef()
+		End If
+	End Sub
+
+	Static Sub move(ByRef dst As IDispatch, ByRef src As IDispatch)
+		dst = src
+		src = Nothing
+	End Sub
+
+End Class
+
+Class VBObject
+	Inherits VBObjectBase
+Public
+	Static Function Attach(y As IDispatch) As VBObject
+		Attach = New VBObject
+		Attach.attach(y)
+	End Function
+
+	Sub VBObject()
+		disp = Nothing
+	End Sub
+
+	Sub VBObject(className As String, outer = Nothing As IUnknown, clsContext = CLSCTX_ALL As DWord)
+		VBObjectBase(createInstance(className, outer, clsContext))
+	End Sub
+
+	Sub VBObject(ByRef clsid As CLSID, outer = Nothing As IUnknown, clsContext = CLSCTX_ALL As DWord)
+		VBObjectBase(createInstance(clsid, outer, clsContext))
+	End Sub
+Private
+	Function createInstance(className As String, outer As IUnknown, clsContext As DWord) As IDispatch
+		Dim clsid = Detail.StringToCLSID(ToWCStr(className))
+		createInstance = createInstance(clsid, outer, clsContext)
+	End Function
+
+	Function createInstance(ByRef clsid As CLSID, outer As IUnknown, clsContext As DWord) As IDispatch
+		Dim hr = CoCreateInstance(clsid, ObjPtr(outer), clsContext, IID_IDispatch, createInstance)
+		Windows.ThrowIfFailed(hr)
+	End Function
+Public
+
+	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
+
 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
-
-	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
+		Dim hr = Dispatch.GetIDsOfNames(GUID_NULL, VarPtr(name), 1, LOCALE_USER_DEFAULT, VarPtr(dispid))
+		Windows.ThrowIfFailed(hr)
+		Return New DispatchCaller(disp, dispid)
+	End Function
 End Class
 
 Class DispatchCaller
+	Implements System.IDisposable
 Public
 	Sub DispatchCaller()
 	End Sub
-	Sub DispatchCaller(pDispatch As *IDispatch, dispatchId As DISPID)
-		pdisp = pDispatch
-		pdisp->AddRef()
+	Sub DispatchCaller(dispObj As IDispatch, dispatchId As DISPID)
+		disp = dispObj
+		disp.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
+		If ObjPtr(disp) <> NULL Then
+			disp.Release()
+			disp = Nothing
 		End If
 	End Sub
@@ -154,10 +164,8 @@
 			.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()
-		Prop = New Variant
-		v.Attach(ret)
-		Return v
+		Call = New Variant
+		Dim hr = disp.Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, dispParams, ByVal Call.PtrToVariant, ByVal 0, 0)
+		Windows.ThrowIfFailed(hr)
+		Dispose()
 	End Function
 
@@ -186,10 +194,8 @@
 			.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
+		Call = New Variant
+		Dim hr = disp.Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, dispParams, ByVal Call.PtrToVariant, ByVal 0, 0)
+		Windows.ThrowIfFailed(hr)
+		Dispose()
 	End Function
 
@@ -259,10 +265,10 @@
 			.cNamedArgs = 1
 		End With
-		Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, callType, dispParams, ByVal 0, ByVal 0, 0)
-		Dispose()
-	End Sub
-
-
-	pdisp As *IDispatch
+		Dim hr = disp.Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, callType, dispParams, ByVal 0, ByVal 0, 0)
+		Windows.ThrowIfFailed(hr)
+		Dispose()
+	End Sub
+
+	disp As IDispatch
 	dispid As DISPID
 End Class
@@ -276,7 +282,8 @@
 End Function
 
-Function CallByName(obj As *IDispatch, name As PCWSTR, callType As Word, cArgs As Long, args As *VARIANT) As Variant
+Function CallByName(obj As IDispatch, name As PCWSTR, callType As Word, cArgs As Long, args As *VARIANT) As Variant
 	Dim dispid As DISPID
-	Dim hr = obj->GetIDsOfNames(GUID_NULL, VarPtr(name), 1, LOCALE_USER_DEFAULT, VarPtr(dispid))
+	Dim hr = obj.GetIDsOfNames(GUID_NULL, VarPtr(name), 1, LOCALE_USER_DEFAULT, VarPtr(dispid))
+	Windows.ThrowIfFailed(hr)
 	Dim dispParams As DISPPARAMS
 	With dispParams
@@ -286,9 +293,7 @@
 		.cNamedArgs = 0
 	End With
-	Dim ret As VARIANT
-	hr = obj->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, dispParams, ret, ByVal 0, 0)
 	CallByName = New Variant
-	CallByName.Attach(ret)
-	Return CallByName
+	hr = obj.Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, dispParams, ByVal CallByName.PtrToVariant, ByVal 0, 0)
+	Windows.ThrowIfFailed(hr)
 End Function
 /*
@@ -300,5 +305,5 @@
 	Return New VBObject(ToWCStr(className), 0, CLSCTX_ALL)
 End Function
-/*
+*/
 #ifdef _WIN32_DCOM
 Function CreateObject(className As PCWSTR, serverName As PCWSTR) As VBObject
@@ -306,5 +311,5 @@
 	Dim si As COSERVERINFO
 	Dim context As DWord
-	If /*Server = 0 OrElse* / Server[0] = 0 Then
+	If /*Server = 0 OrElse*/ Server[0] = 0 Then
 		context = CLSCTX_SERVER
 	Else
@@ -332,37 +337,40 @@
 End Function
 #endif
-*/
-Function _System_CLSIDFromString(pwString As PCWSTR, ByRef guid As GUID) As HRESULT
+
+
+Namespace Detail
+Function StringToCLSID(pwString As PCWSTR) As CLSID
 	If pwString[0] = &h007b As WCHAR Then
 		' 1文字目が { ならクラスIDの文字列表現と見なしCLSIDFromStringで変換。
-		_System_CLSIDFromString = CLSIDFromString(pwString, guid)
+		Windows.ThrowIfFailed(CLSIDFromString(pwString, StringToCLSID))
 	Else
-		_System_CLSIDFromString = CLSIDFromProgID(pwString, guid)
-	End If
-End Function
-
-Function _System_COMReferenceEquals(p As *IUnknown, q As *IUnknown) As Boolean
-	If p = q Then
+		Windows.ThrowIfFailed(CLSIDFromProgID(pwString, StringToCLSID))
+	End If
+End Function
+
+Function COMReferenceEquals(p As IUnknown, q As IUnknown) As Boolean
+	If ObjPtr(p) = ObjPtr(q) Then
 		Return True
-	Else If p = 0 Or q = 0 Then
+	Else If ObjPtr(p) = 0 Or ObjPtr(q) = 0 Then
 		Return False
 	End If
 
-	Dim punkX = _System_GetUnknown(p)
-	Dim punkY = _System_GetUnknown(q)
-	If punkX = punkY Then
-		_System_COMReferenceEquals = True
+	Dim punkX = GetUnknown(p)
+	Dim punkY = GetUnknown(q)
+	If ObjPtr(punkX) = ObjPtr(punkY) Then
+		COMReferenceEquals = True
 	Else
-		_System_COMReferenceEquals = False
-	End If
-	punkX->Release()
-	punkY->Release()
-End Function
-
-Function _System_GetUnknown(p As *IUnknown) As *IUnknown 'pは任意のCOMインタフェース
-	If FAILDED(pdisp->QueryInterface(IID_Unknown, _System_GetUnknown)) Then
-		GetUnknown = 0
-	End If
-End Function
+		COMReferenceEquals = False
+	End If
+	punkX.Release()
+	punkY.Release()
+End Function
+
+Function GetUnknown(p As IUnknown) As IUnknown 'pは任意のCOMインタフェース
+	If FAILED(p.QueryInterface(IID_IUnknown, GetUnknown)) Then
+		GetUnknown = Nothing
+	End If
+End Function
+End Namespace 'Detail
 
 End Namespace 'COM
