CountInString()

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
dodicat
Posts: 5700
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: CountInString()

jj2007 -- one reason, you could create a new utopia in your own dinner time.

Code: Select all

Function TALLY(SomeString As String,PartString As String) As Long
Dim As Long LenP=Len(PartString),count
Dim As Long position=Instr(SomeString,PartString)
If position=0 Then Return 0
While position>0
count+=1
position=Instr(position+LenP,SomeString,PartString)
Wend
Return count
End Function

Function findAndReplace(original As String , find As String , replace As String) As String
If Len(find) = 0 Then Return original
Var t = tally(original , find)               'find occurencies of find
Dim As integer found , n , staid , m
Var Lf = Len(find) , Lr = Len(replace) , Lo = Len(original)
Dim As integer x = Len(original) - t * Lf + t * Lr 'length of output string
dim As String res = String(x , 0)            'output string
Do
If original[n] = find[0] Then            'got a possible
For m = 0 To Lf - 1
If original[n + m] <> find[m] Then Goto lbl 'nope
Next m
found = 1                            'Bingo
End If
If found Then
For m = 0 To Lr - 1
res[staid] = replace[m]          'load the replacerment
staid += 1
Next m
n += Lf
found = 0
End If
lbl:
res[staid] = original[n]
staid += 1
n += 1
Loop Until n >= Lo
Return res
End Function

#Include "file.bi"
Sub savefile(filename As String,p As String)
Dim As Integer n
n=Freefile
If Open (filename For Binary Access Write As #n)=0 Then
Put #n,,p
Close
Else
Print "Unable to save " + filename
End If
End Sub
Function loadfile(file as string) as String
If FileExists(file)=0 Then Print file;" not found":Sleep:end
var  f=freefile
Open file For Binary Access Read As #f
Dim As String text
If Lof(f) > 0 Then
text = String(Lof(f), 0)
Get #f, , text
End If
Close #f
return text
end Function

dim as string n1=loadfile("book.htm")

print tally(n1,"hell")
print tally(n1,"Hell")
n1=findandreplace(n1,"hell","heaven")
n1=findandreplace(n1,"Hell","Heaven")
print "Done"
print tally(n1,"hell")
print tally(n1,"Hell")
savefile("NewBook.htm",n1)
print "OK"
sleep

UEZ
Posts: 312
Joined: May 05, 2017 19:59
Location: Germany

Re: CountInString()

Here the function StringCount() returning the occurrence only using RegEx.

Code: Select all

'libpcre.a needed in lib folder!
#Ifdef __Fb_64bit__
#Libpath "lib\win64\"
#Else
#Libpath "lib\win32\"
#Endif

#Define PCRE_STATIC
#Include "pcre.bi"

Function StringRegEx(sPattern As String, sString As String, aArr() As String) As Integer 'coded by UEZ
Const iStrVecCnt = 300

Dim As Zstring Ptr pErrorStr, pSubStrMatchStr
Dim As Long iErrOffset, iRegexExec, aStrVec(iStrVecCnt - 1), iResult = 0, i, j = 0, k = 1
Dim As pcre_extra tRegexStudy
Dim As pcre Ptr pRegexCompiled
Dim As pcre_extra Ptr pRegexStudy

Erase aArr
Redim aArr(0 To iStrVecCnt)

pRegexCompiled = pcre_compile(sPattern, 0, @pErrorStr, @iErrOffset, NULL)
If pRegexCompiled = NULL Then
Return iResult
End If

pRegexStudy = pcre_study(pRegexCompiled, 0, @pErrorStr)
If pRegexStudy = NULL Then
Return iResult
End If

Do
iRegexExec = pcre_exec(pRegexCompiled, pRegexStudy, Strptr(sString), Len(sString), j, 0, @aStrVec(0), iStrVecCnt)
If iRegexExec > 0 Then
For i = 0 To iRegexExec - 1
pcre_get_substring(Strptr(sString), @aStrVec(0), iRegexExec, i, @pSubStrMatchStr)
If k > Ubound(aArr) Then Redim Preserve aArr(0 To (Ubound(aArr) Shr 1))
aArr(k) = *pSubStrMatchStr
k += 1
Next
iResult += 1
j = aStrVec(1)
Endif
Loop Until iRegexExec < 1
Redim Preserve aArr(0 To k - 1)
pcre_free(pRegexCompiled)
#Ifdef PCRE_CONFIG_JIT
pcre_free_study(pRegexStudy)
#Else
pcre_free(pRegexStudy)
#Endif
aArr(0) = Str(iResult)

Return iResult
End Function

Function __ArrayToString(aArr() As String) as String
Dim As String sResult
For i As Integer = 1 To Ubound(aArr)
sResult &= aArr(i) & Chr(10, 13)
Next i
Return sResult
End Function

Function StringCount(sInput As String, sSearch As String, bCaseSensitive As Boolean = False) As String
Dim As String aResult()
If bCaseSensitive Then
If StringRegEx(sSearch, sInput, aResult()) = 0 Then Return "0"
Else
If StringRegEx("(?i)" & sSearch, sInput, aResult()) = 0 Then Return "0"
Endif
Return aResult(0)
End Function

Dim As String sString = "When processing source files, FreeBASIC can parse ASCII files with Unicode escape sequences (\u), or UTF-8, UTF-16LE, UTF-16BE, UTF-32LE and UTF-32BE files, as long as they were saved with Byte Order Mark (BOM)."
? "String to test: "
? sString
?
? "Found all u: " & StringCount(sString, "u")
? "Found U only: " & StringCount(sString, "U", True)
? "Found all UTF: " & StringCount(sString, "UTF")
? "Found numbers only: " & StringCount(sString, "[\d+]+")

Sleep

Output:

Code: Select all

String to test:
When processing source files, FreeBASIC can parse ASCII files with Unicode escape sequences (\u), or UTF-8, UTF-16LE, UT
F-16BE, UTF-32LE and UTF-32BE files, as long as they were saved with Byte Order Mark (BOM).

Found all u: 9
Found U only: 6
Found all UTF: 5
Found numbers only: 5