## CountInString()

dodicat
Posts: 5980
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 countEnd FunctionFunction 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 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 resEnd 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 IfEnd SubFunction 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 textend Functiondim 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: 337
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 iResultEnd FunctionFunction __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 sResultEnd FunctionFunction 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 FunctionDim 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, UTF-16BE, UTF-32LE and UTF-32BE files, as long as they were saved with Byte Order Mark (BOM).Found all u: 9Found U only: 6Found all UTF: 5Found numbers only: 5`