• Welcome to PlanetSquires Forums.
 

bstr class

Started by aloberr, January 15, 2016, 02:32:29 PM

Previous topic - Next topic

aloberr

widestring.bi
#Include Once "win/ole2.bi"



type WideString
Private:
   Declare Function StrToBSTR(cnv_string As String) As BSTR
    Public:
   m_bstr As BSTR
   m_str  As ZString Ptr 
  Public:
   Declare Constructor() 
   Declare Constructor(mbstr As BSTR )
   Declare Constructor(mstr As String )
   Declare Constructor(byref mwstr As WideString )
   Declare Operator Let(mbstr As BSTR )
   Declare Operator Let(mstr As String )
   Declare Operator Let(ByRef mstr As WideString )
    Declare Operator +=(byref s  as  WideString ) 
Declare Operator &=(byref s  as  WideString ) 
    Declare Operator +=(byref s  as  String ) 
Declare Operator &=(byref s  as  String ) 
    Declare Operator +=(byref s  as  BSTR ) 
Declare Operator &=(byref s  as  BSTR )
   
   Declare Operator Cast() As BSTR
   Declare Operator Cast() As String
   Declare Operator Cast() As BSTR Ptr
   Declare Operator Cast() As String Ptr
   Declare Destructor()
End Type

Constructor WideString()
   m_str=NULL
   m_bstr=NULL
End Constructor


Constructor WideString(mbstr As BSTR )
    if (0=mbstr) Then
    m_str = NULL
    Else
    Dim s As String=*Cast(WString Ptr,mbstr)
      m_str=New Byte[Len(s)+1]
      *m_str= s
    End If
    m_bstr=mbstr
End Constructor

Constructor WideString(mstr As String )
    if Len(mstr)=NULL Then
    m_str = NULL
    m_bstr=NULL
    Else
      m_str=New Byte[Len(mstr)+1]
      *m_str= mstr
      m_bstr=StrToBSTR(mstr)
    End if
End Constructor

Constructor WideString(byref mwstr As WideString )
  'if mwstr.m_str  Then  m_str  = mwstr.m_str       ' erratique  m_str non instancié
  'if mwstr.m_bstr Then  m_bstr = mwstr.m_bstr
 
  if mwstr.m_str  Then 
    this.constructor(*mwstr.m_str)
    Exit Constructor
  Else
  if mwstr.m_bstr Then  this.constructor(mwstr.m_bstr)

  EndIf
   
End Constructor

Operator WideString.let(mbstr As BSTR )
    if m_str  Then  Delete [] m_str :m_str = NULL
    if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mbstr)
End Operator

Operator WideString.let(mstr As String )
   if m_str  Then  Delete [] m_str :m_str = NULL
   if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mstr)
End Operator

Operator WideString.let(byref mwstr As WideString )
   if m_str  Then  Delete [] m_str :m_str = NULL
   if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mwstr)
End Operator

Operator WideString.Cast() As BSTR
if m_bstr=NULL  Then
   Return StrToBSTR(*m_str)
Else
   Return m_bstr
End If   
End Operator

Operator WideString.Cast() As String
if m_str=NULL  Then
   '*m_str=*Cast(WString Ptr,m_bstr) ' mauvais car m_str non initialisé
   this.constructor(m_bstr)
   Return *m_str
Else
   Return  *m_str
End If
End Operator
   
Operator WideString.Cast() As BSTR Ptr
if m_bstr=NULL  Then
    m_bstr=StrToBSTR(*m_str)
    Return cptr(BSTR Ptr,m_bstr)
Else
    Return cptr(BSTR Ptr,m_bstr)
End If
End Operator

Operator WideString.Cast() As String Ptr
if m_str=NULL  Then
     this.constructor(m_bstr)
     Return  Cast(String Ptr,m_str)
Else
    Return  Cast(String Ptr,m_str)
End If   
End Operator

  Destructor WideString()
    If m_str Then Delete [] m_str : m_str=NULL
    if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
End Destructor     

