Gary
27-08-2023, 21:23
'---Script created on 08-27-2023 11:59:24 by
uses "VBREGEXP"
Uses "Console"
uses "File"
'pbHelpFile() 'works
'AlternateSpelling() ' working
'PhoneNumbers() ' working
'FindEachWordInString() 'working
'ThreewayAlternation() 'working
'RegExprLineInput() 'working
'CompressSpaces() 'working
'ReplaceEachWordInStringWithplural() 'working
'ParseCSVFile() 'working
FindAllComments_InSourceCode() 'working
function FindAllComments_InSourceCode()
dim TheFile as string
dim FileData as string
dim mask as string
dim startvar as long
dim posVar as long
dim lenvar as long
dim retFromReg as string
TheFile = "C:\thinBasic\SampleScripts\regularExpression.tbasic"
FileData = File2Text(TheFile)
dim comments as string
Mask = "'[\x20]*[A-Za-z0-9 ]*"
vbregex(mask, fileData)
Console_WaitKey
end function
function ParseCSVFile()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
dim FileData as string
' file in: "Value","value", "value",crlf, "value", "value", "value", Crlf.....
FileData = $Dq & "Smith" & $Dq & "," & $Dq & "John" & $Dq & "," & $Dq & "555-1234" & $Dq & $CrLf & _
$Dq & "Doe" & $Dq & "," & $Dq & "Jane" & $Dq & "," & $Dq & "555-6789" & $Dq & $CrLf & _
$Dq & "Brown" & $Dq & "," & $Dq & "Willie" & $Dq & "," & $Dq & "555-8765" & $Dq & $CrLf
Dim WordMask As String
Mask = "\q(.*)\q"
Print mask + $crlf
Print FileData + $crlf
Print "*** END OF FILEDATA OF LEN=" & Str$(Len(FileData)) & "***" +$crlf
vbregex(mask, fileData)
Console_WaitKey
Print Filedata ' show the modified file
end function
function ReplaceEachWordInStringWithplural()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim Main As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain2 As String
Dim ReplaceMask As String
dim retFromReg as string
dim newRetFromReg as string
Main = "Now is the time for all good men" & $CrLf
'Find each word in a string WORKS 9/17/99 even with embedded spaces, CRLF is an undocumented word boundary
mask = "([A-Za-z]+)" ' not working
Print mask + $crlf
Main = "Now is the time for all good men" & $CrLf
print main
ReplaceMask = "$1"+"s" ' for each word, append an 's'
vbregReplace(mask,Main,ReplaceMask )
Console_WaitKey
end function
function CompressSpaces()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
dim retFromReg as string
TheMain = " The color of the leaves is more brilliant than the colour of the television."
Mask = "\x20[\x20]+" ' find space followed by one or more spaces
'mask =chgRe(mask)
'Print mask + $crlf
print theMain + $crlf
ReplaceMask = " " ' replace with a single space.
vbregReplace(mask,TheMain,ReplaceMask )
Console_WaitKey
end function
function vbregReplace(pattern as string,txt as string,replaceTxt as string )
dim lpRegExp as dword
'dim txt as string value "The quick brown fox jumped over the lazy dog."
dim strRetVal as string
'---Allocate a new regular expression instance
lpRegExp = VBREGEXP_New
'---Check if it was possible to allocate and if not stop the script
if isfalse lpRegExp then
print "Unable to create an instance of the RegExp object." & $crlf & "Script terminated"
stop
end if
'---Set case insensitivity
VBREGEXP_SetIgnoreCase lpRegExp, -1
'---Set global applicability
VBREGEXP_SetGlobal lpRegExp, -1
'---Replace example 1
'---Replace 'fox' with 'cat'.
VBREGEXP_SetPattern lpRegExp, pattern
strRetVal = VbRegExp_Replace(lpRegExp, txt, replaceTxt )
print strRetVal+$crlf
'---Replace example 2
'---In addition, the Replace method can replace subexpressions in the pattern.
'---The following swaps the first pair of words in the original string:
'VBREGEXP_SetPattern lpRegExp, "(\S+)(\s+)(\S+)"
'strRetVal = VbRegExp_Replace(lpRegExp, txt, "$3$2$1")
'print strRetVal+$crlf
'---Deallocate regular expression resource
IF istrue lpRegExp THEN VBREGEXP_Release(lpRegExp)
end function
Function File2Text(sfn As String) As String
Dim st As String
Dim n As Long
Dim FileHandle As DWORD,s as string
FileHandle= FILE_OPEN(sfn, "INPUT")
while not FILE_EOF(FileHandle)
s=FILE_LineInput(FileHandle)
st=st+s+$crlf
wend
s = FILE_Close(FileHandle)
Function=st
End Function
function RegExprLineInput()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
Dim TheFile as string,FileData as string
TheFile = "C:\thinBasic\SampleScripts\vbreg.tbasic"
FileData = File2Text(TheFile)
'Print "Size of file is " & Str$(Len(FileData))
Mask = "\n"
vbregex(mask, FileData)
Console_WaitKey
end function
function ThreewayAlternation()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
TheMain = " Two is too many to do the job "
Mask = "(too)|(to)|(two)\b" ' did not find too(9), but did find to (18) and Two (2) BUGBUGBUG
vbregex(mask, theMain)
Console_WaitKey
end function
function FindEachWordInString()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
TheMain = " Now is the time for all good men" & $CrLf & "to come to the aid of his party."
Let mask = "[a-zA-z]*\b" ' \b = word boundary. CRLF is (undocumented) word boundary
Print mask
PosVar = 1: StartVar = 1
vbregex(mask, theMain)
Console_WaitKey
end function
Function PhoneNumbers()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
Mask = "\([0-9]{0,3}\)-[0-9]{0,3}-[0-9]{0,4}"
Print mask
TheMain = " call me at (900)-123-4567"
vbregex(mask, theMain)
Console_WaitKey
end function
function AlternateSpelling()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
Mask = "colo[u]?r" ' a 'u' in the indicated position is optional
TheMain = " The color of the leaves is more brilliant than the colour of the television."
' INPUT: TheMain, Mask. OUTPUT: multiple REGEXPR results
PosVar = 1: StartVar = 1
vbregex(mask, theMain)
Console_WaitKey
end function
function PBHelpFile()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
TheMain = "Send your comments to BASICally Speaking at bsp@infoms.com"
Mask = "[a-z_.-]+@[a-z_.-]+"
'Mask = "[html]+@[html]+"
dim nStart as long,s as string
nStart=1
Print mask
'mask =chgRe(mask)
'Print mask
vbregex(mask, theMain)
'REGEXPR$(Mask, TheMain, startvar, PosVar, LenVar)
'RegExpr Mask In TheMain To PosVar, LenVar
'Print "REGEXPR returns:" & Mid$(TheMain, PosVar, lenVar)
Console_WaitKey
End Function
function vbregex(pattern as string, txt as string)
dim lpRegExp as dword
dim lpMatches as dword
dim lpMatch as dword
dim strValue as string
'---Allocate a new regular expression instance
lpRegExp = VBREGEXP_New
'---Check if it was possible to allocate and if not stop the script
if isfalse lpRegExp then
Print "Unable to create an instance of the RegExp object." & $crlf & "Script terminated" + $crlf
stop
end if
'---Set pattern
VBREGEXP_SetPattern lpRegExp, pattern '"[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
'---Set case insensitivity
VBREGEXP_SetIgnoreCase lpRegExp, -1
'---Set global applicability
VBREGEXP_SetGlobal lpRegExp, -1
'---Execute search '"Please send a mail to eros.olmi@thinbasic.com or to <support@thinbasic.com>. Thanks!"
lpMatches = VBREGEXP_Execute(lpRegExp, txt)
IF ISFALSE lpMatches THEN
Print "1. No match found"
else
dim nCount as long value VBMatchCollection_GetCount(lpMatches)
IF nCount = 0 THEN
Print "2. No match found" + $crlf
else
'---Iterate the Matches collection
dim I as long
strValue += "Total matches found: " & nCount & $CRLF & string$(50, "-") & $crlf
FOR i = 1 TO nCount
lpMatch = VBMatchCollection_GetItem(lpMatches, i)
IF ISFALSE lpMatch THEN EXIT FOR
strValue += "Match number " & i & " found at position: " & VBMatch_GetFirstIndex(lpMatch) & " length: " & VBMatch_Getlength(lpMatch) & $CRLF
strValue += "Value is: " & VBMatch_GetValue(lpMatch) & $CRLF
strValue += "--------------" & $CRLF
VBREGEXP_Release lpMatch
NEXT
Print strValue + $crlf
END IF
END IF
IF istrue lpMatches THEN VBREGEXP_Release(lpMatches)
IF istrue lpRegExp THEN VBREGEXP_Release(lpRegExp)
end function
uses "VBREGEXP"
Uses "Console"
uses "File"
'pbHelpFile() 'works
'AlternateSpelling() ' working
'PhoneNumbers() ' working
'FindEachWordInString() 'working
'ThreewayAlternation() 'working
'RegExprLineInput() 'working
'CompressSpaces() 'working
'ReplaceEachWordInStringWithplural() 'working
'ParseCSVFile() 'working
FindAllComments_InSourceCode() 'working
function FindAllComments_InSourceCode()
dim TheFile as string
dim FileData as string
dim mask as string
dim startvar as long
dim posVar as long
dim lenvar as long
dim retFromReg as string
TheFile = "C:\thinBasic\SampleScripts\regularExpression.tbasic"
FileData = File2Text(TheFile)
dim comments as string
Mask = "'[\x20]*[A-Za-z0-9 ]*"
vbregex(mask, fileData)
Console_WaitKey
end function
function ParseCSVFile()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
dim FileData as string
' file in: "Value","value", "value",crlf, "value", "value", "value", Crlf.....
FileData = $Dq & "Smith" & $Dq & "," & $Dq & "John" & $Dq & "," & $Dq & "555-1234" & $Dq & $CrLf & _
$Dq & "Doe" & $Dq & "," & $Dq & "Jane" & $Dq & "," & $Dq & "555-6789" & $Dq & $CrLf & _
$Dq & "Brown" & $Dq & "," & $Dq & "Willie" & $Dq & "," & $Dq & "555-8765" & $Dq & $CrLf
Dim WordMask As String
Mask = "\q(.*)\q"
Print mask + $crlf
Print FileData + $crlf
Print "*** END OF FILEDATA OF LEN=" & Str$(Len(FileData)) & "***" +$crlf
vbregex(mask, fileData)
Console_WaitKey
Print Filedata ' show the modified file
end function
function ReplaceEachWordInStringWithplural()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim Main As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain2 As String
Dim ReplaceMask As String
dim retFromReg as string
dim newRetFromReg as string
Main = "Now is the time for all good men" & $CrLf
'Find each word in a string WORKS 9/17/99 even with embedded spaces, CRLF is an undocumented word boundary
mask = "([A-Za-z]+)" ' not working
Print mask + $crlf
Main = "Now is the time for all good men" & $CrLf
print main
ReplaceMask = "$1"+"s" ' for each word, append an 's'
vbregReplace(mask,Main,ReplaceMask )
Console_WaitKey
end function
function CompressSpaces()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
dim retFromReg as string
TheMain = " The color of the leaves is more brilliant than the colour of the television."
Mask = "\x20[\x20]+" ' find space followed by one or more spaces
'mask =chgRe(mask)
'Print mask + $crlf
print theMain + $crlf
ReplaceMask = " " ' replace with a single space.
vbregReplace(mask,TheMain,ReplaceMask )
Console_WaitKey
end function
function vbregReplace(pattern as string,txt as string,replaceTxt as string )
dim lpRegExp as dword
'dim txt as string value "The quick brown fox jumped over the lazy dog."
dim strRetVal as string
'---Allocate a new regular expression instance
lpRegExp = VBREGEXP_New
'---Check if it was possible to allocate and if not stop the script
if isfalse lpRegExp then
print "Unable to create an instance of the RegExp object." & $crlf & "Script terminated"
stop
end if
'---Set case insensitivity
VBREGEXP_SetIgnoreCase lpRegExp, -1
'---Set global applicability
VBREGEXP_SetGlobal lpRegExp, -1
'---Replace example 1
'---Replace 'fox' with 'cat'.
VBREGEXP_SetPattern lpRegExp, pattern
strRetVal = VbRegExp_Replace(lpRegExp, txt, replaceTxt )
print strRetVal+$crlf
'---Replace example 2
'---In addition, the Replace method can replace subexpressions in the pattern.
'---The following swaps the first pair of words in the original string:
'VBREGEXP_SetPattern lpRegExp, "(\S+)(\s+)(\S+)"
'strRetVal = VbRegExp_Replace(lpRegExp, txt, "$3$2$1")
'print strRetVal+$crlf
'---Deallocate regular expression resource
IF istrue lpRegExp THEN VBREGEXP_Release(lpRegExp)
end function
Function File2Text(sfn As String) As String
Dim st As String
Dim n As Long
Dim FileHandle As DWORD,s as string
FileHandle= FILE_OPEN(sfn, "INPUT")
while not FILE_EOF(FileHandle)
s=FILE_LineInput(FileHandle)
st=st+s+$crlf
wend
s = FILE_Close(FileHandle)
Function=st
End Function
function RegExprLineInput()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
Dim TheFile as string,FileData as string
TheFile = "C:\thinBasic\SampleScripts\vbreg.tbasic"
FileData = File2Text(TheFile)
'Print "Size of file is " & Str$(Len(FileData))
Mask = "\n"
vbregex(mask, FileData)
Console_WaitKey
end function
function ThreewayAlternation()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
TheMain = " Two is too many to do the job "
Mask = "(too)|(to)|(two)\b" ' did not find too(9), but did find to (18) and Two (2) BUGBUGBUG
vbregex(mask, theMain)
Console_WaitKey
end function
function FindEachWordInString()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
TheMain = " Now is the time for all good men" & $CrLf & "to come to the aid of his party."
Let mask = "[a-zA-z]*\b" ' \b = word boundary. CRLF is (undocumented) word boundary
Print mask
PosVar = 1: StartVar = 1
vbregex(mask, theMain)
Console_WaitKey
end function
Function PhoneNumbers()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
Mask = "\([0-9]{0,3}\)-[0-9]{0,3}-[0-9]{0,4}"
Print mask
TheMain = " call me at (900)-123-4567"
vbregex(mask, theMain)
Console_WaitKey
end function
function AlternateSpelling()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
Mask = "colo[u]?r" ' a 'u' in the indicated position is optional
TheMain = " The color of the leaves is more brilliant than the colour of the television."
' INPUT: TheMain, Mask. OUTPUT: multiple REGEXPR results
PosVar = 1: StartVar = 1
vbregex(mask, theMain)
Console_WaitKey
end function
function PBHelpFile()
Dim Mask As String, posvar As Long, lenvar As Long, startvar As Long
Dim Mask2 As String
Dim TheMain As String ' 'MAIN' IS AN UNDOCUMENTED KEYWORD
Dim TheWord As String
Dim NewMain As String
Dim ReplaceMask As String
TheMain = "Send your comments to BASICally Speaking at bsp@infoms.com"
Mask = "[a-z_.-]+@[a-z_.-]+"
'Mask = "[html]+@[html]+"
dim nStart as long,s as string
nStart=1
Print mask
'mask =chgRe(mask)
'Print mask
vbregex(mask, theMain)
'REGEXPR$(Mask, TheMain, startvar, PosVar, LenVar)
'RegExpr Mask In TheMain To PosVar, LenVar
'Print "REGEXPR returns:" & Mid$(TheMain, PosVar, lenVar)
Console_WaitKey
End Function
function vbregex(pattern as string, txt as string)
dim lpRegExp as dword
dim lpMatches as dword
dim lpMatch as dword
dim strValue as string
'---Allocate a new regular expression instance
lpRegExp = VBREGEXP_New
'---Check if it was possible to allocate and if not stop the script
if isfalse lpRegExp then
Print "Unable to create an instance of the RegExp object." & $crlf & "Script terminated" + $crlf
stop
end if
'---Set pattern
VBREGEXP_SetPattern lpRegExp, pattern '"[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
'---Set case insensitivity
VBREGEXP_SetIgnoreCase lpRegExp, -1
'---Set global applicability
VBREGEXP_SetGlobal lpRegExp, -1
'---Execute search '"Please send a mail to eros.olmi@thinbasic.com or to <support@thinbasic.com>. Thanks!"
lpMatches = VBREGEXP_Execute(lpRegExp, txt)
IF ISFALSE lpMatches THEN
Print "1. No match found"
else
dim nCount as long value VBMatchCollection_GetCount(lpMatches)
IF nCount = 0 THEN
Print "2. No match found" + $crlf
else
'---Iterate the Matches collection
dim I as long
strValue += "Total matches found: " & nCount & $CRLF & string$(50, "-") & $crlf
FOR i = 1 TO nCount
lpMatch = VBMatchCollection_GetItem(lpMatches, i)
IF ISFALSE lpMatch THEN EXIT FOR
strValue += "Match number " & i & " found at position: " & VBMatch_GetFirstIndex(lpMatch) & " length: " & VBMatch_Getlength(lpMatch) & $CRLF
strValue += "Value is: " & VBMatch_GetValue(lpMatch) & $CRLF
strValue += "--------------" & $CRLF
VBREGEXP_Release lpMatch
NEXT
Print strValue + $crlf
END IF
END IF
IF istrue lpMatches THEN VBREGEXP_Release(lpMatches)
IF istrue lpRegExp THEN VBREGEXP_Release(lpRegExp)
end function