Changeset 478 for trunk/Include/com


Ignore:
Timestamp:
Mar 13, 2008, 9:06:43 PM (17 years ago)
Author:
イグトランス (egtra)
Message:

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

Location:
trunk/Include/com
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Include/com/bstring.ab

    r335 r478  
    11' com/bstring.ab
    2 
    3 '#require <ole2.ab>
    4 '#require <oleauto.ab>
    52
    63Namespace ActiveBasic
    … …  
    85
    96Class BString
    10     'Inherits System.IDisposable, System.ICloneable
     7    Implements System.IDisposable ', System.ICloneable
    118Public
    129    Sub BString()
    … …  
    1916
    2017    Sub BString(s As BString)
    21         BString.Copy(This.bs, s.bs)
    22     End Sub
    23 
    24     Sub BString(s As LPCOLESTR)
    25         bs = SysAllocString(s)
     18        If Not IsNothing(s) Then
     19            bs = copy(s.bs)
     20        End If
    2621    End Sub
    2722
    2823    Sub BString(s As LPCOLESTR, len As DWord)
    29         bs = SysAllocStringLen(s, len)
    30     End Sub
    31 
    32     Sub BString(s As PCSTR)
    33         Init(s, lstrlenA(s))
    34     End Sub
    35 
    36     Sub BString(s As PCSTR, len As DWord)
    37         Dim lenBS = MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, 0, 0)
    38         bs = SysAllocStringLen(0, lenBS)
    39         MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, bs, lenBS)
     24        If s <> 0 Then
     25            bs = SysAllocStringLen(s, len)
     26        End If
    4027    End Sub
    4128
    4229    Sub BString(s As String)
    43         Init(s.StrPtr, s.Length As DWord)
    44     End Sub
     30        If Not IsNothing(s) Then
     31            Init(s.StrPtr, s.Length As DWord)
     32        End If
     33    End Sub
     34
     35    Static Function FromBStr(bs As BSTR) As BString
     36        FromBStr = New BString(bs, SysStringLen(bs))
     37    End Function
     38
     39    Static Function FromCStr(s As PCWSTR) As BString
     40        If s <> 0 Then
     41            FromCStr = New BString(s, lstrlenW(s))
     42        Else
     43            FromCStr = New BString
     44        End If
     45    End Function
     46
     47    Static Function FromCStr(s As PCWSTR, len As DWord) As BString
     48        If s <> 0 Then
     49            FromCStr = New BString(s, len)
     50        Else
     51            FromCStr = New BString
     52        End If
     53    End Function
     54
     55    Static Function FromCStr(s As PCSTR) As BString
     56        Dim dst As PCWSTR
     57        Dim lenW = GetStr(s, dst)
     58        FromCStr = FromCStr(s, lenW)
     59    End Function
     60
     61    Static Function FromCStr(s As PCSTR, len As DWord) As BString
     62        Dim dst As PCWSTR
     63        Dim lenW = GetStr(s, len, dst)
     64        FromCStr = FromCStr(s, lenW)
     65    End Function
    4566
    4667    Sub ~BString()
    … …  
    4869    End Sub
    4970
    50     Sub Assign(bstr As BString)
    51         Clear()
    52         BString.Copy(This.bs, bstr.bs)
    53     End Sub
    54 
    55     Sub Assign(s As LPCOLESTR)
    56         Clear()
    57         s = SysAllocString(s)
    58     End Sub
    59 
    60     Sub AssignFromBStr(bstr As BSTR)
    61         Clear()
    62         BString.Copy(bs, bstr)
    63     End Sub
    64 
    6571    Const Function Copy() As BSTR
    66         BString.Copy(Copy, bs)
     72        Copy = copy(bs)
    6773    End Function
    6874
    … …  
    7682
    7783    Sub Clear()
    78         If bs <> 0 Then
    79             SysFreeString(bs)
    80             bs = 0
    81         End If
     84        reset(0)
    8285    End Sub
    8386
    8487    Sub Attach(ByRef bstr As BSTR)
    85         Clear()
    86         BString.Move(bs, bstr)
     88        reset(move(bstr))
    8789    End Sub
    8890
    8991    Function Detach() As BSTR
    90         BString.Move(Detach, bs)
     92        Detach = move(bs)
    9193    End Function
    9294
    9395    Function BStr() As BSTR
    9496        BStr = bs
    95     End Function
    96 /*
    97     Static Function Assgin(bs As BSTR) As BString
    98         Assgin = New BString
    99         Assgin.Assgin(bs)
    10097    End Function
    10198
    … …  
    104101        Attach.Attach(bs)
    105102    End Function
    106 */
     103
    107104    Const Function Length() As DWord
    108         Length = SysStringLen(bs)
     105        Length = GetDWord(bs As VoidPtr - SizeOf (DWord)) 'SysStringLen(bs)
    109106    End Function
    110107
    111108    Const Function Operator [](i As SIZE_T) As OLECHAR
    112 #ifdef _DEBUG
    113109        If i > Length Then
    114             'Throw OutOfRangeException
    115         End If
    116 #endif
     110            Throw New ArgumentOutOfRangeException("i")
     111        End If
    117112        Return bs[i]
    118113    End Function
    119114
    120115    Sub Operator []=(i As SIZE_T, c As OLECHAR)
    121 #ifdef _DEBUG
    122116        If i > Length Then
    123             'Throw OutOfRangeException
    124         End If
    125 #endif
     117            Throw New ArgumentOutOfRangeException("i")
     118        End If
    126119        bs[i] = c
    127120    End Sub
    … …  
    135128    End Function
    136129
     130    Override Function Equals(o As Object) As Boolean
     131        If Not IsNothing(o) Then
     132            If This.GetType().Equals(o.GetType()) Then
     133                Equals(o As BString)
     134            End If
     135        End If
     136    End Function
     137
     138    Const Function Equals(s As BString) As Boolean
     139        Equals = Compare(This, s) = 0
     140    End Function
     141
     142    Static Function Compare(l As BString, r As BString) As Long
     143        If IsNullOrEmpty(l) Then
     144            If IsNullOrEmpty(r) Then
     145                Compare = 0
     146            Else
     147                Compare = -1
     148            End If
     149        Else
     150            If IsNullOrEmpty(bsr) Then
     151                Compare = 1
     152            Else
     153                Compare = Strings.ChrCmp(l.bs, l.Length As SIZE_T, r.bs, r.Length As SIZE_T)
     154            End If
     155        End If
     156    End Function
     157
     158    Static Function IsNullOrEmpty(s As BString)
     159        If IsNothing(s) Then
     160            IsNullOrEmpty = True
     161        ElseIf s.bs = 0 Then
     162            IsNullOrEmpty = True
     163        ElseIf s.Length = 0 Then
     164            IsNullOrEmpty = True
     165        Else
     166            IsNullOrEmpty = False
     167        End If
     168    End Function
     169
     170    Function Operator ==(s As BString) As Boolean
     171        Return Compare(This, s) = 0
     172    End Function
     173
     174    Function Operator <>(s As BString) As Boolean
     175        Return Compare(This, s) <> 0
     176    End Function
     177
     178    Function Operator <(s As BString) As Boolean
     179        Return Compare(This, s) < 0
     180    End Function
     181
     182    Function Operator <=(s As BString) As Boolean
     183        Return Compare(This, s) <= 0
     184    End Function
     185
     186    Function Operator >(s As BString) As Boolean
     187        Return Compare(This, s) > 0
     188    End Function
     189
     190    Function Operator >=(s As BString) As Boolean
     191        Return Compare(This, s) >= 0
     192    End Function
     193
    137194Private
    138195    bs As BSTR
    139196
    140     Sub Init(s As PCSTR, len As DWord)
    141         Dim lenBS = MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, 0, 0)
    142         bs = SysAllocStringLen(0, lenBS)
    143         MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, bs, lenBS)
    144     End Sub
    145 
    146     Static Sub Copy(ByRef dst As BSTR, ByVal src As BSTR)
    147         dst = SysAllocStringLen(src, SysStringLen(src))
    148     End Sub
    149 
    150     Static Sub Move(ByRef dst As BSTR, ByRef src As BSTR)
    151         dst = src
    152         src = 0
    153     End Sub
     197    Sub init(s As PCSTR, len As DWord)
     198        If <> 0 Then
     199            Dim lenBS = MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, 0, 0)
     200            bs = SysAllocStringLen(0, lenBS)
     201            If bs <> 0 Then
     202                MultiByteToWideChar(CP_THREAD_ACP, 0, s, len As Long, bs, lenBS)
     203            End If
     204        End If
     205    End Sub
     206
     207    Sub reset(newBS As BSTR)
     208        Dim old = InterlockedExchangePointer(bs, newBS)
     209        SysFreeString(old)
     210    End Sub
     211
     212    Static Function copy(src As BSTR) As BSTR
     213        copy = SysAllocStringLen(src, SysStringLen(src))
     214    End Function
     215
     216    Static Function move(ByRef src As BSTR) As BSTR
     217        move = InterlockedExchangePointer(src, 0)
     218    End Function
    154219End Class
    155220

  • trunk/Include/com/currency.ab

    r355 r478  
    22
    33#require <com/variant.ab>
    4 
    5 #ifndef _COM_CURRENCY_AB
    6 #define _COM_CURRENCY_AB
    74
    85Namespace ActiveBasic
    … …  
    5653        Return ret
    5754    End Function
    58 /*
     55
    5956    Const Function Operator /(y As Variant) As Double
    6057        Dim vx = New Variant(This)
    … …  
    6966        Return ret.ValR8
    7067    End Function
    71 */
     68
    7269    Const Function Operator +(y As Currency) As Currency
    7370        Dim ret = New Currency
    … …  
    131128        Return c = VARCMP_LT
    132129    End Function
    133 /*
     130
    134131    Const Function Operator >(y As Currency) As Boolean
    135132        Dim c = Compare(This, y)
    … …  
    141138        Return c = VARCMP_GT
    142139    End Function
    143 */
     140
    144141    Const Function Operator <=(y As Currency) As Boolean
    145142        Dim c = Compare(This, y)
    … …  
    183180
    184181    Const Function Cy() As CY
    185         Return cy
     182        Cy = cy
    186183    End Function
    187184
    … …  
    203200
    204201    Override Function ToString() As String
    205         Dim bs As BSTR
    206         VarBstrFromCy(cy, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
    207         ToString = New String(bs As PCWSTR, SysStringLen(bs) As Long)
    208         SysFreeString(bs)
     202        /*Using*/ Dim bstr = New BString
     203            Dim bs As BSTR
     204            VarBstrFromCy(cy, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
     205            bstr.Attach(bs)
     206            ToString = bstr.ToString
     207        bstr.Dispose() 'End Using
    209208    End Function
    210209
    … …  
    223222End Namespace 'COM
    224223End Namespace 'ActiveBasic
    225 
    226 #endif '_COM_CURRENCY_AB

  • trunk/Include/com/decimal.ab

    r355 r478  
    11' com/decimal.ab
    22
    3 '#require <oleauto.ab>
    43#require <com/variant.ab>
    54#require <com/currency.ab>
    … …  
    1413
    1514    Sub Decimal(d As Decimal)
    16 '       dec = d なぜかコンパイルできない
    17         memcpy(VarPtr(dec), VarPtr(d.dec), Len(dec))
     15        dec = d.dec
    1816    End Sub
    1917
    2018    Sub Decimal(ByRef d As DECIMAL)
    21         memcpy(VarPtr(dec), VarPtr(d), Len(dec))
     19        dec = d
    2220    End Sub
    2321
    2422    Sub Decimal(lo As Long, mid As Long, hi As Long, isNegative As Boolean, scale As Byte)
    2523        If scale > 28 Then
    26             Debug
    27             Throw New ArgumentOutOfRangeException
     24            Throw New ArgumentOutOfRangeException("scale")
    2825        End If
    2926        Dim sign As Byte
    … …  
    284281        Return c = VARCMP_LT
    285282    End Function
    286 /*
     283
    287284    Const Function Operator >(y As Decimal) As Boolean
    288285        Dim c = Compare(This, y)
    … …  
    294291        Return c = VARCMP_GT
    295292    End Function
    296 */
     293
    297294    Const Function Operator <=(y As Decimal) As Boolean
    298295        Dim c = Compare(This, y)
    … …  
    348345
    349346    Override Function ToString() As String
    350         Dim bs As BSTR
    351         VarBstrFromDec(dec, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
    352         ToString = New String(bs As PCWSTR, SysStringLen(bs) As Long)
    353         SysFreeString(bs)
     347        /*Using*/ Dim bstr = New BString
     348            Dim bs As BSTR
     349            VarBstrFromDec(dec, LOCALE_USER_DEFAULT, LOCALE_USE_NLS, bs)
     350            bstr.Attach(bs)
     351            ToString = bstr.ToString
     352        bstr.Dispose() 'End Using
    354353    End Function
    355354

  • trunk/Include/com/variant.ab

    r355 r478  
    11' com/variant.ab
    22
    3 #ifndef _COM_VARIANT_AB
    4 #define _COM_VARIANT_AB
    5 
    6 '#require <oaidl.ab>
    7 '#require <oleauto.ab>
    83'#require <com/index.ab>
    94
    … …  
    7974    Sub Variant(bs As BString)
    8075        v.vt = VT_BSTR
    81         SetPointer(VarPtr(v.val), SysAllocStringLen(bs.BStr, bs.Length))
    82     End Sub
    83 
    84     Sub Variant(p As *IUnknown)
    85         p->AddRef()
     76        SetPointer(VarPtr(v.val), bs.Copy))
     77    End Sub
     78
     79    Sub Variant(unk As IUnknown)
     80        If Not IsNothing(unk) Then unk.AddRef()
    8681        v.vt = VT_UNKNOWN
    87         SetPointer(VarPtr(v.val), p)
    88     End Sub
    89 
    90     Sub Variant(p As *IDispatch)
    91         p->AddRef()
     82        SetPointer(VarPtr(v.val), ObjPtr(unk))
     83    End Sub
     84
     85    Sub Variant(disp As IDispatch)
     86        If Not IsNothing(disp) Then disp.AddRef()
    9287        v.vt = VT_DISPATCH
    93         SetPointer(VarPtr(v.val), p)
     88        SetPointer(VarPtr(v.val), ObjPtr(disp))
    9489    End Sub
    9590/*
    … …  
    284279
    285280    Static Function Compare(x As Variant, y As Variant, lcid As LCID, flags As DWord) As HRESULT
    286         Return VarCmp(x.v, y.v, lcid, flags)
     281        Return VarCmp(removeNull(x).v, removeNull(y).v, lcid, flags)
    287282    End Function
    288283
    … …  
    290285        Return VarCmp(x.v, y.v, LOCALE_USER_DEFAULT, 0) 'VARCMP_NULL = 3を返す場合があるので注意
    291286    End Function
    292 /*
     287
    293288    Const Function Operator ==(y As Variant) As Boolean
    294289        Dim c = Compare(This, y)
    295         If c = VARCMP_EQ Then
    296             Return True
    297         Else
    298             Return False
    299         End If
     290        Return c = VARCMP_EQ
    300291    End Function
    301292
    302293    Const Function Operator <>(y As Variant) As Boolean
    303294        Dim c = Compare(This, y)
    304         If c <> VARCMP_EQ Then
    305             Return True
    306         Else
    307             Return False
    308         End If
     295        Return c <> VARCMP_EQ
    309296    End Function
    310297
    311298    Const Function Operator <(y As Variant) As Boolean
    312299        Dim c = Compare(This, y)
    313         If c = VARCMP_LT Then
    314             Return True
    315         Else
    316             Return False
    317         End If
    318     End Function
    319 /*
     300        Return c = VARCMP_LT
     301    End Function
     302
    320303    Const Function Operator >(y As Variant) As Boolean
    321304        Dim c = Compare(This, y)
    322         If c = VARCMP_GT Then
    323             Return True
    324         Else
    325             Return False
    326         End If
    327     End Function
    328 */
    329 /*
     305        Return c = VARCMP_GT
     306    End Function
     307
    330308    Const Function Operator <=(y As Variant) As Boolean
    331309        Dim c = Compare(This, y)
    332         If c = VARCMP_LT Or c = VARCMP_EQ Then
    333             Return True
    334         Else
    335             Return False
    336         End If
     310        Return c = VARCMP_LT Or c = VARCMP_EQ
    337311    End Function
    338312
    339313    Const Function Operator >=(y As Variant) As Boolean
    340314        Dim c = Compare(This, y)
    341         If c = VARCMP_GT Or c = VARCMP_EQ Then
    342             Return True
    343         Else
    344             Return False
    345         End If
    346     End Function
    347 */
     315        Return c = VARCMP_GT Or c = VARCMP_EQ
     316    End Function
     317
    348318    Const Function ChangeType(vt As VARTYPE, flags As Word) As Variant
    349         Dim ret = New Variant
    350         ChangeType(ret, flags, vt)
    351         Return ret
     319        ChangeType = New Variant
     320        ChangeType(ChangeType, flags, vt)
    352321    End Function
    353322
    … …  
    369338
    370339    Override Function ToString() As String
    371         Dim tmp = ChangeType(VT_BSTR, VARIANT_ALPHABOOL)
    372         Dim bs = ((tmp.v.val As ULONG_PTR) As BSTR)
    373         Return New String(bs As PCWSTR, SysStringLen(bs) As Long)
     340        /*Using*/ Dim bs = ValStr
     341        ToString = bs.ToString
     342        bstr.Dispose() 'End Using
    374343    End Function
    375344
    … …  
    526495
    527496    Const Function ValStr() As BString
     497        ValStr = New BString
    528498        Dim r As VARIANT
    529499        ChangeType(r, VARIANT_ALPHABOOL, VT_BSTR)
    530         Dim bs = New BString
    531         bs.Attach(GetPointer(VarPtr(r.val)) As BSTR)
    532         Return bs
     500        ValStr.Attach(GetPointer(VarPtr(r.val)) As BSTR)
    533501    End Function
    534502
    … …  
    536504        Clear()
    537505        v.vt = VT_BSTR
    538         SetPointer(VarPtr(v.val), x.Copy())
    539     End Sub
    540 
    541     Const Function ValUnknown() As *IUnknown
     506        If IsNothing(x) Then
     507            SetPointer(VarPtr(v.val), SysAllocStringLen(0))
     508        Else
     509            SetPointer(VarPtr(v.val), x.Copy())
     510        End If
     511    End Sub
     512
     513    Const Function ValUnknown() As IUnknown
    542514        Dim r As VARIANT
    543515        ChangeType(r, 0, VT_UNKNOWN)
    544         Return GetPointer(VarPtr(r.val)) As *IUnknown
    545     End Function
    546 
    547     Sub ValUnknown(x As *IUnknown)
    548         Clear()
    549         SetPointer(VarPtr(v.val), x)
    550         x->AddRef()
     516        Return _System_PtrUnknown(r.val As ULONG_PTR As VoidPtr)
     517    End Function
     518
     519    Sub ValUnknown(x As IUnknown)
     520        Clear()
     521        SetPointer(VarPtr(v.val), ObjPtr(x))
     522        If Not IsNothing(x) Then
     523            x.AddRef()
     524        End If
    551525        v.vt = VT_UNKNOWN
    552526    End Sub
    … …  
    587561
    588562    Static Function OptionalParam() As Variant
    589 '       If _System_VariantOptionalParam = Nothing Then
    590 '           'ToDo マルチスレッド対応
    591             VariantOptionalParam = New Variant
    592             VariantOptionalParam.ValError = DISP_E_PARAMNOTFOUND
    593 '       End If
    594         Return VariantOptionalParam
     563        If IsNothing(optionalParam) Then
     564            Dim t = New Variant
     565            t.ValError = DISP_E_PARAMNOTFOUND
     566            InterlockedCompareExchangePointer(ByVal VarPtr(optionalParam), ObjPtr(t), 0)
     567        End If
     568        Return optionalParam
     569    End Function
     570
     571    Static Function Null() As Variant
     572        If IsNothing(optionalParam) Then
     573            Dim t = New Variant
     574            Dim p = t.PtrToVariant
     575            p->vt = VT_NULL
     576            InterlockedCompareExchangePointer(ByVal VarPtr(optionalParam), ObjPtr(t), 0)
     577        End If
     578        Return optionalParam
    595579    End Function
    596580Private
    … …  
    605589'       src.vt = VT_EMPTY
    606590    End Sub
     591
     592    Static Function removeNull(v As Variant) As Varinat
     593        If IsNothing(v) Then
     594            removeNull = Null
     595        Else
     596            removeNull = v
     597        End If
     598    End Function
     599
     600    Static optionalParam = Nothing As Variant
     601    Static null = Nothing As Variant
    607602End Class
    608 
    609 Dim VariantOptionalParam = Nothing As Variant
    610603
    611604/*
    … …  
    629622End Namespace 'COM
    630623End Namespace 'ActiveBasic
    631 
    632 #endif '_COM_VARIANT_AB
Note: See TracChangeset for help on using the changeset viewer.