Changeset 478 for trunk/Include/com/variant.ab

Timestamp:

Mar 13, 2008, 9:06:43 PM (17 years ago)

Author:

イグトランス (egtra)

Message:

現在向けに修正（参照型のポインタの排除など）

File:

• trunk/Include/com/variant.ab (modified) (10 diffs)

trunk/Include/com/variant.ab

@@ -1 +1 @@
 ' com/variant.ab
 
-#ifndef _COM_VARIANT_AB
-#define _COM_VARIANT_AB
-
-'#require <oaidl.ab>
-'#require <oleauto.ab>
 '#require <com/index.ab>
 
@@ -79 +74 @@
     Sub Variant(bs As BString)
         v.vt = VT_BSTR
-        SetPointer(VarPtr(v.val), SysAllocStringLen(bs.BStr, bs.Length))
-    End Sub
-
-    Sub Variant(p As *IUnknown)
-        p->AddRef()
+        SetPointer(VarPtr(v.val), bs.Copy))
+    End Sub
+
+    Sub Variant(unk As IUnknown)
+        If Not IsNothing(unk) Then unk.AddRef()
         v.vt = VT_UNKNOWN
-        SetPointer(VarPtr(v.val), p)
-    End Sub
-
-    Sub Variant(p As *IDispatch)
-        p->AddRef()
+        SetPointer(VarPtr(v.val), ObjPtr(unk))
+    End Sub
+
+    Sub Variant(disp As IDispatch)
+        If Not IsNothing(disp) Then disp.AddRef()
         v.vt = VT_DISPATCH
-        SetPointer(VarPtr(v.val), p)
+        SetPointer(VarPtr(v.val), ObjPtr(disp))
     End Sub
 /*
@@ -284 +279 @@
 
     Static Function Compare(x As Variant, y As Variant, lcid As LCID, flags As DWord) As HRESULT
-        Return VarCmp(x.v, y.v, lcid, flags)
+        Return VarCmp(removeNull(x).v, removeNull(y).v, lcid, flags)
     End Function
 
@@ -290 +285 @@
         Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意
     End Function
-/*
+
     Const Function Operator ==(y As Variant) As Boolean
         Dim c = Compare(This, y)
-        If c = VARCMP_EQ Then
-            Return True
-        Else
-            Return False
-        End If
+        Return c = VARCMP_EQ
     End Function
 
     Const Function Operator <>(y As Variant) As Boolean
         Dim c = Compare(This, y)
-        If c <> VARCMP_EQ Then
-            Return True
-        Else
-            Return False
-        End If
+        Return c <> VARCMP_EQ
     End Function
 
     Const Function Operator <(y As Variant) As Boolean
         Dim c = Compare(This, y)
-        If c = VARCMP_LT Then
-            Return True
-        Else
-            Return False
-        End If
-    End Function
-/*
+        Return c = VARCMP_LT
+    End Function
+
     Const Function Operator >(y As Variant) As Boolean
         Dim c = Compare(This, y)
-        If c = VARCMP_GT Then
-            Return True
-        Else
-            Return False
-        End If
-    End Function
-*/
-/*
+        Return c = VARCMP_GT
+    End Function
+
     Const Function Operator <=(y As Variant) As Boolean
         Dim c = Compare(This, y)
-        If c = VARCMP_LT Or c = VARCMP_EQ Then
-            Return True
-        Else
-            Return False
-        End If
+        Return c = VARCMP_LT Or c = VARCMP_EQ
     End Function
 
     Const Function Operator >=(y As Variant) As Boolean
         Dim c = Compare(This, y)
-        If c = VARCMP_GT Or c = VARCMP_EQ Then
-            Return True
-        Else
-            Return False
-        End If
-    End Function
-*/
+        Return c = VARCMP_GT Or c = VARCMP_EQ
+    End Function
+
     Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
-        Dim ret = New Variant
-        ChangeType(ret, flags, vt)
-        Return ret
+        ChangeType = New Variant
+        ChangeType(ChangeType, flags, vt)
     End Function
 
@@ -369 +338 @@
 
     Override Function ToString() As String
-        Dim tmp = ChangeType(VT_BSTR, VARIANT_ALPHABOOL)
-        Dim bs = ((tmp.v.val As ULONG_PTR) As BSTR)
-        Return New String(bs As PCWSTR, SysStringLen(bs) As Long)
+        /*Using*/ Dim bs = ValStr
+        ToString = bs.ToString
+        bstr.Dispose() 'End Using
     End Function
 
@@ -526 +495 @@
 
     Const Function ValStr() As BString
+        ValStr = New BString
         Dim r As VARIANT
         ChangeType(r, VARIANT_ALPHABOOL, VT_BSTR)
-        Dim bs = New BString
-        bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
-        Return bs
+        ValStr.Attach(GetPointer(VarPtr(r.val)) As BSTR)
     End Function
 
@@ -536 +504 @@
         Clear()
         v.vt = VT_BSTR
-        SetPointer(VarPtr(v.val), x.Copy())
-    End Sub
-
-    Const Function ValUnknown() As *IUnknown
+        If IsNothing(x) Then
+            SetPointer(VarPtr(v.val), SysAllocStringLen(0))
+        Else
+            SetPointer(VarPtr(v.val), x.Copy())
+        End If
+    End Sub
+
+    Const Function ValUnknown() As IUnknown
         Dim r As VARIANT
         ChangeType(r, 0, VT_UNKNOWN)
-        Return GetPointer(VarPtr(r.val)) As *IUnknown
-    End Function
-
-    Sub ValUnknown(x As *IUnknown)
-        Clear()
-        SetPointer(VarPtr(v.val), x)
-        x->AddRef()
+        Return _System_PtrUnknown(r.val As ULONG_PTR As VoidPtr)
+    End Function
+
+    Sub ValUnknown(x As IUnknown)
+        Clear()
+        SetPointer(VarPtr(v.val), ObjPtr(x))
+        If Not IsNothing(x) Then
+            x.AddRef()
+        End If
         v.vt = VT_UNKNOWN
     End Sub
@@ -587 +561 @@
 
     Static Function OptionalParam() As Variant
-'       If _System_VariantOptionalParam = Nothing Then
-'           'ToDo マルチスレッド対応
-            VariantOptionalParam = New Variant
-            VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
-'       End If
-        Return VariantOptionalParam
+        If IsNothing(optionalParam) Then
+            Dim t = New Variant
+            t.ValError = DISP_E_PARAMNOTFOUND
+            InterlockedCompareExchangePointer(ByVal VarPtr(optionalParam), ObjPtr(t), 0)
+        End If
+        Return optionalParam
+    End Function
+
+    Static Function Null() As Variant
+        If IsNothing(optionalParam) Then
+            Dim t = New Variant
+            Dim p = t.PtrToVariant
+            p->vt = VT_NULL
+            InterlockedCompareExchangePointer(ByVal VarPtr(optionalParam), ObjPtr(t), 0)
+        End If
+        Return optionalParam
     End Function
 Private
@@ -605 +589 @@
 '       src.vt = VT_EMPTY
     End Sub
+
+    Static Function removeNull(v As Variant) As Varinat
+        If IsNothing(v) Then
+            removeNull = Null
+        Else
+            removeNull = v
+        End If
+    End Function
+
+    Static optionalParam = Nothing As Variant
+    Static null = Nothing As Variant
 End Class
-
-Dim VariantOptionalParam = Nothing As Variant
 
 /*
@@ -629 +622 @@
 End Namespace 'COM
 End Namespace 'ActiveBasic
-
-#endif '_COM_VARIANT_AB