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
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'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
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'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
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
No. It will create an empty BSTR.
But it is unneeded, because there is already one.
' ========================================================================================
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.
Jose,
This will not compile with your CBStr.
James
'#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
But it is strictly a parser thingy. If it works adding a parameterless constructor, then do it.