Testing Vb Regular Expression Functions

[Gary]

'---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