")
strString = Replace(strString,vbcrlf,"
")
end if
FormatTextboxHTML = strString
End Function
Function RandomPassword()
' Creates an 8 letter/number random string
dim strPass, strPasswordTemp
dim intUpper, intLower, intRand, intNum, i
Randomize
For i = 1 to 8
intNum = Int(10 * Rnd + 48)
intUpper = Int(26 * Rnd + 65)
intLower = Int(26 * Rnd + 97)
intRand = Int(3 * Rnd + 1)
Select Case intRand
Case 1
strPass = Chr(intNum)
Case 2
strPass = Chr(intUpper)
Case 3
strPass = Chr(intLower)
End Select
strPasswordTemp = strPasswordTemp & strPass
Next
RandomPassword = LCASE(strPasswordTemp)
End Function
Function TitleCase(TitleString)
'Converts a string into Title Case
'Written by Tim Surtell and downloaded from www.surtell.com
'(C) 2004 Tim Surtell
dim TempString, NextCap, CurrentChar
NextCap = True
for CurrentChar = 1 to Len(TitleString)
if NextCap = True then
TempString = TempString & UCase(Mid(TitleString, CurrentChar, 1))
NextCap = False
else
TempString = TempString & Mid(TitleString, CurrentChar, 1)
end if
if InStr(" ({[""""", Mid(TitleString, CurrentChar, 1)) > 0 then
NextCap = True
end if
next
TitleCase = TempString
End Function
function FixEmail(strEmailAddress)
' Gets rid of non-email syntax
strEmailAddress = fixQuotes(strEmailAddress)
strEmailAddress=lcase(strEmailAddress)
strEmailAddress=replace(strEmailAddress," ", "")
strEmailAddress=replace(strEmailAddress,",", ".")
if left(strEmailAddress,4) = "www." then strEmailAddress = mid(strEmailAddress,5,len(strEmailAddress))
FixEmail = strEmailAddress
end function
FUNCTION invalidEmail( email )
' Is email valid?
IF INSTR( email, "@" ) = 0 OR INSTR( email, "." ) = 0 THEN
invalidEmail = TRUE
ELSE
invalidEmail = FALSE
END IF
END FUNCTION
FUNCTION invalidUrl( url )
' Is url valid?
IF INSTR( url, "http://" ) = 0 OR INSTR( url, "." ) = 0 THEN
invalidUrl = TRUE
ELSE
invalidUrl = FALSE
END IF
END FUNCTION
FUNCTION SELECTED( firstVal, secondVal )
' Adds a selected to a drop-down/listbox if selected
IF cSTR( firstVal ) = cSTR( secondVal ) THEN
SELECTED = " SELECTED "
ELSE
SELECTED = ""
END IF
END FUNCTION
FUNCTION CHECKED( firstVal, secondVal )
' Adds a tick/check to check box if selected
IF cSTR( firstVal ) = cSTR( secondVal ) THEN
CHECKED = " CHECKED "
ELSE
CHECKED = ""
END IF
END FUNCTION
FUNCTION FixQuotes(theString)
' Replaces ' with ''
dim strTemp
if isnull(theString) = false then
strTemp = Cstr(theString)
strTemp = replace(strTemp,"'","''")
FixQuotes = trim(strTemp)
else
FixQuotes = null
end if
END FUNCTION
FUNCTION FixApostrophe(theString)
' Replaces ' with ascii code equivalent(?)
dim strTemp
if isnull(theString) = false then
strTemp = Cstr(theString)
strTemp = replace(strTemp,"'","'")
strTemp = replace(strTemp,chr(34),""")
strTemp = replace(strTemp,",",",")
FixApostrophe = trim(strTemp)
else
FixApostrophe = null
end if
END FUNCTION
Function GetUrl()
' Get current url
GetUrl = request.servervariables("SCRIPT_NAME") & "?" & request.ServerVariables("QUERY_STRING")
End Function
Public Function CreateList(Data, RowDelimiter, ColDelimiter, ListType, ListName, FirstOption, Style, Extra)
' Create list from datasource
dim strTempArray, strTempInnerArray, strTempValue, strTempText, strTempSelected
dim strTempList
dim i
strTempArray = split(Data,RowDelimiter)
for i = 0 to ubound(strTempArray)
if trim(strTempArray(i)) <> "" then
strTempInnerArray = split(strTempArray(i),ColDelimiter)
strTempValue = trim(strTempInnerArray(0))
strTempText = trim(strTempInnerArray(1))
strTempSelected = trim(strTempInnerArray(2))
end if
' Create list items
Select Case lcase(ListType)
case "listbox", "dropdown"
strTempList = strTempList & "" & vbcrlf
case "checkbox"
strTempList = strTempList & "
") Temp = replace(Temp,"{b}","") Temp = replace(Temp,"{/b}","") Temp = replace(Temp,"{\b}","<\b>") Temp = replace(Temp,"{i}","") Temp = replace(Temp,"{/i}","") Temp = replace(Temp,"{\i}","<\i>") ReplaceKeyTags = Temp End Function Function GetPageName() ' Gets current page name dim strTempURL strTempURL = request.ServerVariables("URL") strTempURL = strReverse(strTempURL) strTempURL = left(strTempURL,instr(strTempURL,"/")-1) strTempURL = strReverse(strTempURL) GetPageName = strTempURL End Function Function ScreenScrape(url) ' Gets a web page's contents Dim xml, strData if url = "" then exit function 'Next, create an instance of the MS XMLhttp component. 'old version, unstable server side performance so upgrade if you can ' *** OLD *** Set xml = Server.CreateObject("Microsoft.XMLHTTP") 'new version, better server side performance Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP") xml.Open "GET", url, true ' the True specifies an asynchronous request Call xml.Send() 'Turn off error handling On Error Resume Next 'Wait for up to 3 seconds if we've not gotten the data yet If xml.readyState <> 4 then xml.waitForResponse 3 End If 'Did an error occur? If so, use a default value for our data If Err.Number <> 0 then strData = "" Else If (xml.readyState <> 4) Or (xml.Status <> 200) Then 'Abort the XMLHttp request xml.Abort strData = "" Else strData = xml.ResponseText End If End If ScreenScrape = strData End Function Function CreateBar(BarWidth, TotalBarWidth) dim BarTable, Colour Colour = "green" ' Get correct colour depending on percent if CInt((100/TotalBarWidth)*BarWidth) >= 75 and CInt((100/TotalBarWidth)*BarWidth) <= 85 then Colour = "orange" elseif CInt((100/TotalBarWidth)*BarWidth) > 85 then Colour = "red" end if BarTable = "
 | " & vbcrlf & _
" ![](../images/bar_" & Colour & ".gif){kind=small} | " & vbcrlf & _
"  | " & vbcrlf & _
"  | " & vbcrlf & _
"