1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
| <html>
<head>
<title>Regex Tester</title>
<HTA:APPLICATION
icon = "explorer.exe"
Caption = "yes"
Version = "3.0"
/>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<!-- Author : Mike D Adams <a href="mailto:michael.david.adams@gmail.com">michael.david.adams@gmail.com</a>
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> |
Récupérer une partie d'une chaine
Répondre avec citation
Partager