Print

Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

[José Roca]

We can do string concatenation without memory leaks using

DIM bs3 AS CBStr = **bs1 & " " & **bs2

A little weird syntax, but...

No wonder the CComBstr class of Microsoft Fundation Classes does not have string concatenation.

Only the compiler can deal with the intermediate temporary strings.

[José Roca]

I have added the operator @. It allows to pass the address of the BSTR pointer (m_bstr) to a function (OUT parameter). As the address is manipulated directly, we must first set it to empty if it has contents to avoid memory leaks. To set it to empty, just assign an empty string to it, i.e. bs = "".

Code: [Select]

' ========================================================================================
' Returns the address of the BSTR
' ========================================================================================
OPERATOR CBStr.@ () AS AFX_BSTR PTR
   OPERATOR = @m_bstr
END OPERATOR
' ========================================================================================

Usage example:

Code: [Select]

SUB Foo (BYVAL b AS AFX_BSTR PTR)
   *b = SysAllocString("xxxxx")
END SUB

DIM bs AS CBStr
Foo @bs
print **bs

Well, I think that now the class is fully usable. We still need to use double indirection to print the contents of the BSTR (**bs) because the current version of the compiler does not support the * operator as a member of the class. It is in the TODO list.

[José Roca]

We can declare "A" and "W" functions as follows:

Code: [Select]

