Fun with CBStr

[James Fuller]

I rediscovered some old source from my early days of FreeBasic and decided to try and bring some of the routines up to date.
The only issue I found here is the inability to redim a CBStr array. The error seems to indicate I could if there was a constructor without parameters??

James

jcf_lib.bas

Code Select Expand


'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'New jcf_fblib
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
#include once "windows.bi"
#include once "win/commdlg.bi"
#Include Once "string.bi"
#include Once "Afx/CBstr.inc"
Declare Function FbParseCount OVERLOAD ( cmd As String, del As String)As Long
Declare Function FbParseCount OVERLOAD (cmd As CBstr,del As CBstr) As Long
Declare Function FbParse OVERLOAD (S1 As String,Dlim As String,S2() As String) As Long
Declare Function FbParse OVERLOAD (S1 As CBStr,Dlim As CBStr,S2() As CBStr) As Long
'==============================================================================
Private Function FbParseCount( cmd As String, del As String)As Long
  Dim As Long i,s,c,l
  s=1
  l=Len(del)
  Do
    i=Instr(s,cmd,del)
    If i>0 Then
      c+=1
      s=i+l
    End If
  Loop Until i=0
  Function=c+1
End Function
'==============================================================================
Private Function FbParseCount(cmd As CBstr ,del As CBstr ) As Long
    Dim As Long i,s,c,l
    s=1
    l = Len(del)
    Do
        i = Instr(s,**cmd,**del)
        If i > 0 Then
            c+=1
            s = i + l
        EndIf
    Loop Until i = 0
    Function = c + 1
End Function
'==============================================================================
Private Function FbParse (S1 As String,Dlim As String,S2() As String) As Long
  Dim As Long i,s,c,l,k
      s=1
      l=Len(Dlim)
      k = FbParseCount(S1,DLim)
      Function = k
      ReDim S2(k)
      S2(0) = Str(k)
      c = 1
      Do
        i=Instr(s,S1,Dlim)
        If i>0 Then
             S2(c)=Mid(S1,s,Instr(s,S1,Dlim)-s)
          c+=1
          s=i+l
        Else
             S2(c) = Mid(S1,s,Len(S1))
        End If
      Loop Until i=0
End Function
'==============================================================================
Private Function FbParse (S1 As CBStr,Dlim As CBStr,S2() As CBStr) As Long
      Dim As Long i,s,c,l,k
    s=1
    Function = k
    l=Len(Dlim)
    k = FbParseCount(S1,DLim)
    Function = k
    'ReDim S2(k)
    S2(0) = Str(k)
      c = 1
      Do
        i=Instr(s,**S1,**Dlim)
        If i>0 Then
             S2(c)=Mid(**S1,s,Instr(s,**S1,**Dlim)-s)
          c+=1
          s=i+l
        Else
             **S2(c) = Mid(**S1,s,Len(S1))
        End If
      Loop Until i=0
End Function
'==============================================================================


Testjcf_lib.bas

Code Select Expand


'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'Test jcf_lib
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
#include once "jcf_lib.bas"
Dim As String s
Dim As String sa()
Dim As Long count,k
Dim As CBStr bs = "One,Two,Three,Four,Five,Six",bsa(20),bsdlim = ","

s = "One,Two,Three,Four,Five,Six"
count = FbParse(s,",",sa())
For k = 1 To Count
    ? sa(k)
Next

count = FbParse(bs,bsdlim,bsa())
For k = 1 To Count
    ? **bsa(k)
Next

sleep



[James Fuller]

Jose,
  Do you see any problems with this CBStr implementation?
I added an Empty Constructor so an array of CBStr's can be redimed.

James

[José Roca]

No. It will create an empty BSTR.

But it is unneeded, because there is already one.

Code Select Expand


' ========================================================================================
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
         IF m_bstr THEN SysFreeString(m_bstr)
         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
' ========================================================================================


As the parameter is optional, it will just execute m_bstr = SysAllocString(""). So you can already use DIM cbs AS CBStr without the need of a constructor without parameters.

I have added the following line: IF m_bstr THEN SysFreeString(m_bstr)

Anyway, I have already said that I don't find any of the techniques that I have tried fully satisfactory and, therefore, I probably I'm going to use low-level COM and some wrappers.

[James Fuller]

Jose,
  This will not compile with your CBStr.
James

Code Select Expand


'#include "afx/JcfCBstr.inc"
#include "afx/CBstr.inc"
'==============================================================================
Function FbParseCount (cmd As CBstr ,del As CBstr ) As Long
    Dim As Long i,s,c,l
    s=1
    l = Len(del)
    Do
        i = Instr(s,**cmd,**del)
        If i > 0 Then
            c+=1
            s = i + l
        EndIf
    Loop Until i = 0
    Function = c + 1
End Function
'==============================================================================
Function FbParse  (S1 As CBStr,Dlim As CBStr,S2() As CBStr) As Long
      Dim As Long i,s,c,l,k
    s=1
    Function = k
    l=Len(Dlim)
    k = FbParseCount(S1,DLim)
    Function = k
    ReDim S2(k)
    S2(0) = Str(k)
      c = 1
      Do
        i=Instr(s,**S1,**Dlim)
        If i>0 Then
             S2(c)=Mid(**S1,s,Instr(s,**S1,**Dlim)-s)
          c+=1
          s=i+l
        Else
             **S2(c) = Mid(**S1,s,Len(S1))
        End If
      Loop Until i=0
End Function
'==============================================================================
Dim As CBStr bs = "One,Two,Three,Four,Five,Six",bsa(),bsdlim = ","
Dim AS Long k,count
count = FbParse(bs,bsdlim,bsa())
For k = 1 To Count
    ? **bsa(k)
Next
'==============================================================================
sleep


[José Roca]

But it is strictly a parser thingy. If it works adding a parameterless constructor, then do it.