Long time no talkie on this forum.
Had some free time, wife had mouth surgery and i brought my laptop.
I indentified and resolved 3 different bugs in just the GUI portion of the code.
Code cleanup and optimization.
Feel free to contact me with suggestions or any quesitons.
<html>
<head>
<title>Regex Tester</title>
<HTA:APPLICATION
icon = "c:\icons\hate.ico"
Caption = "yes"
Version = "3.0"
/>
<!-- Author : Mike D Adams [email=michael.david.adams@gmail.com]michael.david.adams@gmail.com[/email]
Thanks to Jared Franklin for the submatches portion.
Thanks to all the suggestion and help from the users of the visualbasicscript.com forums
2007/01/19
- Added prompt for over-writing of files for
- Templates and settings save.
- Added load file boolean check. Now throws error in html.
- Added icon to over-write prompt
- Cleaned excessive if's from fileLoader subroutine
- Updated template wording to make more sense
- Started to fix tab issues with code layout.
- Version jump to 3.0
2006/07/25
- Added tool-tips on text areas for exp and string
- Changed the color of all text areas to match the "theme" of the app
2006/07/24
- fixed some issues in the text processing portion (load/unload files)
- Added Tooltips for almost all buttons
- Disabled other file options once you have one selected
- Renamed close button to hide. Clarity sake
- Changed the file text to blue w\ a size of +1
- Added tooltips to the checkboxes
- Jumped version number to 2.5 (from 2.0)
-->
<script language="VBScript">
'#################### Start VBScript Section ####################
''= refreshes the HTA page, which includes re-running any Windows_Onload code
'' ============================================================================
Sub reloadHTA()
location.reload( True )
End Sub
'Sub to Run when Test RegEx button is pressed
sub cmdTextBox
dim string1, Re,s,colMatches,Test,ResultArr()
'Configure Regular Expression
set Re = new RegExp
Re.Pattern = ExprStrin.TextBox.value
' Error if pattern is blank
if Re.Pattern = "" Then
strError = "<font color=red>Please enter a Regular Expression!</font>"
DataAr1.InnerHTML = strError
SubAr1.InnerHTML = strError
strError = ""
'Move on pattern is not blank
else
If ExprStrin.GlobalCheckBox.checked Then 'Set Global attribute according to checkbox
Re.Global = true
Else
Re.Global = false
End If
If ExprStrin.caseCheckbox.checked Then 'Set IgnoreCase attribute according to checkbox
Re.IgnoreCase = True
Else
Re.IgnoreCase = False
End If
If ExprStrin.MultilineCheckBox.checked Then 'Set Multiline attribute according to checkbox
Re.Multiline = True
Else
Re.Multiline = False
End If
s = ExprStrin.StringBox.value
'Error if string to search is blank
if s = "" Then
strError = "<font color=red>Search String cannot be left blank!</font>"
DataAr1.InnerHTML = strError
SubAr1.InnerHTML = strError
strError = ""
' Test regex if string is not blank
else
'If a match is found...
if Re.Test(s) then
'Collect and Output Matches
Set colMatches = Re.Execute(s)
counter = 0
numMatches = colMatches.count
for each Test in colMatches
ReDim Preserve ResultArr(counter + 1)
ResultArr(counter) = Test.value
counter = counter + 1
next
dim tempstring
for count2 = 0 to counter - 1
tempstring = tempstring & "<b>Match " & count2+1 & ": </b>" & ResultArr(count2) & "<br>"
next
DataAr1.InnerHTML = "<b>The following matches were found:</b><br>" & tempstring
'Collect SubMatches and Store them in a String
subMatchesString = ""
For i=0 to numMatches-1 'Loop through each match
Set myMatch = colMatches(i)
numSubMatches = myMatch.submatches.count
If numSubMatches > 0 Then 'Loop through each submatch in current match
subMatchesString = subMatchesString & "<b>Submatches for Match " & i+1 & "</b><br>"
For j=0 to numSubMatches-1
subMatchesString = subMatchesString & myMatch.SubMatches(j) & "<br>"
Next
End If
Next
'Output submatches to correct field
SubAr1.InnerHTML = subMatchesString
'If no match is found output error and sub strings
else
DataAr1.InnerHTML = "No match was found for the regular expression."
'ClearSubs
end if
end if
end if
'Clear things up
Set Re = Nothing
Set colMatches = nothing
end sub
'Sub to Run when Clear Results and submatches when button is pressed
sub ClearDataAr1
DataAr1.InnerHTML = "Results Cleared!"
SubAr1.InnerHTML = "Results Cleared!"
end sub
sub loadfiles
retVal = "<input type=file name=xmlname> <br> <input type=button value=Assimilate onclick=fileLoader Title=""Click to load settings into App"">"
Loader.InnerHTML = retVal
ExprStrin.Saver.disabled = True
ExprStrin.Templ2.Disabled = True
exprstrin.xmlname.style.backgroundcolor = "C0C0C0"
end sub
sub CloseFile
Loader.InnerHTML = ""
Loader2.InnerHTML = ""
ExprStrin.Loader.Disabled = False
ExprStrin.Saver.disabled = False
ExprStrin.Templ2.Disabled = false
end sub
sub fileLoader
set fileObj = CreateObject("Scripting.FileSystemObject")
if ExprStrin.xmlname.value = "" then
Loader2.InnerHTML= "<font color=red>Enter a filename</font>"
else
file = ExprStrin.xmlname.value
end if
if fileObj.FileExists(file) then
set objStream = fileObj.OpenTextFile (file, _
1,false,0)
opened = true
else
Loader2.InnerHTML= "<font color=red size=+1>File not found</font>"
opened = false
end if
if opened then
Loader2.InnerHTML= ""
contents = ObjStream.Readall
contents2 = split(contents,"-------")
expr = Replace(contents2(0),VbnewLine,"")
if instr(len(contents2(1))-1,contents2(1),vbnewline) then
stringer = Left(cstr(contents2(1)),len(cstr(contents2(1)))-2)
stringer = right(stringer,len(stringer) -2 )
else
Stringer = contents2(1)
end if
ig = Replace(contents2(2),vbnewline,"")
gs = Replace(contents2(3),vbnewline,"")
ml = Replace(contents2(4),vbnewline,"")
BoolOpts = CheckBData(ig,gs,ml)
if len(BoolOpts) > 0 then
Loader2.InnerHTML = BoolOpts
expr =""
stringer = ""
ig = ""
gs = ""
ml = ""
else
'Set hta vars back to loaded values
ExprStrin.TextBox.value = expr
ExprStrin.StringBox.value = Stringer
ExprStrin.caseCheckbox.checked = ig
ExprStrin.GlobalCheckBox.Checked = gs
ExprStrin.MultilineCheckBox.checked = ml
end if
end if
set fileObj = Nothing
End sub
Function CheckBdata (Ignore,Global,Multi)
'msgbox Instr(1,ignore,"t",1) & " , " & Instr(1,ignore,"f",1)
if Instr(1,Ignore,"t",1) > 0 and Instr(1,Ignore,"f",1) > 0 then
retval = "Ignore case value is not boolean <br>"
end if
if Instr(1,Global,"t",1) > 0 and Instr(1,Global,"f",1) > 0 then
retval = retval & "Global search value is not boolean <br>"
end if
if Instr(1,Multi,"t",1) > 0 and Instr(1,Multi,"f",1) > 0 then
retval = retval & "Multi-line value is not boolean <br>"
end if
if len(retval) > 0 then
retval = "<font color=red>" & retval & "</font>"
end if
CheckBdata = Retval
End function
sub TmpInner
Loader2.InnerHTML = ""
Loader.InnerHTML= "Enter a filename for template<br>" & _
"<input type=""Text"" ""id=Templ"" name=""Templ"" value="""">" & _
"<input type=""Button"" value=""Save"" onClick=""SaveTmpl"" Title=""Click after entering filename for template to be created"">"
ExprStrin.Loader.Disabled = true
ExprStrin.Saver.disabled = true
ExprStrin.Templ.style.backgroundcolor = "C0C0C0"
end sub
sub SaveTmpl
set fileObj = CreateObject("Scripting.FileSystemObject")
file = ExprStrin.Templ.value
if file = "" then
Loader2.InnerHTML = "<font color=red size=+1>Enter a FileName</font>"
else
if not (fileObj.FileExists(file)) then
Loader2.InnerHTML = "File not found. Creating now"
set file2 = fileObj.CreateTextFile(file)
else
Result = msgbox ("Would you like to over-write the file?",33,"Over-write file prompt")
if Result = vbOK then
Loader2.InnerHTML = "Over-writing now!"
set file2 = fileObj.CreateTextFile(file,True)
file2.writeline ("'Remove this line and put regular expression here")
file2.WriteLine ("-------")
file2.WriteLine ("'Remove this line and enter in string.. Can be multi line")
file2.WriteLine ("-------")
file2.WriteLine ("'Remove this line. Enter boolean of Ignore case value")
file2.WriteLine ("-------")
file2.WriteLine ("'Remove this line. Enter boolean of Global Search value ")
file2.WriteLine ("-------")
file2.WriteLine ("'Remove this line. Enter boolean of Multi-Line value")
file2.close
elseif Result = vbCancel then
Loader2.InnerHTML = "File existed. File operation canceled"
end if
end if
end if
set fileObj = nothing
end sub
sub SaveSets
Loader2.InnerHTML = ""
'load txtbox for save value
Loader.InnerHTML= "Enter a filename to save<br>" & _
"<input type=""Text"" ""id=Templ"" name=""Templ"" value="""">" & _
"<input type=""button"" value=""Save"" onclick=""SaveSets2"" Title=""Click after entering a filename to save"">"
ExprStrin.Loader.Disabled = True
ExprStrin.Templ2.Disabled = True
ExprStrin.Templ.style.backgroundcolor = "C0C0C0"
end sub
sub SaveSets2
set fileObj = CreateObject("Scripting.FileSystemObject")
file = ExprStrin.Templ.value
'open file for writing
if file = "" then
Loader2.InnerHTML = "<font color=red size=+1>Enter a FileName</font>"
else
if not (fileObj.FileExists(file)) then
Loader2.InnerHTML = "File not found. Creating now"
set file2 = fileObj.CreateTextFile(file)
else
Result = msgbox ("Would you like to over-write the file?",33,"Over-write file prompt")
if Result = vbOK then
Loader2.InnerHTML = "Over-writing now!"
set file2 = fileObj.CreateTextFile(file,True)
delim = "-------"
file2.writeline(ExprStrin.TextBox.value)
file2.writeline(delim)
file2.writeline(ExprStrin.StringBox.value)
file2.writeline(delim)
file2.writeline( ExprStrin.caseCheckbox.checked)
file2.writeline(delim)
file2.writeline(ExprStrin.GlobalCheckBox.Checked)
file2.writeline(delim)
file2.writeline(ExprStrin.MultilineCheckBox.checked)
file2.close
elseif Result = vbCancel then
Loader2.InnerHTML = "File existed. File operation canceled"
end if
end if
End if
set fileObj = nothing
end sub
sub Window_onload
ExprStrin.TextBox.style.backgroundcolor = "C0C0C0"
ExprStrin.StringBox.style.backgroundcolor = "c2c2c2"
end sub
'#################### End VBScript Section ####################
</script>
</head>
<body STYLE="filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#c2c2c2', EndColorStr='#00CCFF')">
<form action="some_form_handler.asp" method="post" id="ExprStrin" name="ExprStrin" target="_self">
<center><h1>Regex Tester</font></h1></center>
<table align="center">
<tr>
<td>Enter an expression</td>
<td><input type="text" id="TextBox" name="TextEntry" value="" tabindex=1 size=66 title="Enter a valid regular expression here"></td>
</tr>
<tr>
<td>Enter a string</td>
<td><textarea cols=50 rows=4 name="StringBox" tabindex=2 Title="Enter in a string to test Regular expression against"></textarea>
</td>
</tr>
</table>
<!-- Check boxes and main button locations -->
<table align="center" cellpadding="5">
<tr>
<td><input type=checkbox name="IgnoreCase" ID="CaseCheckBox" tabindex=3 title="Allows the ability to ignore case sensitivity">Ignore Case</td>
<td><input type=checkbox name="Global" id="GlobalCheckBox" tabindex=4 checked="true" Title="Allows the ability to search the whole string">Global Search</td>
<td><input type=checkbox name="Multiline" id="MultilineCheckBox" tabindex=5 title="Allows the ability to search multiple line strings">Multiline</td>
</tr>
<tr>
<td><input type="button" value="Clear Results" onClick="ClearDataAr1" size=30 tabindex=6 Title="Clear the results area"></td>
<td><input type="button" value="Test RegEx" onClick="cmdTextBox" tabindex=7 title="Test regular expression"></td>
<td><input type = "BUTTON" value = "Reload" onclick = "reloadHTA()"tabindex=8 title="Reload App with default values" ></td>
</tr>
</table>
<table align="center" cellpadding="5">
<tr>
<td><br><font color=blue size=+1><b>Error or Result display</b></font></td>
</tr>
</table>
<table align="center" >
<tr>
<td><span id=DataAr1>Result will display here</span></td>
</tr>
</table>
<table align="center" ID="Table1" cellpadding="5">
<br>
<tr><td><font color=blue size=+1><b>Substring Matches Display</b></font></td></tr>
</table>
<table align=center >
<tr>
<td><span id=SubAr1>Substrings will display here</span></td>
</tr>
</table>
<table align=center cellpadding="5"><br><br>
<tr>
<td><font color=blue size=+1>Import/Export data from file</font><br><input type="button" value="Load" onClick="loadfiles" id="loader" Title="Select to enable loading options">
<input type="button" value="Template" onClick="TmpInner" id="Templ2" Title="Allows the creation of a default template">
<input type="button" value="Save" onclick="SaveSets" id="Saver" Title="Allows you to save current settings to a file">
<input type="button" Value="Hide" onClick="CloseFile" Title="Hides save/template options"></td>
</tr>
<tr>
<td><span id=Loader></span></td>
</tr>
<tr><td><span id=Loader2></span></td></tr>
</table>
</form>
</body>
</html>
Updated: commented remove subs as post below says it is invalid.
Looking through the older versions, I cannot find what the sub should do. Commented and let me know if you run into errors. (I think I fixed the error handleing elsewhere.)
<message edited by mikeock on Monday, January 29, 2007 4:07 AM>