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


186  Private


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


217  End Class


218 


219  End Namespace 'COM


220  End Namespace 'ActiveBasic

