License MIT
windows version:
Code: Select all
#define UNICODE
#include "windows.bi"
type extWstring extends wstring
dim pPointerWstr as wstring ptr ' Pointer to the data
dim iLen as Long ' Length line
dim iSize as Long ' allocated bytes
declare constructor()
declare Constructor(byref as Const Wstring ptr)
declare Constructor(byref as Const extWstring)
declare Constructor(byref as Const string)
declare Constructor(as Long)
declare Destructor()
declare operator let(byref as Const wstring ptr)
declare operator let(byREF as const extWstring)
declare operator let(byREF as const string)
Declare Operator &=(ByRef As Const wString ptr)
Declare Operator &=(ByRef As Const String)
Declare Operator &=(ByRef As const extWstring)
Declare Operator &=(Byval As const Longint)
Declare Operator &=(Byval As const DOUBLE)
Declare Operator +=(ByRef As Const wString ptr)
Declare Operator +=(ByRef As Const String)
Declare Operator +=(ByRef As const extWstring)
Declare Operator Cast() ByRef As Const wString
Declare Operator [](as Long) ByRef As USHORT
declare property UTF8() as string
declare property UTF8(ByRef As const string)
const SZW as Long = sizeof(wstring) ' size wstring (linux - 4 , windows - 2)
Const SIZEALLOC As Long = 30*SZW
End Type
' init default
PRIVATE constructor extWstring()
dim as long iSize = SIZEALLOC
this.pPointerWstr = allocate( iSize )
this.iLen = 0
this.iSize = iSize
(this.pPointerWstr)[0] = 0
End Constructor
' init assign , let operators , &= operators
#macro MACRO_ASSIGN_LET_STRING(operations , macrotype , macrotypeSTR , flagConcatOrPlus , Specifier)
#if operations = "ASSIGN"
#define __BEGIN_MACROCLASS_BLOCK__ constructor extWstring
#define __END_MACROCLASS_BLOCK__ End Constructor
#elseif operations = "LET"
#undef __BEGIN_MACROCLASS_BLOCK__
#undef __END_MACROCLASS_BLOCK__
#define __BEGIN_MACROCLASS_BLOCK__ Operator extWstring.Let
#define __END_MACROCLASS_BLOCK__ End Operator
#elseif operations = "&="
#undef __BEGIN_MACROCLASS_BLOCK__
#define __BEGIN_MACROCLASS_BLOCK__ Operator extWstring.&=
#elseif operations = "+="
#undef __BEGIN_MACROCLASS_BLOCK__
#define __BEGIN_MACROCLASS_BLOCK__ Operator extWstring.+=
#EndIf
PRIVATE __BEGIN_MACROCLASS_BLOCK__(Specifier s as Const macrotype)
#if macrotypeSTR = "WSTRING PTR"
dim as Long iLen = len(*s)
#elseif macrotypeSTR = "EXTWSTRING"
dim as Long iLen = s.iLen
#elseif macrotypeSTR = "STRING"
dim as Long iLen = len(s)
#elseif macrotypeSTR = "NUMERIC"
#if flagConcatOrPlus = 1
dim sz as Wstring*30 = wstr(s)
dim as Long iLen = len(sz)
#EndIf
#EndIf
dim as Long iSize = iLen * SZW + SZW
dim as Long iLenTemp = this.iLen
#if flagConcatOrPlus = 1
if this.iSize < this.iLen * SZW + iSize then
iSize = this.iLen * SZW + iSize + SIZEALLOC
this.pPointerWstr = reallocate(this.pPointerWstr , iSize)
this.iSize = iSize
EndIf
this.iLen = iLen + this.iLen
#else
if iSize > this.iSize orelse (iSize + SIZEALLOC) < this.iSize then
iSize +=SIZEALLOC
deallocate(this.pPointerWstr)
this.pPointerWstr = allocate(iSize)
this.iSize = iSize
EndIf
this.iLen = iLen
#endif
dim as short ptr pDest , pSource
dim as BOOLEAN bFlagDeallocate
#if macrotypeSTR = "WSTRING PTR"
pSource = cast(short ptr,s)
#elseif macrotypeSTR = "EXTWSTRING"
pSource = cast(short ptr,s.pPointerWstr)
#elseif macrotypeSTR = "STRING"
dim as Long iBlen = iLen*SZW+SZW
Dim As WString Ptr pwBuf
pwBuf = Allocate( iBlen )
MultiByteToWideChar(CP_ACP, 0, StrPtr(s) , -1, pwBuf, iBlen)
pSource = cast(short ptr, pwBuf)
bFlagDeallocate = TRUE
#elseif macrotypeSTR = "NUMERIC"
#if flagConcatOrPlus = 1
pSource = cast(short ptr, @sz)
#EndIf
#EndIf
#if flagConcatOrPlus = 1
pDest = cast(short ptr,this.pPointerWstr) + iLenTemp
#else
pDest = cast(short ptr,this.pPointerWstr)
#EndIf
if pDest andalso pSource then
memcpy(pDest , pSource, iLen * SZW)
cast(short ptr ,(this.pPointerWstr))[this.iLen] = 0
EndIf
if bFlagDeallocate then
if pSource then deallocate(pSource)
EndIf
__END_MACROCLASS_BLOCK__
#EndMacro
MACRO_ASSIGN_LET_STRING("ASSIGN" , Wstring ptr , "WSTRING PTR" , 0 , byref)
MACRO_ASSIGN_LET_STRING("ASSIGN" , extWstring , "EXTWSTRING" , 0 , byref)
MACRO_ASSIGN_LET_STRING("ASSIGN" , string , "STRING" , 0 , byref)
MACRO_ASSIGN_LET_STRING("LET" , Wstring ptr , "WSTRING PTR" , 0 , byref)
MACRO_ASSIGN_LET_STRING("LET" , extWstring , "EXTWSTRING" , 0 , byref)
MACRO_ASSIGN_LET_STRING("LET" , string , "STRING" , 0 , byref)
MACRO_ASSIGN_LET_STRING("&=" , Wstring ptr , "WSTRING PTR" , 1 , byref)
MACRO_ASSIGN_LET_STRING("&=" , extWstring , "EXTWSTRING" , 1 , byref)
MACRO_ASSIGN_LET_STRING("&=" , string , "STRING" , 1 , byref)
MACRO_ASSIGN_LET_STRING("&=" , longint , "NUMERIC" , 1 , byval)
MACRO_ASSIGN_LET_STRING("&=" , DOUBLE , "NUMERIC" , 1 , Byval)
MACRO_ASSIGN_LET_STRING("+=" , Wstring ptr , "WSTRING PTR" , 1 , byref)
MACRO_ASSIGN_LET_STRING("+=" , extWstring , "EXTWSTRING" , 1 , byref)
MACRO_ASSIGN_LET_STRING("+=" , string , "STRING" , 1 , byref)
' init fix size
PRIVATE Constructor extWstring(byval iNumberSimbols as long)
this.iLen = iNumberSimbols * SZW
this.iSize = this.iLen * SZW + SZW
this.pPointerWstr = callocate(this.iSize)
End Constructor
PRIVATE Destructor extWstring()
deallocate(pPointerWstr)
End Destructor
PRIVATE Operator extWstring.Cast() ByRef As Const WString
Return *(This.pPointerWstr)
End Operator
PRIVATE Operator extWstring.[](iIndex as Long) ByRef As USHORT
Return (This.pPointerWstr)[iIndex]
End Operator
PRIVATE Operator *(ByRef extWS As const extWstring) As const wString ptr
return extWS.pPointerWstr
End Operator
PRIVATE operator len(w as extWstring) as integer
return w.iLen
End Operator
PRIVATE property extWstring.UTF8() as string
dim as Long iBlen
Dim As zString Ptr szBuf
dim as string sRet
iBlen = WideCharToMultiByte (CP_UTF8 , 0 , this.pPointerWstr , -1 , 0 , 0 , 0 , 0)
szBuf = CAllocate( iBlen + 1 )
WideCharToMultiByte (CP_UTF8 , 0 , this.pPointerWstr , -1 , Cast( LPSTR ,szBuf) , iBlen , 0 , 0)
sRet = *szBuf
if szBuf then deallocate szBuf
return sRet
End Property
PRIVATE property extWstring.UTF8(ByRef s As const string)
dim as Long iLen = Len(s) , iSize
dim as Long iBlen
Dim As WString Ptr pwBuf
pwBuf = Allocate( iLen*SZW + SZW)
iBlen = MultiByteToWideChar(CP_UTF8, 0, StrPtr(s) , -1, 0 , iBLen)
if iBlen > 0 then
iBlen = MultiByteToWideChar(CP_UTF8, 0, StrPtr(s) , -1, pwBuf, iBLen)
if iBlen > 0 then
iSize = iBlen*SZW
If iSize > This.iSize Orelse (iSize + SIZEALLOC) < This.iSize Then
iSize += SIZEALLOC
deallocate(this.pPointerWstr)
this.pPointerWstr = allocate(this.iSize)
EndIf
This.iLen = iBlen - 1
memcpy( this.pPointerWstr , pwBuf , iSize )
cast(short ptr ,(this.pPointerWstr))[this.iLen] = 0
endif
endif
if pwBuf then deallocate pwBuf
End Property
PRIVATE function val (w as extWstring) as double
return val(**w)
End function
PRIVATE function valint (w as extWstring) as integer
return valint(**w)
End function
PRIVATE function right (w as extWstring , n as integer) as extWstring
dim sRet as extWstring
sRet = right(**w , n )
return sRet
End function
PRIVATE function left (w as extWstring , n as integer) as extWstring
dim sRet as extWstring
sRet = left(**w , n )
return sRet
End Function
Code: Select all
#include "crt.bi"
Type extWstring Extends Wstring
Dim pPointerWstr As Wstring Ptr ' Pointer to the data
Dim iLen As Long ' Length line
Dim iSize As Long ' allocated bytes
Declare Constructor()
Declare Constructor(Byref As Const Wstring Ptr)
Declare Constructor(Byref As Const extWstring)
Declare Constructor(Byref As Const String)
Declare Constructor(As Long)
Declare Destructor()
Declare Operator Let(Byref As Const Wstring Ptr)
Declare Operator Let(Byref As Const extWstring)
Declare Operator Let(Byref As Const String)
Declare Operator &=(Byref As Const Wstring Ptr)
Declare Operator &=(Byref As Const String)
Declare Operator &=(Byref As Const extWstring)
Declare Operator &=(Byval As Const Longint)
Declare Operator &=(Byval As Const Double)
Declare Operator +=(Byref As Const Wstring Ptr)
Declare Operator +=(Byref As Const String)
Declare Operator +=(Byref As Const extWstring)
Declare Operator Cast() Byref As Const Wstring
Declare Operator [](As Long) Byref As Ulong
Declare Property UTF8() As String
Declare Property UTF8(Byref As Const String)
Declare Function EncodeUTF8ToUnicode(sTextUtf8 As Const String) As Wstring Ptr
Declare Function EncodeUnicodeToUTF8(wsText As Wstring Ptr) As String
Declare Function CalculateUTF8ToUnicode(sTextUtf8 As Const String) As Long
Const SZW As Long = Sizeof(Wstring) ' size wstring (linux - 4 , windows - 2)
Const SIZEALLOC As Long = 30*SZW
End Type
' init default
Private Constructor extWstring()
Dim As Long iSize = SIZEALLOC
This.pPointerWstr = Allocate( iSize )
This.iLen = 0
This.iSize = iSize
(This.pPointerWstr)[0] = 0
End Constructor
' init assign , let operators , &= operators
#macro MACRO_ASSIGN_LET_STRING(operations , macrotype , macrotypeSTR , flagConcatOrPlus , Specifier)
#if operations = "ASSIGN"
#define __BEGIN_MACROCLASS_BLOCK__ Constructor extWstring
#define __END_MACROCLASS_BLOCK__ End Constructor
#elseif operations = "LET"
#undef __BEGIN_MACROCLASS_BLOCK__
#undef __END_MACROCLASS_BLOCK__
#define __BEGIN_MACROCLASS_BLOCK__ Operator extWstring.Let
#define __END_MACROCLASS_BLOCK__ End Operator
#elseif operations = "&="
#undef __BEGIN_MACROCLASS_BLOCK__
#define __BEGIN_MACROCLASS_BLOCK__ Operator extWstring.&=
#elseif operations = "+="
#undef __BEGIN_MACROCLASS_BLOCK__
#define __BEGIN_MACROCLASS_BLOCK__ Operator extWstring.+=
#endif
Private __BEGIN_MACROCLASS_BLOCK__(Specifier s As Const macrotype)
#if macrotypeSTR = "WSTRING PTR"
Dim As Long iLen = Len(*s)
#elseif macrotypeSTR = "EXTWSTRING"
Dim As Long iLen = s.iLen
#elseif macrotypeSTR = "STRING"
Dim As Long iLen = CalculateUTF8ToUnicode(s)
#elseif macrotypeSTR = "NUMERIC"
#if flagConcatOrPlus = 1
Dim sz As Wstring*30 = Wstr(s)
Dim As Long iLen = Len(sz)
#endif
#endif
Dim As Long iSize = iLen * SZW + SZW
Dim As Long iLenTemp = This.iLen
#if flagConcatOrPlus = 1
If This.iSize < This.iLen * SZW + iSize Then
iSize = This.iLen * SZW + iSize + SIZEALLOC
This.pPointerWstr = Reallocate(This.pPointerWstr , iSize)
This.iSize = iSize
Endif
#else
If iSize > This.iSize Orelse (iSize + SIZEALLOC) < This.iSize Then
iSize += SIZEALLOC
Deallocate(This.pPointerWstr)
This.pPointerWstr = Allocate(iSize)
This.iSize = iSize
Endif
#endif
Dim As Long Ptr pDest , pSource
Dim As Boolean bFlagDeallocate
#if macrotypeSTR = "WSTRING PTR"
pSource = Cast(Long Ptr,s)
#elseif macrotypeSTR = "EXTWSTRING"
pSource = Cast(Long Ptr,s.pPointerWstr)
#elseif macrotypeSTR = "STRING"
Dim As Wstring Ptr pwBuf
pwBuf = EncodeUTF8ToUnicode(s)
iLen = Len(*pwBuf)
pSource = Cast(Long Ptr, pwBuf)
bFlagDeallocate = TRUE
#elseif macrotypeSTR = "NUMERIC"
#if flagConcatOrPlus = 1
pSource = Cast(Long Ptr, @sz)
#endif
#endif
#if flagConcatOrPlus = 1
This.iLen = iLen + This.iLen
pDest = Cast(Long Ptr,This.pPointerWstr) + iLenTemp
#else
This.iLen = iLen
pDest = Cast(Long Ptr,This.pPointerWstr)
#endif
If pDest Andalso pSource Then
memcpy(pDest , pSource, iLen * SZW)
Cast(Long Ptr ,(This.pPointerWstr))[This.iLen] = 0
Endif
If bFlagDeallocate Then
If pSource Then Deallocate(pSource)
Endif
__END_MACROCLASS_BLOCK__
#endmacro
MACRO_ASSIGN_LET_STRING("ASSIGN" , Wstring Ptr , "WSTRING PTR" , 0 , Byref)
MACRO_ASSIGN_LET_STRING("ASSIGN" , extWstring , "EXTWSTRING" , 0 , Byref)
MACRO_ASSIGN_LET_STRING("ASSIGN" , String , "STRING" , 0 , Byref)
MACRO_ASSIGN_LET_STRING("LET" , Wstring Ptr , "WSTRING PTR" , 0 , Byref)
MACRO_ASSIGN_LET_STRING("LET" , extWstring , "EXTWSTRING" , 0 , Byref)
MACRO_ASSIGN_LET_STRING("LET" , String , "STRING" , 0 , Byref)
MACRO_ASSIGN_LET_STRING("&=" , Wstring Ptr , "WSTRING PTR" , 1 , Byref)
MACRO_ASSIGN_LET_STRING("&=" , extWstring , "EXTWSTRING" , 1 , Byref)
MACRO_ASSIGN_LET_STRING("&=" , String , "STRING" , 1 , Byref)
MACRO_ASSIGN_LET_STRING("&=" , Longint , "NUMERIC" , 1 , Byval)
MACRO_ASSIGN_LET_STRING("&=" , Double , "NUMERIC" , 1 , Byval)
MACRO_ASSIGN_LET_STRING("+=" , Wstring Ptr , "WSTRING PTR" , 1 , Byref)
MACRO_ASSIGN_LET_STRING("+=" , extWstring , "EXTWSTRING" , 1 , Byref)
MACRO_ASSIGN_LET_STRING("+=" , String , "STRING" , 1 , Byref)
' init fix size
Private Constructor extWstring(Byval iNumberSimbols As Long)
This.iLen = iNumberSimbols * SZW
This.iSize = This.iLen * SZW + SZW
This.pPointerWstr = Callocate(This.iSize)
End Constructor
Private Destructor extWstring()
Deallocate(pPointerWstr)
End Destructor
Private Operator extWstring.Cast() Byref As Const Wstring
Return *(This.pPointerWstr)
End Operator
Private Operator extWstring.[](iIndex As Long) Byref As Ulong
Return (This.pPointerWstr)[iIndex]
End Operator
Private Operator *(Byref extWS As Const extWstring) As Const Wstring Ptr
Return extWS.pPointerWstr
End Operator
Private Operator Len(w As extWstring) As Integer
Return w.iLen
End Operator
Private Property extWstring.UTF8() As String
Return EncodeUnicodeToUTF8(This.pPointerWstr)
End Property
Private Property extWstring.UTF8(Byref s As Const String)
Dim As Long iLen = Len(s) , iSize
Dim As Wstring Ptr pwBuf
If iLen > 0 Then
pwBuf = EncodeUTF8ToUnicode(s)
If pwBuf Then
This.iLen = Len(*pwBuf)
iSize = This.iLen*SZW+SZW
If iSize > This.iSize Orelse (iSize + SIZEALLOC) < This.iSize Then
iSize += SIZEALLOC
Deallocate(This.pPointerWstr)
This.pPointerWstr = Allocate(This.iSize)
Endif
memcpy( This.pPointerWstr , pwBuf , iSize )
Cast(Long Ptr ,(This.pPointerWstr))[This.iLen] = 0
Endif
Endif
If pwBuf Then Deallocate pwBuf
End Property
Private Function Val (w As extWstring) As Double
Return Val(**w)
End Function
Private Function Valint (w As extWstring) As Integer
Return Valint(**w)
End Function
Private Function Right (w As extWstring , n As Integer) As extWstring
Dim sRet As extWstring
sRet = Right(**w , n )
Return sRet
End Function
Private Function Left (w As extWstring , n As Integer) As extWstring
Dim sRet As extWstring
sRet = Left(**w , n )
Return sRet
End Function
Private Function extWstring.CalculateUTF8ToUnicode(sTextUtf8 As Const String) As Long
Dim As Long iIndex
For i As Long = 0 To Len(sTextUtf8) -1
If (sTextUtf8[i] And &hF0) = &hE0 Andalso (sTextUtf8[i+1] And &hC0) = &h80 Andalso (sTextUtf8[i+2] And &hC0) = &h80 Then
i+=2
Elseif (sTextUtf8[i] And &hC0) = &hC0 Andalso (sTextUtf8[i+1] And &hC0) = &h80 Then
i+=1
Endif
iIndex+=1
Next
Return iIndex
End Function
Private Function extWstring.EncodeUTF8ToUnicode(sTextUtf8 As Const String) As Wstring Ptr
Dim As Long iIndex
Dim As Long shUnicodeSymbol
Dim As Wstring Ptr ws = Callocate(Len(sTextUtf8)*SZW+SZW)
For i As Long = 0 To Len(sTextUtf8) -1
If (sTextUtf8[i] And &hF0) = &hE0 Andalso (sTextUtf8[i+1] And &hC0) = &h80 Andalso (sTextUtf8[i+2] And &hC0) = &h80 Then
shUnicodeSymbol = ((sTextUtf8[i] And &hF) Shl 12) Or (((sTextUtf8[i+1] And &h3F) Shl 6) Or (sTextUtf8[i+2] And &h3F))
i+=2
Elseif (sTextUtf8[i] And &hC0) = &hC0 Andalso (sTextUtf8[i+1] And &hC0) = &h80 Then
shUnicodeSymbol = ((sTextUtf8[i] And &h1F) Shl 6) Or ((sTextUtf8[i+1] And &h3F))
i+=1
Elseif (sTextUtf8[i] And &h80) = &h0 Then
shUnicodeSymbol = sTextUtf8[i]
Else
shUnicodeSymbol = &hFFFD
Endif
(*ws)[iIndex] = shUnicodeSymbol
iIndex+=1
Next
(*ws)[iIndex] = 0
Return ws
End Function
Private Function extWstring.EncodeUnicodeToUTF8(wsText As Wstring Ptr ) As String
Dim As Long iSimbol
Dim As String sRet
For i As Long = 0 To Len(*wsText)-1
iSimbol = wsText[i]
If iSimbol < &h80 Then
sRet &= Chr(iSimbol)
Elseif iSimbol < &h800 Then
sRet &= Chr(&hC0 Or (iSimbol Shr 6)) & Chr(&h80 Or (iSimbol And &h3f))
Elseif iSimbol < &h10000 Andalso (iSimbol < &hD800 Orelse iSimbol > &hDFFF) Then
sRet &= Chr((&he0 Or (&hF And (iSimbol Shr 12)))) & Chr(&h80 Or (&h3f And (iSimbol Shr 6))) & Chr(&h80 Or (iSimbol And &h3F))
Else
sRet &= Chr(&hEF) & Chr(&hBF) & Chr(&hBD)
End If
Next
Return sRet
End Function