' ========================================================================================
' Returns the path of the program that is currently executing.
' Contrarily to the Free Basic ExePath function, it includes a trailing "\".
' ========================================================================================
PRIVATE FUNCTION AfxGetExePathA () AS STRING
   DIM buffer AS STRING * MAX_PATH + 1
   GetModuleFileNameA NULL, STRPTR(buffer), LEN(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   FUNCTION = LEFT(buffer, p)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxGetExePathW () AS AFX_BSTR
   DIM buffer AS WSTRING * MAX_PATH
   GetModuleFileNameW NULL, @buffer, SIZEOF(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   DIM bs AS AFX_BSTR = SysAllocString(LEFT(buffer, p))
   FUNCTION = bs
END FUNCTION
' ========================================================================================

#ifndef UNICODE
   #define AfxGetExePath AfxGetExePathA
#else
   #define AfxGetExePath AfxGetExePathW
#endif

Usage of the "W" version:

Code: [Select]

DIM bs AS CBStr = AfxGetExePathW
print **bs

Usage example without assigning the returned handle to an instance of the class.

Code: [Select]

DIM b AS AFX_BSTR = AfxGetExePathW
print *b
SysFreeString b


[Paul Squires]

Will you consider adding some of these controls soon to the Firefly for FB interface, because I really suck at placing controls manually.
Some of the stuff you posted here really is starting to make Freebasic look like a good move, but many of us would love just to click and place.
PLEASE...

I think what I will do as an interim step will be to create a small utility that will read a FireFly frm file and create the necessary cWindow code. Allow that code to be copied to the clipboard so that you can paste it into your editor. This will allow us to use FireFly to visually create a form while still be able to have access to the underlying cWindow code that could be used to create that form.

EDIT: Added - this utility is just about complete. Just need to do some testing and then I will post it.

EDIT: Added - utility is now available at: http://www.planetsquires.com/protect/forum/index.php?topic=3834.msg28038



 

[aloberr]

josé
for CBSTR ,I have to add a constructor, operator let and cast for the BSTR
your method is not badly, but there is simpler with my method
to see widestring.bi and its test

Code: [Select]

#pragma once

#include once "windows.bi"
#include once "win/ole2.bi"
#Include once "win/shlwapi.bi"

#ifndef AFX_BSTR
   #define AFX_BSTR WSTRING PTR
#endif

NAMESPACE Afx.CBStrClass

' ========================================================================================
' CBStr - OLE strings class
' ========================================================================================
TYPE CBStr

   Private:
      m_bstr AS AFX_BSTR

   Public:
      DECLARE CONSTRUCTOR (BYREF wszStr AS CONST WSTRING = "")
      DECLARE CONSTRUCTOR (BYREF szStr AS STRING = "")
      DECLARE CONSTRUCTOR (BYREF pCBStr AS CBStr)
      DECLARE CONSTRUCTOR (BYREF bstrHandle AS AFX_BSTR = NULL)
      DECLARE CONSTRUCTOR (BYVAL pCBStr AS BSTR)
      DECLARE DESTRUCTOR
      DECLARE OPERATOR Let (BYREF szStr AS STRING)
      DECLARE OPERATOR Let (BYREF wszStr AS CONST WSTRING)
      DECLARE OPERATOR Let (BYREF pCBStr AS CBStr)
      DECLARE OPERATOR Let (BYREF bstrHandle AS AFX_BSTR)
      DECLARE OPERATOR Let (BYVAL pBStr AS BSTR)
      DECLARE OPERATOR += (BYREF wszStr AS CONST WSTRING)
      DECLARE OPERATOR += (BYREF pCBStr AS CBStr)
      DECLARE OPERATOR &= (BYREF wszStr AS CONST WSTRING)
      DECLARE OPERATOR &= (BYREF pCBStr AS CBStr)
      DECLARE PROPERTY Handle () AS AFX_BSTR
      DECLARE SUB Append (BYREF wszStr AS CONST WSTRING)
      DECLARE FUNCTION Concat (BYREF wszStr2 AS CONST WSTRING, BYREF wszStr2 AS CONST WSTRING) AS AFX_BSTR
      DECLARE OPERATOR cast() AS String
      DECLARE OPERATOR cast() AS BSTR
END TYPE
' ========================================================================================

' ========================================================================================
' CBStr class constructor
' ========================================================================================
CONSTRUCTOR CBStr (BYREF wszStr AS CONST WSTRING = "")
   m_bstr = SysAllocString(wszStr)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF szStr AS STRING = "")
   m_bstr = SysAllocString(WSTR(szStr))
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF pCBStr AS CBStr)
   m_bstr = SysAllocString(*pCBStr.Handle)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF bstrHandle AS AFX_BSTR = NULL)
   IF bstrHandle = NULL THEN
      m_bstr = SysAllocString("")
   ELSE
      ' Detect if the passed handle is an OLE string
      ' If it is an OLE string it must have a descriptor; otherwise, don't
      ' Get the length looking at the descriptor
      DIM res AS INTEGER = PEEK(DWORD, CAST(ANY PTR, bstrHandle) - 4) \ 2
      ' If the retrieved length if the same that the returned by LEN, then it must be an OLE string
      IF res = .LEN(*bstrHandle) THEN
         ' Free the current OLE string and attach the passed handle to the class
         m_bstr = bstrHandle
      ELSE
         ' Allocate an OLE string with the contents of the string pointer by bstrHandle
         m_bstr = SysAllocString(*bstrHandle)
      END IF
   END IF
END CONSTRUCTOR

CONSTRUCTOR CBStr(BYVAL pCBStr AS BSTR)
    m_bstr =Cast(WString Ptr,pCBStr)
End Constructor

' ========================================================================================
' CBStr class destructor
' ========================================================================================
DESTRUCTOR CBStr
   IF m_bstr THEN SysFreeString m_bstr
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Assigns new text to the BSTR
' Note: We can also pass a FB ansi string (the conversion to Unicode is automatic)
' ========================================================================================
OPERATOR CBStr.Let (BYREF wszStr AS CONST WSTRING)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(wszStr)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF szStr AS STRING)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(WSTR(szStr))
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF pCBStr AS CBStr)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(*pCBStr.Handle)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF bstrHandle AS AFX_BSTR)
   IF bstrHandle = NULL THEN EXIT OPERATOR
   ' Free the current OLE string
   IF m_bstr THEN SysFreeString(m_bstr)
   ' Detect if the passed handle is an OLE string
   ' If it is an OLE string it must have a descriptor; otherwise, don't
   ' Get the length looking at the descriptor
   DIM res AS INTEGER = PEEK(DWORD, CAST(ANY PTR, bstrHandle) - 4) \ 2
   ' If the retrieved length if the same that the returned by LEN, then it must be an OLE string
   IF res = .LEN(*bstrHandle) THEN
      ' Attach the passed handle to the class
      m_bstr = bstrHandle
   ELSE
      ' Allocate an OLE string with the contents of the string pointer by bstrHandle
      m_bstr = SysAllocString(*bstrHandle)
   END IF
