'====================================================================================================================================
Public Function Str_Extract(ByVal tsSrcString As String, ByVal tsBegDelim As String, ByVal tsEndDelim As String, _
Optional ByVal tiOccurance As Integer = 1, Optional ByVal tiFlag As Integer = 0, _
Optional ByVal tlAddDelims As Boolean = False) As String
'====================================================================================================================================
' Purpose : Extracts a substring from the given string.
' Description : Essentially, a "replica" of the VFP's built-in STREXTRACT() function.
' Calculates starting position and length of the substring to be extracted based on starting positions and lengths
' of the given starting and ending delimiters, applying the CompareMethod. Then uses the VB's built-in Mid() function
' for string extraction.
' Returns : Extracted substring as String.
' If the given Source string is empty - returns empty string.
' If the starting delimiter is empty String - extracts the left part of the given string till the starting position
' of the ending delimiter.
' If the ending delimiter is empty String - extracts the right part of the given string beginning on the ending
' position of the starting delimiter.
' If both starting and ending delimiters are empty strings - returns the entire given source string.
' Side effects : None.
' Notes : 1. Generic.
' 2. Complies with .NET Framework ver. 1.1 and higher.
' 3. Verbose on errors, silent otherwise.
' format - remains on the calling prog's "conscience".
' Author : Ilya I. Rabyy
' Revisions : 2020-06-01 by Ilya – completed 1st draft.
' by Ilya on 2022-07-06 to add delimiters into returned string, if requested.
'====================================================================================================================================
Dim lsRetStr As String = ""
' Parameters' verification / validation
' ComparisonMethod flag: can be either 0 (case-sensitive comparison) or 1 (case-insensitive comparison)
If tiFlag > 0 Then
tiFlag = 1
End If
' Occurance
If tiOccurance <= 0 Then
Return lsRetStr
End If
' Given Source string
If IsNothing(tsSrcString) Then
Return lsRetStr
ElseIf tsSrcString.Trim() = "" Then
Return lsRetStr
End If
Dim liSrcLen As Integer = Len(tsSrcString), liStartPos As Integer = 0, liRetLength As Integer = 0
' Starting and ending delimiters, Starting one's 1st
If IsNothing(tsBegDelim) Then
liStartPos = 1
ElseIf tsBegDelim = "" Then
liStartPos = 1
ElseIf tiOccurance > 1 Then
liStartPos = 1
For liCnt As Integer = 1 To tiOccurance
liStartPos = InStr(liStartPos, tsSrcString, tsBegDelim, tiFlag) + Len(tsBegDelim)
Next 'liCnt
Else
liStartPos = InStr(1, tsSrcString, tsBegDelim, tiFlag) ' + Len(tsBegDelim)
' Since the given starting delimiter might not be found...
If liStartPos = 0 Then
Return lsRetStr
Else
liStartPos = liStartPos + Len(tsBegDelim)
End If ' liStartPos = 0
End If 'IsNothing(tsBegDelim)
' Ending delimiter
If IsNothing(tsEndDelim) Then
liRetLength = liSrcLen - liStartPos + 1
ElseIf tsEndDelim = "" Then
liRetLength = liSrcLen - liStartPos + 1
ElseIf InStr(1, tsSrcString, tsEndDelim, tiFlag) = 0 Then
Return lsRetStr
Else
liRetLength = InStr(liStartPos, tsSrcString, tsEndDelim, tiFlag) - liStartPos
liRetLength = InStr(liStartPos + 1, tsSrcString, tsEndDelim, tiFlag) - liStartPos
End If 'IsNothing(tsEndDelim)
' If we came to this point - everything's kosher, we can extract the string
lsRetStr = Mid(tsSrcString, liStartPos, liRetLength)
'************************************************************************************************************************************
'****************** Next code was added by Ilya on 2022-07-06 to add delimiters into returned string, if requested ******************
If tlAddDelims Then
lsRetStr = tsBegDelim & lsRetStr & tsEndDelim
End If
'******************* End of code added by Ilya on 2022-07-06 to add delimiters into returned string, if requested *******************
'************************************************************************************************************************************
Return lsRetStr
End Function
'====================================================================================================================================
'====================================================================================================================================
Public Function GetChrCount(Optional ByVal tcChar As String = "", Optional ByVal tcStr As String = "", _
Optional tlCaseSensitive As Boolean = False) As Integer
'====================================================================================================================================
' Purpose : Counts the occurances of the given Character in the given String.
' Description : If any of the two optional parameters is blank - returns zero.
' Goes char-by-char through the given parameter-string counting given char parameter's occurances.
' Parameters : Sought Character as String;
' Searched string as String.
' Returns : Number of occurances of the given Character in the given String.
' Side effects : None.
' Notes : 1. Generic, applies to .NET Framework ver. 1.1, .NET Core 1.0, .NET Standard 1.0 and higher.
' 2. Silent.
' 3. If tcChar contains more than one character - it's truncated to the 1st one.
' Author : Ilya I. Rabyy
' Revisions : 2020-08-13 by Ilya – started 1st draft.
' 2022-02-04 by Ilya - made standard one.
' 2022-02-15 by Ilya - section was added to check if the given String contains the sought Char at all.
'====================================================================================================================================
Dim lnRet As Integer = 0
' Parameters' validation
If tcChar = "" Or tcStr = "" Then
MsgBox("Blank String(s) argument(s) aren't allowed!", MsgBoxStyle.Information, "Function GetChrCount(): invalid parameter(s)")
Return lnRet
End If
If Len(tcChar) > 1 Then
tcChar = Left(tcChar, 1)
End If
'************************************************************************************************************************************
'************ Next section was added by Ilya on 2022-02-15 to check if the given String contains the sought Char at all *************
If Not tcStr.Contains(tcChar) Then Return lnRet
'************** End of section added by Ilya on 2022-02-15 to check if the given String contains the sought Char at all *************
'************************************************************************************************************************************
Dim lcChar As String, liCnt As Integer
For liCnt = 1 To Len(tcStr)
lcChar = Mid(tcStr, liCnt, 1)
lcChar = IIf(tlCaseSensitive, lcChar, lcChar.ToUpper())
If lcChar = tcChar.ToUpper() Then
lnRet += 1
End If
Next liCnt
Return lnRet
End Function
'====================================================================================================================================