source: trunk/ab5.0/ablib/src/com/bstring.ab @ 709

Last change on this file since 709 was 709, checked in by イグトランス (egtra), 14 years ago

最新のコンパイラに通るように修正。参照クラスのセマンティクスに合うように修正(Setter系プロパティの削除など)。

File size: 4.7 KB
Line 
1' com/bstring.ab
2
3Namespace ActiveBasic
4Namespace COM
5
6Class BString
7    Implements System.IDisposable, System.ICloneable
8Public
9    Sub BString()
10        bs = 0
11    End Sub
12
13    Sub BString(len As DWord)
14        bs = SysAllocStringLen(0, len)
15    End Sub
16
17    Sub BString(s As LPCOLESTR, len As DWord)
18        init(s, len)
19    End Sub
20
21    Sub BString(s As String)
22        If Not IsNothing(s) Then
23            init(s.StrPtr, s.Length As DWord)
24        End If
25    End Sub
26
27    Static Function FromBStr(bs As BSTR) As BString
28        FromBStr = New BString(bs, SysStringLen(bs))
29    End Function
30
31    Static Function FromCStr(s As PCWSTR) As BString
32        If s <> 0 Then
33            FromCStr = New BString(s, lstrlenW(s))
34        Else
35            FromCStr = New BString
36        End If
37    End Function
38
39    Static Function FromCStr(s As PCWSTR, len As DWord) As BString
40        If s <> 0 Then
41            FromCStr = New BString(s, len)
42        Else
43            FromCStr = New BString
44        End If
45    End Function
46
47    Static Function FromCStr(s As PCSTR) As BString
48        Dim dst As PCWSTR
49        Dim lenW = GetStr(s, dst)
50        FromCStr = FromCStr(s, lenW)
51    End Function
52
53    Static Function FromCStr(s As PCSTR, len As DWord) As BString
54        Dim dst As PCWSTR
55        Dim lenW = GetStr(s, len, dst)
56        FromCStr = FromCStr(s, lenW)
57    End Function
58
59    Sub ~BString()
60        Clear()
61    End Sub
62
63    Const Function Copy() As BSTR
64        Copy = copy(bs)
65    End Function
66
67    Function Clone() As BString
68        Return New BString(bs, Length)
69    End Function
70
71    Sub Dispose()
72        Clear()
73    End Sub
74
75    Sub Clear()
76        reset(0)
77    End Sub
78
79    Sub Attach(ByRef bstr As BSTR)
80        reset(move(bstr))
81    End Sub
82
83    Function Detach() As BSTR
84        Detach = move(bs)
85    End Function
86
87    Function BStr() As BSTR
88        BStr = bs
89    End Function
90
91    Static Function Attach(bs As BSTR) As BString
92        Attach = New BString
93        Attach.Attach(bs)
94    End Function
95
96    Const Function Length() As DWord
97        Length = SysStringLen(bs)
98    End Function
99
100    Const Function Operator [](i As SIZE_T) As OLECHAR
101        If i > Length Then
102            Throw New System.ArgumentOutOfRangeException("i - BString.Operator [] (get)")
103        End If
104        Return bs[i]
105    End Function
106
107    Sub Operator []=(i As SIZE_T, c As OLECHAR)
108        If i > Length Then
109            Throw New System.ArgumentOutOfRangeException("i - BString.Operator [] (set)")
110        End If
111        bs[i] = c
112    End Sub
113
114    Override Function ToString() As String
115        Return New String(bs As PCWSTR, Length As Long)
116    End Function
117
118    Override Function GetHashCode() As Long
119        Return _System_GetHashFromWordArray(bs, Length)
120    End Function
121
122    Override Function Equals(o As Object) As Boolean
123        If Not IsNothing(o) Then
124            If This.GetType().Equals(o.GetType()) Then
125                Equals(o As BString)
126            End If
127        End If
128    End Function
129
130    Const Function Equals(s As BString) As Boolean
131        Equals = Compare(This, s) = 0
132    End Function
133
134    Static Function Compare(l As BString, r As BString) As Long
135        If IsNullOrEmpty(l) Then
136            If IsNullOrEmpty(r) Then
137                Compare = 0
138            Else
139                Compare = -1
140            End If
141        Else
142            If IsNullOrEmpty(r) Then
143                Compare = 1
144            Else
145                Compare = Strings.ChrCmp(l.bs, l.Length As SIZE_T, r.bs, r.Length As SIZE_T)
146            End If
147        End If
148    End Function
149
150    Static Function IsNullOrEmpty(s As BString) As Boolean
151        If IsNothing(s) Then
152            IsNullOrEmpty = True
153        ElseIf s.bs = 0 Then
154            IsNullOrEmpty = True
155        ElseIf s.Length = 0 Then
156            IsNullOrEmpty = True
157        Else
158            IsNullOrEmpty = False
159        End If
160    End Function
161
162    Function Operator ==(s As BString) As Boolean
163        Return Compare(This, s) = 0
164    End Function
165
166    Function Operator <>(s As BString) As Boolean
167        Return Compare(This, s) <> 0
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
186Private
187    bs As BSTR
188
189    Sub init(s As PCSTR, len As DWord)
190        If s <> 0 Then
191            Dim lenBS = MultiByteToWideChar(CP_ACP, 0, s, len As Long, 0, 0)
192            bs = SysAllocStringLen(0, lenBS)
193            If bs <> 0 Then
194                MultiByteToWideChar(CP_ACP, 0, s, len As Long, bs, lenBS)
195            End If
196        End If
197    End Sub
198
199    Sub init(s As PCWSTR, len As DWord)
200        If s <> 0 Then
201            bs = SysAllocStringLen(s, len)
202        End If
203    End Sub
204
205    Sub reset(newBS As BSTR)
206        Dim old = InterlockedExchangePointer(ByVal VarPtr(bs) As *VoidPtr, newBS)
207        SysFreeString(old)
208    End Sub
209
210    Static Function copy(src As BSTR) As BSTR
211        copy = SysAllocStringLen(src, SysStringLen(src))
212    End Function
213
214    Static Function move(ByRef src As BSTR) As BSTR
215        move = InterlockedExchangePointer(ByVal VarPtr(src) As *VoidPtr, 0)
216    End Function
217End Class
218
219End Namespace 'COM
220End Namespace 'ActiveBasic
Note: See TracBrowser for help on using the repository browser.