function ListFolderContents(path,displayRoot)
dim fs, folder, file, item, url
set fs = CreateObject("Scripting.FileSystemObject")
set folder = fs.GetFolder(path)
'Display the target folder and info.
if displayRoot = true then
Response.Write("<li><strong><a href=""" & MapURL(folder) & """>" & folder.Name & "</a></strong>")
Response.Write "<ul>" & vbcrlf
end if
'Display a list of sub folders.
for each item in folder.SubFolders
ListFolderContents item.Path, true
next
'Display a list of files.
for each item in folder.Files
if item.name <> "index.asp" and item.name <> "index.htm" and item.name <> "index.html" then
url = MapURL(item.path)
Response.Write("<li><a href=""" & url & """>" _
& item.Name & "</a>" _
& "</li>" & vbCrLf)
end if
next
if displayRoot = true then
Response.Write "</ul>" & vbcrlf
Response.Write "</li>"
end if
end function
<%
' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
' Calculate root to a given depth (square root, cubic root, etc.)
' x is what you want the root of
' y is the depth you want to go (2 = square, 3 = cubic, etc.)
function root(x, y)
root = x ^ (1 / y)
end function
%>
<%
' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
' The golden function is the upper branch of the hyperbola.
function gold(x)
gold = (x + sqr(x^2 + 4)) / 2
end function
%>
<%
' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
Const M_PI = 3.14159265358979323846
' Unnormalized sinc function.
function sinc(x)
sinc = sin(x) / x
end function
' Normalized sinc function.
' REQUIRES: constant M_PI
function nsinc(x)
sinc = sin(M_PI * x) / (M_PI * x)
end function
%>
function ucfirst(tname)
ucfirst = ""
tname = tname & " "
do while instr(tname, " ")
temp_string = left(tname, instr(tname," " ) -1)
' ucase the first letter
ucfirst = ucfirst & ucase(mid(temp_string, 1,1))
' lcase for rest of word
ucfirst = ucfirst & lcase(mid(temp_string,2)) & " "
tname = right(tname, len(tname) - instr(tname," " ))
loop
'show me what i get
ucfirst = ucfirst & ucase(mid(tname, 1,1))
ucfirst = ucfirst & mid(tname,2)
ucfirst = Trim(ucfirst)
end Function
<%
' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
' Returns the current date and time (UTC) from the NIST server in Boulder, Colorado.
function utcnow()
dim xmlhttp
dim response
' Server to query datetime from
Const TimeServer = "http://time.nist.gov:13"
' Use XML HTTP object to request web page content
Set xmlhttp = Server.CreateObject("Microsoft.XMLHTTP")
xmlhttp.Open "GET", TimeServer, false, "", ""
xmlhttp.Send
response = xmlhttp.ResponseText
set xmlhttp = nothing
' Parse UTC date
utcnow = cDate(mid(response, 11, 2) & "/" & mid(response, 14, 2) & "/" & mid(response, 8, 2) & " " & mid(response, 16, 9))
end function
' Returns the current date and time, offset to local time zone, from the NIST server in Boulder, Colorado.
' This is more accurate than VBScript's built-in Now() function in situations where the local server is not synchronized.
' There is expected to be some lag caused by this function, but the order of magnitude should only be milliseconds.
' REQUIRES: utcnow()
function atomicnow()
dim utc
dim offset
utc = utcnow()
' The order of the dates is important here!
offset = DateDiff("h", utc, now())
atomicnow = DateAdd("h", offset, utc)
end function
%>
<%
' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
' Strip HTML/ASP/PHP tags from a string.
function strip_tags(unsafeString)
dim regEx
set regEx = new RegExp
with regEx
.Global = true
.IgnoreCase = true
.Pattern = "(\<(/?[^\>]+)\>)"
end with
strip_tags = regEx.Replace(unsafeString, "")
set regEx = nothing
end function
%>
<%
' Copyright (c) 2009, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
' Determine whether the given number is a perfect number.
function isPerfect(someNumber)
dim i
dim arrFactors
arrFactors = Array()
' Only positive integers can be perfect.
if someNumber < 1 then
isPerfect = false
exit function
end if
' Calculate the factors for the given number.
for i = 1 to someNumber
if someNumber mod i = 0 then
redim preserve arrFactors(UBound(arrFactors) + 1)
arrFactors(UBound(arrFactors)) = i
end if
next
' A perfect number is a number that is half the sum of all of its positive divisors (including itself).
if someNumber = eval(join(arrFactors, " + ")) / 2 then
isPerfect = true
else
isPerfect = false
end if
end function
%>
<%
' Copyright (c) 2009, reusablecode.blogspot.com; some rights reserved.
'
' This work is licensed under the Creative Commons Attribution License. To view
' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
' 94305, USA.
' Merge two arrays into one.
function array_merge(byVal firstArray, byVal secondArray)
dim totalSize
dim i
dim combinedArray
' Ensure that we're dealing with arrays.
if not isArray(firstArray) then
firstArray = Array(firstArray)
end if
if not isArray(secondArray) then
secondArray = Array(secondArray)
end if
' Set up the new array.
totalSize = uBound(firstArray) + uBound(secondArray) + 1
combinedArray = firstArray
redim preserve combinedArray(totalSize)
for i = 0 to uBound(secondArray)
combinedArray(uBound(firstArray) + 1 + i) = secondArray(i)
next
array_merge = combinedArray
end function
%>