Function WideString.StrToBSTR(cnv_string As String) As BSTR
    Dim sb As BSTR
    Dim As Integer n
    n = (MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, StrPtr(cnv_string), -1, NULL, 0))-1
    sb=SysAllocStringLen(sb,n)
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, StrPtr(cnv_string), -1, sb, n)
    Return sb
End Function


Operator WideString.+=(byref s As  WideString ) 
'If Len(*m_str) And Len(*s.m_str) Then    ' on ne peut pas ajouter un " " /
     Dim temp As String =*m_str
  temp=temp & *s.m_str
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)   
     
'Else

'End If
End Operator

Operator WideString.&=(byref s  as  WideString ) 
'If Len(*m_str) And Len(*s.m_str) Then
  Dim temp As String =*m_str
  temp=temp & *s.m_str
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)
'Else
     
'End If
End Operator

   Operator WideString.+=(byref s  as  String ) 
    'If m_str<>NULL And Len(s)<>NULL Then
  Dim temp As String =*m_str
  temp=temp & s
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)
  ' Else
     
  ' End If
   End Operator
   
Operator WideString.&=(byref s As  String )
'If  m_str<>NULL And  Len(s)<>NULL Then
    Dim temp As String =*m_str
    temp=temp & s
    If m_str  Then  Delete [] m_str :m_str = NULL
             If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
             this.constructor(temp)
     ' Else
     
   '   End If
End Operator

   

   Operator WideString.+=(byref s  as  BSTR )
   ' If sysstringLen(m_bstr) Then
         Dim As BSTR mbstr
     VarBstrCat(m_bstr,s,@mbstr)
     if m_str  Then  Delete [] m_str :m_str = NULL
              If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
              this.constructor(mbstr)
'  Else
     
'  End If

   End Operator
   
  Operator WideString.&=(byref s  as  BSTR )
  ' If sysstringLen(m_bstr) Then
     Dim As BSTR mbstr
     VarBstrCat(m_bstr,s,@mbstr)
     if m_str  Then  Delete [] m_str :m_str = NULL
              If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
              this.constructor(mbstr)
' Else
     
' End If
 
  End Operator


Operator + OverLoad ( byref s1 As  ZString Ptr , byref  s2 As  WideString ) As WideString
    Dim As String s =  *s1 + Cast(String,s2)
Operator= (s)
  End Operator

  Operator +( byref  s2 As  WideString, byref s1 As  ZString Ptr  ) As WideString
     Dim s As String= Cast(String,s2) + *s1
  Return s
  End Operator

 
  Operator +( byref s1 As  BSTR , byref  s2 As  WideString ) As WideString
Dim s As BStr
VarBstrCat(s1,Cast(BSTR,s2),@s)
Operator= s
  End Operator

  Operator +( byref  s2 As  WideString, byref s1 As  BSTR  ) As WideString
Dim s As BStr
VarBstrCat(Cast(BSTR,s2),s1,@s)
Operator= s
  End Operator

 
   
 
  Operator & OverLoad ( byref s1 As  ZString Ptr , byref  s2 As  WideString ) As WideString
Dim As String s =  *s1 & Cast(String,s2)
Return (s)
  End Operator

  Operator &( byref  s2 As  WideString, byref s1 As ZString Ptr  ) As WideString
  Dim s As String= Cast(String,s2) & *s1
  Return (s)
  End Operator

   
Operator &( byref s1 As  BSTR , byref  s2 As  WideString ) As WideString
Dim s As BStr
VarBstrCat(s1,Cast(BSTR,s2),@s)
Return s
  End Operator

  Operator &( byref  s2 As  WideString, byref s1 As  BSTR  ) As WideString
Dim s As BStr
VarBstrCat(Cast(BSTR,s2),s1,@s)
Return s
  End Operator
 
 
 

Operator Not OverLoad ( ByRef lhs As WideString)  As  boolean
Return (Cast(String,lhs) = "") And (Cast(BSTR,lhs) = NULL)
End Operator

