1  ' com/bstring.ab


2 


3  Namespace ActiveBasic


4  Namespace COM


5 


6  Class BString


7  Implements System.IDisposable ', System.ICloneable


8  Public


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 BString)


18  If Not IsNothing(s) Then


19  bs = copy(s.bs)


20  End If


21  End Sub


22 


23  Sub BString(s As LPCOLESTR, len As DWord)


24  If s <> 0 Then


25  bs = SysAllocStringLen(s, len)


26  End If


27  End Sub


28 


29  Sub BString(s As String)


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


66 


67  Sub ~BString()


68  Clear()


69  End Sub


70 


71  Const Function Copy() As BSTR


72  Copy = copy(bs)


73  End Function


74 


75  /*Override*/ Function Clone() As BString


76  Return New BString(This)


77  End Function


78 


79  /*Override*/ Sub Dispose()


80  Clear()


81  End Sub


82 


83  Sub Clear()


84  reset(0)


85  End Sub


86 


87  Sub Attach(ByRef bstr As BSTR)


88  reset(move(bstr))


89  End Sub


90 


91  Function Detach() As BSTR


92  Detach = move(bs)


93  End Function


94 


95  Function BStr() As BSTR


96  BStr = bs


97  End Function


98 


99  Static Function Attach(bs As BSTR) As BString


100  Attach = New BString


101  Attach.Attach(bs)


102  End Function


103 


104  Const Function Length() As DWord


105  Length = GetDWord(bs As VoidPtr  SizeOf (DWord)) 'SysStringLen(bs)


106  End Function


107 


108  Const Function Operator [](i As SIZE_T) As OLECHAR


109  If i > Length Then


110  Throw New ArgumentOutOfRangeException("i")


111  End If


112  Return bs[i]


113  End Function


114 


115  Sub Operator []=(i As SIZE_T, c As OLECHAR)


116  If i > Length Then


117  Throw New ArgumentOutOfRangeException("i")


118  End If


119  bs[i] = c


120  End Sub


121 


122  Override Function ToString() As String


123  Return New String(bs As PCWSTR, Length As Long)


124  End Function


125 


126  Override Function GetHashCode() As Long


127  Return _System_GetHashFromWordArray(bs, Length)


128  End Function


129 


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 


194  Private


195  bs As BSTR


196 


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


219  End Class


220 


221  End Namespace 'COM


222  End Namespace 'ActiveBasic

