<%
server.scripttimeout=100000
response.buffer=true
dim sList, oTimer, x, lATime, sAResult, sRResult, lRexTime, ldictTime, sDResult, maxkeys,keyWordList, sJSAResult, lJSATime
maxkeys = request("maxkeys")
if not(isNumeric(maxkeys)) then
maxkeys = 100
else
maxkeys = abs(maxkeys)
end if
if maxkeys = 0 then maxKeys = 100
if maxKeys > 5000 then maxKeys = 1000
keyWordList = "Newsgroup,Newsgroups,Protocol,SomeClientName,client,"
sList = buildKeywords(maxKeys, keyWordList)
response.write ""
'response.write "| Original List Contents: | " & sList & " |
"
response.write "Testing against: " & maxKeys & " items"
set oTimer = server.createobject("aspfree.timer")
lATime = 0
oTimer.setTime "start_array_remove"
sAResult = removeDupsArray(sList)
oTimer.setTime "end_array_remove"
lATime = cdbl((oTimer.getTime("end_array_remove")) - cdbl(oTimer.getTime("start_array_remove")))
oTimer.setTime "start_regexp_remove"
sRResult=RegExpTest(sList)
oTimer.setTime "end_regexp_remove"
lRexTime = cdbl((oTimer.getTime("end_regexp_remove")) - cdbl(oTimer.getTime("start_regexp_remove")))
oTimer.setTime "start_dict_remove"
sDResult=dictTest(sList)
oTimer.setTime "end_dict_remove"
ldictTime = cdbl((oTimer.getTime("end_dict_remove")) - cdbl(oTimer.getTime("start_dict_remove")))
oTimer.setTime "start_js_array_remove"
sJSAResult=jsArrayCheck(sList)
oTimer.setTime "end_js_array_remove"
lJSATime = cdbl((oTimer.getTime("end_js_array_remove")) - cdbl(oTimer.getTime("start_js_array_remove")))
set oTimer = nothing
response.write "| JS Array: | "& sJSAResult & " | " & lJSATime & " |
"
response.write "| VBS Array: | "&sAResult&" | " & lATime & " |
"
response.write "| RegExp: | "&sRResult&" | " & lRexTime & " |
"
response.write "| Dict Object: | "&sDResult&" | " & ldictTime & " |
"
response.write "
"
function removeDupsArray(byVal sList)
dim sNewList, aList, maxItems
aList = split(sList,",")
maxItems = ubound(aList)
for x = 0 to (maxItems)
if instr(sNewList, aList(x) & ",") <= 0 then sNewList = sNewList & aList(x) & ","
next
removeDupsArray = left(sNewList,len(sNewList)-1)
end function
Function RegExpTest(strng)
Dim regEx, Match, Matches, test ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = "(\w+)\," ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
tempmatch = "" 'Holds distinct values of string
Set Matches = regEx.Execute(strng) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
'test if value has been found already
testmatch = Instr(1,tempmatch,Match.Value,1)
if testmatch = 0 then
tempmatch = tempmatch & Match.Value
end if
Next
RegExpTest = left(tempmatch,len(tempmatch)-1)
End Function
function dictTest(byVal sList)
'provided by: Philip Obbard (PObbard@slimfast.com)
dim myArray, myDictionary, ct, myKeys
myArray = split(sList,",")
Set myDictionary = Server.CreateObject("Scripting.Dictionary")
for ct = 0 to ubound(myArray)
If Not myDictionary.Exists(myArray(ct)) Then
myDictionary.Add myArray(ct), ""
End If
next
'Now get your array of your three unique items and you're done...
myArray = myDictionary.Keys
Set myDictionary = Nothing
dictTest = join(myArray,",")
end function
function buildKeywords(byval maxKeys, byVal keyWordList)
dim aKeyWords, lMax, lMin, x, rndItem
aKeyWords = split(keyWordList,",")
lMax = ubound(aKeyWords)-1
lMin = lbound(aKeyWords)
for x = 0 to maxKeys
rndItem = Int((lMax - lMin + 1) * Rnd + lMin)
sList = sList & aKeyWords(rndItem) & ","
next
buildKeywords = left(sList,len(sList)-1)
end function
%>