Operator = OverLoad  ( ByRef lhs As WideString, ByRef rhs As  ZString Ptr )  As  boolean
Return (Cast(String,lhs) = *rhs)
End Operator

Operator = OverLoad  (ByRef rhs As  ZString Ptr, ByRef lhs As WideString)  As  boolean
Return (Cast(String,lhs) = *rhs)
End Operator

Operator <> OverLoad ( ByRef lhs As WideString, ByRef rhs As  ZString Ptr ) As  boolean
  Return (Cast(String,lhs) <> *rhs)
End Operator

Operator <> OverLoad (ByRef rhs As  ZString Ptr , ByRef lhs As WideString) As  boolean
  Return (Cast(String,lhs) <> *rhs)
End Operator

Operator = ( ByRef lhs As WideString, ByRef rhs As  BSTR )  As  boolean
Return (Cast(BSTR,lhs) = rhs)
End Operator

Operator = (  ByRef rhs As  BSTR,ByRef lhs As WideString )  As  boolean
Return (Cast(BSTR,lhs) = rhs)
End Operator

Operator <> ( ByRef lhs As WideString, ByRef rhs As  BSTR ) As  boolean
Return (Cast(BSTR,lhs) <> rhs)
End Operator

Operator <> (ByRef rhs As  BSTR, ByRef lhs As WideString ) As  boolean
Return (Cast(BSTR,lhs) <> rhs)
End Operator

Function  StrToBSTR(cnv_string As String) As BSTR
    Dim sb As BSTR
    Dim As Integer n
    n = (MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, StrPtr(cnv_string), -1, NULL, 0))-1
    sb=SysAllocStringLen(sb,n)
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, StrPtr(cnv_string), -1, sb, n)
    Return sb
End Function

widestring_test.bas
#Include Once "WideString.bi"



Dim s As String="ayelma"
Dim b As BSTR=StrToBSTR("programation")     'b must be freed by calling sysfreestring
Dim w As WideString="bazelma"        ' construcor utilisé

Print w

Dim w2 As WideString=b            ' construcor utilisé
Print w2

Dim w3 As WideString=s           ' construcor utilisé
Print w3

If b Then sysfreestring(b):b=NULL

Sub Get_String(ByRef ps As ZString Ptr)
  ' ps=New Byte[255+1]
  ps=New Byte[255+1]
*ps= "une ZString ptr en entree et sortie"
End Sub

Sub Get_BSTR(b As BSTR Ptr)
*b=StrToBSTR("une bstr en entree et sortie")
End Sub

Dim w4 As Widestring
Get_BSTR(Cast(BSTR Ptr,@b))
w4=b                       ' opérator let utilisé
Print "w4",w4


Dim w5 As Widestring
Get_BSTR(Cast(BSTR Ptr,@w5))   ' _Get_(Cast(BSTR Ptr,w5))  pas bon
Print "w5",w5

Dim w6 As Widestring
   Get_String(w6.m_str)
  Print "w6 =";w6


  Dim w7 As Widestring
  w7="construction avec m_str"   
Print "w7 =";w7

  Dim w8 As Widestring
  w8=StrToBSTR("construction avec m_bstr")    'memory will be freed automatically
Print "w8 =";w8

Dim As widestring w10
  w10=w5+ " => string ajout sur widestring"
Print "w10 =" & w10

w8=w8 & " => string ajout sur widestring(bstr)"
  Print "w8 =";w8

w7 &=" => string ajout sur widestring(bstr)"
  Print "w7 =";w7

w7 +=" => string ajout sur widestring(bstr)"
  Print "w7 =";w7

  w6=" => string ajout sur widestring " + w6 
Print "w6 =" & w6

Type BSTRclass As WideString

Dim As BSTRclass w11
  w11=w10 & " ******"
Print "w11 =" & w11


Sleep


José Roca

Instead of the StrToBSTR function you can use SysAllocString(WSTR(szStr)), where szStr is a FB ansi string or null terminated string. WSTR does the work of converting it to unicode instead of having to call MultiByteToWideChar.


aloberr

you are right, easy to modify