Extrapolate a certain part of a string that may be inside parentheses or quotation marks

[exagonx]

In this period I came up with a project where using some functions created for old programs you can analyze strings and be able to perform certain tasks via scripting language without compiling the source, it's a lot of work and I personally publish the sources of these functions I don't know if there is an alternative way in FreeBASIC, perhaps one that involves better use of the CPU and reduces execution times, I'm currently using this method, maybe someone can suggest something better, otherwise they are some useful functions that do the their work.

example.bas

Code: Select all

#include "quotes.bas"

dim MyText as string

MyText = "Whe ave a big string {'This is a message with' " & DQuote & "this is inside double Quotes" & DQuote & " }"

print MyText

print "How Many Quotes " & DQuote & " ? " & str(QUOTES_COUNT(MyText, DQuote))

print "Extracted text with Double Quotes    = " & QUOTES_RETRIVE(MyText, DQuote,0,1)
print "Extracted text without Double Quotes = " & QUOTES_RETRIVE(MyText, DQuote)
print " "
print "Extracted text with Quotes   = " & QUOTES_RETRIVE(MyText, SQuote,0,1)
print "Extracted text without Quotes = " & QUOTES_RETRIVE(MyText, SQuote)
print " "
Print "Extracted text inside Bracket = " & BRACKET_CONTENT(MyText, 3)
sleep 

quotes.bas

Code: Select all

'declare function QUOTES_COUNT(ByVal BufferString as String, ByVal CharQuotes as String)As String 
Const DQuote = chr(34)
Const SQuote = chr(39)
Const RBracketO = "("
Const SBracketO = "["
Const GBracketO = "{"
Const GBracketC = "}"
Const SBracketC = "]"
Const RBracketC = ")"

Function BRACKET_CONTENT(ByVal BufferString As String, ByVal BracketType As Integer, ByVal BracketLevel As Integer = 1)as String 
	Dim As Integer StringLength = 0, Cicle = 0, OpenCount = 0, CloseCount = 0
	Dim As String SingleChar = "", ContentBuffer = "", BracketOpen = "", BracketClose = ""
	
	'Reads the number of characters contained in the variable
	StringLength = Len(BufferString)
	
	'Assigns the type of opening and closing brackets
	Select Case BracketType
		Case 1
			BracketOpen = RBracketO
			BracketClose = RBracketC
		Case 2
			BracketOpen = SBracketO
			BracketClose = SBracketC
		Case 3
			BracketOpen = GBracketO
			BracketClose = GBracketC
		Case Else
			BracketOpen = "<"
			BracketClose = ">"
	End Select
	
	
	'Start reading by character to find the opening and closing parentheses
	For Cicle = 1 to StringLength Step 1 
			SingleChar = Mid(BufferString,Cicle,1)
			If SingleChar = BracketOpen Then 
				OpenCount = OpenCount + 1
				If BracketLevel <= OpenCount Then
					ContentBuffer = ContentBuffer  & SingleChar
					SingleChar = ""
				End If
			End If
			
			If SingleChar = BracketClose Then
				CloseCount = CloseCount + 1
				If BracketLevel <= ( ( OpenCount - CloseCount ) + 1 ) Then
					ContentBuffer = ContentBuffer  & SingleChar
					SingleChar = ""
				End If
			End if
				
			If  OpenCount >= BracketLevel AND ( OpenCount - CloseCount ) >= BracketLevel Then 
	
				ContentBuffer = ContentBuffer  & SingleChar
			End If
	
	Next Cicle

	
	'Based on the specified level, the function will produce the extracted output
	Return ContentBuffer
End Function

function QUOTES_COUNT(ByVal BufferString as String, ByVal CharQuotes as String)As Integer 
	'This function counts the character specified through the FOR loop
	dim as integer StringLength = 0, QuotesCount = 0, Cicle = 0
	dim as string RetriveChar = ""
	
	StringLength = len(BufferString)
	
	
	for Cicle = 1 to StringLength step 1
			RetriveChar = MID(BufferString, Cicle, 1)
			
			If RetriveChar = CharQuotes then
				QuotesCount = QuotesCount + 1
			end if
			
	next Cicle
	
	Return QuotesCount
end function

function QUOTES_RETRIVE(ByVal BufferString as String, ByVal CharQuotes as String = chr(34), ByVal BlockNum as Integer = 0, ByVal WithChar as Integer = 0)As String
	dim as integer StringLength =  0, Cicle = 0, OpenBlock = 0, CurrentBlock = 0
	dim as string SingleChar = "", OutSelectedBuffer = ""
	dim BlockBuffer(15) as string
	
	'Using a For Loop assigns characters after reading the specified 
	'character and continues assigning them until it finishes the string or 
	'encounters the specified character again.
	
	StringLength = Len(BufferString)
	for Cicle = 1 to StringLength step 1
		SingleChar = Mid(BufferString, Cicle, 1)
		
		if SingleChar = CharQuotes then
			if OpenBlock = 0 then 
				OpenBlock = 1
			else 
				OpenBlock = 0
				CurrentBlock = CurrentBlock + 1
			end if
		else
			If OpenBlock = 1 then
				BlockBuffer(CurrentBlock) = BlockBuffer(CurrentBlock) & SingleChar
			end if
		end if
		
		
	next Cicle
	
	if WithChar = 1 then
		OutSelectedBuffer = CharQuotes & BlockBuffer(BlockNum) & CharQuotes
	else 
		OutSelectedBuffer = BlockBuffer(BlockNum)	
	end if
	
	Return OutSelectedBuffer
end function

I fixed the Cicle FOR because during Copy and Past I miss something