END OPERATOR

OPERATOR CBStr.Let (BYVAL szStr AS BSTR)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = Cast(WString Ptr,szStr)
END Operator


  OPERATOR CBStr.cast() AS String
    Return *m_bstr
  End Operator

  OPERATOR CBStr.cast() AS BSTR
    Return  Cast(BSTR,m_bstr)
  End Operator
 
' ========================================================================================
' Returns the handle of the BSTR
' ========================================================================================
PROPERTY CBStr.Handle () AS AFX_BSTR
   PROPERTY = m_bstr
END PROPERTY
' ========================================================================================

' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' To append another BSTR:
' DIM bs1 AS CBStr = "1st string"
' DIM bs2 AS CBStr = "2nd string"
' bs1.Append *bs2.Handle
' -or-
' bs1.Append **bs2
' ========================================================================================
SUB CBStr.Append (BYREF wszStr AS CONST WSTRING)
   DIM n1 AS UINT = SysStringLen(m_bstr)
   DIM nLen AS UINT = .LEN(wszStr)
   IF nLen = 0 THEN EXIT SUB
   DIM b AS AFX_BSTR = SysAllocStringLen(NULL, n1+nLen)
   IF b = NULL THEN EXIT SUB
   memcpy(b, m_bstr, n1 * SIZEOF(WSTRING))
   memcpy(b+n1, @wszStr, nLen * SIZEOF(WSTRING))
   SysFreeString(m_bstr)
   m_bstr = b
END SUB
' ========================================================================================

' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' ========================================================================================
OPERATOR CBStr.+= (BYREF wszStr AS CONST WSTRING)
   this.Append(wszStr)
END OPERATOR
' ========================================================================================

' ========================================================================================
' Appends a BSTR to the BSTR.
' ========================================================================================
OPERATOR CBStr.+= (BYREF pCBStr AS CBStr)
   this.Append(*pCBStr.Handle)
END OPERATOR
' ========================================================================================

' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' ========================================================================================
OPERATOR CBStr.&= (BYREF wszStr AS CONST WSTRING)
   this.Append(wszStr)
END OPERATOR
' ========================================================================================

' ========================================================================================
' Appends a BSTR to the BSTR.
' ========================================================================================
OPERATOR CBStr.&= (BYREF pCBStr AS CBStr)
   this.Append(*pCBStr.Handle)
END OPERATOR
' ========================================================================================

' ========================================================================================
' Returns vbTrue (-1) if the two BSTRings are equal; FALSE, otherwise.
' ========================================================================================
OPERATOR = (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) = 0
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR = (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) = 0
END OPERATOR
' ========================================================================================
OPERATOR = (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) = 0
END OPERATOR
' ========================================================================================

' ========================================================================================
' Returns vbTrue (-1) if the two BSTRings are not equal; FALSE, otherwise.
' ========================================================================================
OPERATOR <> (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) <> 0
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR <> (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) <> 0
END OPERATOR
' ========================================================================================
OPERATOR <> (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) <> 0
END OPERATOR
' ========================================================================================

' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is greater than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
OPERATOR > (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) > 0
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR > (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) > 0
END OPERATOR
' ========================================================================================
OPERATOR > (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) > 0
END OPERATOR
' ========================================================================================

' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is less than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
OPERATOR < (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) < 0
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR < (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
   OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) < 0
END OPERATOR
' ========================================================================================
OPERATOR < (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
   OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) < 0
END OPERATOR
' ========================================================================================

' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is greater or equal than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
OPERATOR >= (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
   DIM nResult AS LONG
   nResult = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle)
   IF nResult > 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR >= (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
   DIM nResult AS LONG
   nResult = StrCmpW(*pCBStr.Handle, wszStr)
   IF nResult > 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
END OPERATOR
' ========================================================================================
OPERATOR >= (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
   DIM nResult AS LONG
   nResult = StrCmpW(wszStr, *pCBStr.Handle)
   IF nResult > 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0


[aloberr]

test.bas

Code: [Select]

#Include Once "cbstr.bi"

Using  Afx.CBStrClass

Dim cs As CBStr=CBStr("Une string dans Com String")
Dim cs2 As CBStr

Dim bs As BSTR =cs
Print cs
Print *Cast(WString Ptr,bs)
Print

cs2=cs
Print  cs2

Print
Print

Dim wz As WString*45="Une BSTR dans CCOMBSTR"
cs2=sysallocstring(@wz)
Print  cs2



' To append another BSTR:
 DIM b1 AS CBStr = "1st string"
 DIM b2 AS CBStr = " 2nd string"
 b1.Append *b2.Handle
 '-or-
 'b1.Append **b2
 Print **b1

 DIM bss AS CBStr = "Test string"
 PRINT **bss '(notice the double indirection)


 DIM bs1 AS CBStr = "Test string 1"
 DIM wsz AS WSTRING * 250 = " - concatenated string"
 DIM bs2 AS CBStr
 bs2 = bs1 & wsz
 Print **bs2
Sleep

[aloberr]

widestring.bi

Code: [Select]

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



type WideString
 Private:
    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=SysAllocString(WStr(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 SysAllocString(WStr(*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=SysAllocString(WStr(*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     



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 Operatortestw.bas

Code: [Select]

#Define UNICODE   ' OR NOT
   
#Include Once "widestring.bi"

'Using  Afx.CBStrClass

#Define CBStr WideString

Dim cs As CBStr=CBStr("Une string dans Com String")
Dim cs2 As CBStr

Dim bs As BSTR =cs
Print cs
Print *Cast(WString Ptr,bs)
Print

cs2=cs
Print  cs2

Print
Print

Dim wz As WString*45="Une BSTR dans CCOMBSTR"
cs2=sysallocstring(@wz)
Print  cs2



' To append another BSTR:
 DIM b1 AS CBStr = "1st string"
 DIM b2 AS CBStr = " 2nd string"
 b1 +=b2
 '-or-
 'b1.Append **b2
 Print b1

 DIM bss AS CBStr = "Test string"
 PRINT bss '(notice the double indirection)


 DIM bs1 AS CBStr = "Test string 1"
 DIM wsz AS WSTRING * 250 = " - concatenated string"
 DIM bs2 AS CBStr
 bs2 = bs1 & wsz
 Print bs2
Sleep

[José Roca]

But with

Code: [Select]

Dim cs As CBStr=CBStr("Une string dans Com String")
Print cs

You're printing an ansi string, not an unicode one.

When you use Print cs, it calls this casting operator

Code: [Select]

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


[José Roca]

Unicode is not just converting ansi to utf-16 adding a CHR(0) to any character. This will work with languages that use the ANSI Latin 1; Western European (Windows), but not for Russian, for example.

Using this code, where 1251 is the code page for ANSI Cyrillic; Cyrillic (Windows):

Code: [Select]

#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CBStr.inc"

using Afx.CBStrClass

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED,STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS CBStr = wsz
MessageBoxW 0, **bs, "", MB_OK

print
print "press esc"
sleep

The message box correctly displays семен

Using your class:

Code: [Select]

#define unicode
#INCLUDE ONCE "windows.bi"
#Include Once "Afx/widestring.bi"

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED,STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS WideString = wsz
MessageBoxW 0, bs, "", MB_OK

print
print "press esc"
sleep

It displays ?????

[José Roca]

New version of CbStr.inc. I have removed the leaky concatenation operators and added support to set the code page, as the FreeBasic WSTR function has not a parameter to especify the code page to be used (it should).

We can use:

Code: [Select]

DIM bs AS CBStr = 1251  ' Sets the Russian code page
bs = CHR(209, 229, 236, 229, 237)
MessageBoxW 0, **bs, "", MB_OK

or

Code: [Select]

DIM bs AS CBStr = CBStr(CHR(209, 229, 236, 229, 237), 1251)
MessageBoxW 0, **bs, "", MB_OK

this one uses the Russian code page to do the translation but does not set it permanenty.

You can also use the CodePage property:

Code: [Select]

dim bs AS CBStr
bs.CodePage = 1251   ' Sets the Russian code page
bs = CHR(209, 229, 236, 229, 237)
MessageBoxW 0, **bs, "", MB_OK

We may need to set the code page because we can't use an additional parameter to sepecify it when using the Let operator to assign an ansi string.

[aloberr]

you are right but this is resolved by puting operator cast() byref as wstring
update one
widestring.bi

Code: [Select]

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



type WideString
 Private:
    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(mstr As WString Ptr )
   Declare Constructor(byref mwstr As WideString )
   Declare Operator Let(mbstr As BSTR )
   Declare Operator Let(mstr As String )
   Declare Operator Let(mstr As WString Ptr )
   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() ByRef As WString 
   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=SysAllocString(WStr(mstr))
    End if
End Constructor

 Constructor WideString(mstr As WString Ptr )
     this.constructor(Cast(BSTR,mstr))
 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(mstr As WString Ptr )
this=(Cast(BSTR,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 SysAllocString(WStr(*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) ' pas bon car m_str non initialisé
     this.constructor(m_bstr)
     Return *m_str
  Else
     Return  *m_str
  End If
 End Operator
   
 
 Operator WideString.Cast() ByRef As WString 
  if m_str=NULL  Then
       this.constructor(m_bstr)
       Return  peek(WString,m_str)
  Else
      Return  peek(WString,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     



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


[José Roca]

If I use that change, the program GPFs when it ends.

Code: [Select]

#define unicode
#INCLUDE ONCE "windows.bi"
#Include Once "Afx/widestring.bi"

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED, STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS WideString = wsz
MessageBoxW 0, bs, "", MB_OK


[José Roca]

I have rewritten the AfxUcode/Acode functions:

Code: [Select]

' ========================================================================================
' Translates ansi bytes to unicode bytes
' ========================================================================================
FUNCTION AfxUcode (BYREF ansiStr AS CONST STRING, BYVAL nCodePage AS LONG = 0) AS BSTR
   DIM pbstr AS BSTR = SysAllocString(WSTR(ansiStr))
   IF nCodePage <> 0 THEN MultiByteToWideChar(nCodePage, MB_PRECOMPOSED, STRPTR(ansiStr), -1, pbstr, LEN(ansiStr) * 2)
   FUNCTION = pbstr
END FUNCTION
' ========================================================================================

' ========================================================================================
' Translates unicode bytes to ansi bytes
' ========================================================================================
FUNCTION AfxAcode (BYVAL pbstr AS BSTR, BYVAL nCodePage AS LONG = 0) AS STRING
   DIM ansiStr AS STRING = SPACE(SysStringLen(pbstr))
   DIM hr AS LONG = WideCharToMultiByte(nCodePage, 0, pbstr, SysStringLen(pbstr), STRPTR(ansiStr), LEN(ansiStr), NULL, NULL)
   FUNCTION = ansiStr
END FUNCTION
' ========================================================================================

this allows to use the assignment operator without setting the code page first:

Code: [Select]

Dim bs AS CBStr
bs = AfxUcode(CHR(209, 229, 236, 229, 237), 1251)
MessageBoxW 0, **bs, "", MB_OK

Of course, if WSTR had an optional CodePage parameter, we could do this: bs = WSTR(CHR(209, 229, 236, 229, 237), 1251). In PowerBASIC, that optional CodePage parameter was added by my suggestion.

[aloberr]

If I use that change, the program GPFs when it ends.

curious operator cast() byref as wstring was not the only change

[José Roca]

I have copied all the code you have posted in #55. It GPFs after I click "OK" in the message box. Test it by yourself.