1. hex to number functions: hex2dgt(), hex2dec()

Here is another way to convert hex to digit, hex to decimal:
Code:
<% @language="VBScript" %>
<% option explicit %>
<%

'--------------
' Hex2Dgt()
'------------------------------------------
' input:  one hex-char 0..9, a..f, A..F
' return: a number 0..15
' note: no error-checking
'------------------------------------------
Function Hex2Dgt(ByVal inHexChar)
If ( inHexChar <= "9" ) Then
Hex2Dgt = Asc(inHexChar) - Asc("0")
Else
Hex2Dgt = Asc(uCase(inHexChar)) - Asc("A") + 10
End If
End Function

'--------------
' Hex2Dec()
'------------------------------------------
' input: a Hex string
' return:
'     -2 null string
'     -1 error (non-hex char)
'   >= 0 the converted value
'------------------------------------------
Function Hex2Dec(ByVal inHex)

Dim oREX : Set oREX = New RegExp
Dim nVal : nVal = 0
Dim i

' test if null-string
'
If ( inHex="") Then
Hex2Dec = -2
Exit Function
End If

' test any non-hex char
'
oREX.Pattern = "[^0-9A-Fa-f]"
If ( oREX.Test(inHex)) Then
Hex2Dec = -1
Exit Function
End If

' now do the conversion
'
For i=1 to Len(inHex)
nVal = nVal * 16 + Hex2Dgt(Mid(inHex,i,1))
Next

Hex2Dec = nVal
set oREX = Nothing

End Function

' test
'
Dim aryHex(6)
Dim ix

aryHex(0) = "00000000000000000000000000"
aryHex(1) = "7fffffff"            ' max for Hex()
aryHex(2) = "ffffffffffff"        ' 12-f
aryHex(4) = ""
aryHex(6) = "hex"

For ix=0 to UBound(aryHex)
Response.Write aryHex(ix) & " : " & Hex2Dec(aryHex(ix)) & "<br/>" & vbCRLF
Next

%>
Results:
Code:
00000000000000000000000000 : 0
7fffffff : 2147483647
ffffffffffff : 281474976710655
: -2
: -2
hex : -1

2. Faster reading of text files

Just a little tip......

Text files are slow to read when using the
Code:
do while textFileOpen.AtEndOfStream=false
loop
method.

It is alot faster if the text file is read all at once and the lines put into an array
Code:
text=split(textFileOpen.readall,vbcrlf)
Which works ALOT faster

3. searching a character in a particular sentence and the count of it

Function search(pSearch, pSearchStr)
Dim tempSearch, tempSearchStr, startpos, endpos
startpos = 1
Dim ctr
ctr = 0

Do While (startpos > 0)
endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr))
If endpos > 0 Then
ctr = ctr + 1
startpos = endpos + Len(pSearchStr)
Else
Exit Do
End If
Loop
search = ctr
End Function

4. Get the user name only (drop domain name)

one line version:

findslashinst = findslashinst + 1 ' increment the value so it starts where the actual userid is.

5. I've just built this little function for printing the date that the current document was last saved (maybe useful for static content on an ASP page):
Code:
 function lastUpdated

Set fso = CreateObject("Scripting.FileSystemObject")
thispage = replace(request.ServerVariables("URL"), "/", "\")
Set fileObject = fso.GetFile(server.MapPath(thispage))
datemodified = fileObject.DateLastModified
lastUpdated = (FormatDateTime(datemodified,1))
Set fileObject = Nothing
Set fso = Nothing

end function

' usage:
Response.write ("Last Updated: " & lastUpdated)

6. Hey everyone!
A couple of simlpe ones I use pretty often..

Convert a mm/dd/yy or mm/dd/yyyy Oracle date format that is...DD-MMM-YY
Code:
Function OracleDate( dt )
dt = CDate( dt ) ' just to be sure
OracleDate = Right( "0" & Day(dt), 2 ) & "-" _
& UCase( MonthName(Month(dt), True) ) & "-" _
& Year(dt)
End Function

I didn't write this one, but one of the developers here did and it's convenient..
I thnik you could use the getRows() method and do a couple of other things to optimize but..

Code:
Function xdirlookup(uid, fld)
Dim conn, cmd, rs, i
Set cmd.ActiveConnection = conn
cmd.CommandText = "<LDAP://yourLdapServer>;(&(objectClass=organizationalPerson)(uid=" & uid & "));uid,sn,givenName,mail;subtree"
Set rs = cmd.Execute

If (Not (rs.EOF And rs.BOF)) Then
xdirlookup = rs.Fields(fld).Value
End If
End Function
Runs an A/D lookup given domainId, Field you want to return.
Real handy if you do something like...
Code:
dim myVar
myVar = dirLookUp(Right(Trim(Request.ServerVariables ("AUTH_USER")), iLength), 1)
here are a bunch more ADSI related functions/subs..
http://www.15seconds.com/issue/020130.htm

Yet another function to remove special chars..

Code:
Function RemQuotes(pString)
if Not IsNull(pString) then
RemQuotes =  Replace(Replace(Replace(Replace(Replace(pString,";","-"),"'","''"),"&"," and "),"""",""),",","")
else RemQuotes = pString end if
End Function
Function returns true/false..checks to see if it is daylights savings time...
..I didnt write this!
Code:
Private Function CheckDayLightSavings(dtDateTime)
'Author: Olin Hamilton
'
'Email:  olin@oct.net
'
'Pupose: This function returns true if a passed datetime value is in Daylight Savings time,
'		 Returns false if the datetime value is in Standard Time
'
'Usage:  Use a date, or datetime formatted string as the parameter
'		 If the parameter is not a valid date, the function will return False
'		 If no Time part is passed with the string, it will assume the time is after
'		 2 AM, so would return true on the first sunday of April, and False on the last Sunday in October.
'		 Since a null time part for a datetime value defaults to exactly "00:00:00", if a date is passed with
'		 a time value equal to "00:00:00" the function will assume that the time value was not passed
'		 and that the time is after 2 Am.  This may cause unexpected results if you are passing a valid datetime
'		 value with a time value of exactly midnight.  Unfortunately, I could not think of any other way to handle
'		 no time values, and figured it was best to consider it past 2AM.
'		 However, you can control this limitation by checking the time value for the date before passing it
'		 to this function, and if it has a time value of "00:00:00", increasing it by one second will cause
'		 the function to accurately return false if the date is the start day for DST,
'		 or return True if it's the end day for DST.
'        please send me an email letting me know.

Dim retVal, x, sTempDate
'if the date time has the milliseconds, clean them off
If InStr(1,CStr(dtDateTime),".") <> 0 Then
dtDateTime = Left(dtDateTime, Len(dtDateTime) - 4)
End If

'If the passed string is a valid date, let's begin checking, otherwise
'just return False.
If IsDate(dtDateTime) Then
'We know what to do with any dates within these months
If Month(dtDateTime) <> 10 And Month(dtDateTime) <> 4 Then
Select Case Month(dtDateTime)
'Jan
Case 1
retVal = False
'Feb
Case 2
retVal = False
'Mar
Case 3
RetVal = False
'May
Case 5
retVal = True
'Jun
Case 6
retVal = True
'Jul
Case 7
retVal = True
'Aug
Case 8
retVal = True
'Sep
Case 9
retVal = True
'Nov
Case 11
retVal = False
'Dec
Case 12
retVal = False
End Select
Else
'If the month is April, let's check to see if the date is before or after
'2 AM on the first Sunday of the month
If Month(dtDateTime) = 4 Then
If Day(dtDateTime) < 8 Then
For x = 1 To Day(dtDateTime)
sTempDate = CStr(Month(dtDateTime)) & "/" & x & "/" & CStr(Year(dtDateTime))
If Weekday(sTempDate) = 1 Then
If Day(sTempDate) < Day(dtDateTime) Then
'First sunday in April has already passed, so we are now in DST
retVal = True
Exit For
Else
'It's the first Sunday in April!
'Let's see if it's past 2 AM. If there is no time part in dtDateTime (time part = "00:00:00"),
'we are going to assume it's past 2 AM
If (Hour(dtDateTime) >= 2) Or (Hour(dtDateTime) = 0 And Minute(dtDateTime) = 0 And Second(dtDateTime) = 0) Then
retVal = True
Exit For
Else
retVal = False
End If
End If
Else
retVal = False
End If
Next
Else
'we know what to do if the day is equal to or greater than the 8th
retval = True
End If
'If the month is October, let's check to see if date is before or after
'2 AM on the last Sunday of the month
ElseIf Month(dtDateTime) = 10 Then
'We know what to do if the day is less than then 25th
If Day(dtDateTime) < 25 Then
retval = True
Else
For x = 25 To Day(dtDateTime)
sTempDate = CStr(Month(dtDateTime)) & "/" & x & "/" & CStr(Year(dtDateTime))
If Weekday(sTempDate) = 1 Then
If Day(sTempDate) < Day(dtDateTime) Then
'last sunday in oct has already passed, so we aren't in DST anymore
retVal = False
Exit For
Else
'It's the last Sunday in October!
'Let's see if it's past 2 AM. If there is no time part in dtDateTime (time part = "00:00:00"),
'we are going to assume it's past 2 AM
If (Hour(dtDateTime) >= 2) Or (Hour(dtDateTime) = 0 And Minute(dtDateTime) = 0 And Second(dtDateTime) = 0) Then
retVal = False
Exit For
Else
retVal = True
End If
End If
Else
retVal =True
End If
Next
End If
End If
End If
Else
'if the string passed to the function is not a valid date, let's return false.
retVal = False
End If
CheckDayLightSavings = retVal
End Function
show an array in at table (think this works for multidimensional..but havent used it in awhile)

Code:
Sub ShowArrayInTable(ArrayToShow)
Dim I           ' Simple Looping Var
Dim iArraySize  ' Var to store array size

' If you want to know how big an array is, you can use this
' to find out. This even works in VB where they don't have
' to be zero-based.  The LBound and UBound return the
' indecies of the lowest and highest array elements so to
' get the size we take the difference and add one since you
' can store a value at both end points.
iArraySize = (UBound(ArrayToShow) - LBound(ArrayToShow)) + 1

Response.Write "<p>The array has " & iArraySize _
& " elements.  They are:</p>" & vbCrLf

Response.Write "<table border=""1"">" & vbCrLf

Response.Write "<tr>" & vbCrLf
Response.Write "<th>Index</th>" & vbCrLf
Response.Write "<th>Value</th>" & vbCrLf
Response.Write "</tr>" & vbCrLf

Response.Write "<tbody>" & vbCrLf

' Simple loop over a table outputting a row for each element
For I = LBound(ArrayToShow) To UBound(ArrayToShow)
Response.Write "<tr>" & vbCrLf
' Write out the index of the element we're currently on
Response.Write "<td>" & I & "</td>" & vbCrLf
' Write out the value of the element we're currently on
Response.Write "<td>" & ArrayToShow(I) & "</td>" & vbCrLf
Response.Write "</tr>" & vbCrLf
Next 'I
Response.Write "</tbody>" & vbCrLf

Response.Write "</table>" & vbCrLf
End Sub
didnt write that one either!
Enjoy!

7. Date format. Had a look through and can't see a function to make a date into the format YYYY-MM-DD HH:MI:SS

Anyone got one? Or can the built in functions do it?

Cheers

8. I've never had need of this function because ASP handles time a bit diffferently than *nix scripting languages like PHP but here's a quick and dirty function you can use:
Code:
  <%
function XnixTime(thetime)
if thetime = "" then thetime = now()
XnixTime = year(thetime) & "-"_
& month(thetime) & "-"_
& day(thetime) & " "_
& hour(thetime) & ":"_
& minute(thetime) & ":"_
& second(thetime)
end function
%>
Use it as follows:
<%=XnixTime("")%>
or
<%=XnixTime("4/7/2005 9:39:25")%>

It's not pretty but it should do the job. It would be even better made into a class.

9. This is a great thread, here are a number of functions i use on a regular basis:

Cleans string of unwanted chars:

Code:
<%
Function cleanString(strInput)
Dim regEx
' Create a regular expression
Set regEx = New RegExp

' Match any character NOT in this list
'regEx.Pattern="abcdefghijklmnopqrstuvwxyz.1234567890_-"
regEx.Pattern = "[¬¦!£$%^&*()+=#~'@;:?/><,/*|\}{]" regEx.IgnoreCase = True regEx.Global = True strInput=RMSpace(strInput) ' Replace matches with zero length string cleanString = regEx.Replace(strInput, "") End Function %> Fixes issue of Line breaks not being interpreted with plain text: Code: <% '************ "LBR" Inserts line breaks into a text string ************ Function LBR( strText ) if len(strText) <> 0 then LBR = Replace( strText, chr(13), "<br>" ) else LBR=strText end if End Function %> Strips HTML code from string: Code: <% '************ "RemoveHTML" Strips any HTML from a text string ************ Function RemoveHTML( strText ) Dim RegEx Set RegEx = New RegExp RegEx.Pattern = "<[^>]*>" RegEx.Global = True strText = Replace(LCase(strText), "<br>", chr(10)) RemoveHTML = RegEx.Replace(strText, "") End Function %> This function is great, capitlizes first letter of everyone, useful on forms where getting name and address information: Code: <% '************ "Pcase" This function capitalizes the first letter of each word ************ Function PCase(strInput) Dim iPosition ' Our current position in the string (First character = 1) Dim iSpace ' The position of the next space after our iPosition Dim strOutput ' Our temporary string used to build the function's output iPosition = 1 Do While InStr(iPosition, strInput, " ", 1) <> 0 iSpace = InStr(iPosition, strInput, " ", 1) strOutput = strOutput & UCase(Mid(strInput, iPosition, 1)) strOutput = strOutput & LCase(Mid(strInput, iPosition + 1, iSpace - iPosition)) iPosition = iSpace + 1 Loop strOutput = strOutput & UCase(Mid(strInput, iPosition, 1)) strOutput = strOutput & LCase(Mid(strInput, iPosition + 1)) PCase = strOutput End Function %> Great function to shorten a string by adding a trailing ... after specified number of chars: Code: <% '************ "clipText" Reduces length of text to 15 chars + adds "..." to end to symbolise more text to be displayed ************ Function clipText (strTheText) if Len(strTheText) > 50 then strTheText = Left(strTheText, 50) & " ..." clipText = strTheText End Function %> 10. Function to sort XML This is something I developed to sort XML in asp and return a node object. It's by no means perfect but it does work rather well if you are careful I use Microsoft's MSXML object - I've tested it with MSXML4 SP2. Code: Function SortXML(oMain, sXPath, sBy) Dim oSS, oNS, sName, aSortBy, aSortField, aSortFieldType, aSortFieldDirection, sXSL Set oSS = Server.CreateObject("MSXML.DOMDocument") Set oNS = Server.CreateObject("MSXML.DOMDocument") sName = oMain.nodeName aSortBy = Split(sBy, ",") aSortField = Split(aSortBy(0), "\") aSortFieldType = Split(aSortBy(1), "\") aSortFieldDirection = Split(aSortBy(2), "\") If UBound(aSortFieldType) <> UBound(aSortField) Or UBound(aSortFieldDirection) <> UBound(aSortField) Then Response.Write "Coding error - there must be the same number of sort elements" Else sXSL = "<?xml version='1.0'?>" & _ "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & _ "<xsl:template match=""" & sName & """>" & _ "<" & sName & ">" & _ "<xsl:apply-templates select=""" & sXPath & """>" For i = 0 To UBound(aSortField) sXSL = sXSL & "<xsl:sort select=""" & aSortField(i) & """ order=""" & aSortFieldDirection(i) & """ data-type=""" & aSortFieldType(i) & """/>" Next sXSL = sXSL & "</xsl:apply-templates>" & _ "</" & sName & ">" & _ "</xsl:template>" & _ "<xsl:template match=""* | @* | node()"">" & _ "<xsl:copy><xsl:apply-templates select=""@* | node()""/></xsl:copy>" & _ "</xsl:template>" & _ "</xsl:stylesheet>" oSS.async = false oSS.loadXML sXSL oMain.transformNodeToObject oSS, oNs End If Set SortXML = oNs End Function Syntax: Set oSortedNode = SortXML(oNode, sXPath, sSort) oNode (IXMLDOMNode) - the containing node of the nodes you wish to sort sXPath (String) - an XPath expression to select from oNode the nodes you want to sort sSort (String) - a sort by expression, comma separated, including the criteria to sort, the type of data and the sort direction (see example) Sample XML: Code: <?xml version="1.0" ?> <main> <item id="1" title="President"> <name>Bill</name> <lname>Smith</lname> </item> <item id="2" title="Director of Sales"> <name>Sarah</name> <lname>Smith</lname> </item> <item id="3" title="Operations Manager"> <name>George</name> <lname>Jones</lname> </item> <item id="4" title="Floor Sweeper"> <name>Pete</name> <lname>Pobahushi</lname> </item> </main> EXAMPLES: Let's do a simple sort by the attribute "title": Set oSorted = SortXML(oDOM.selectSingleNode("main"), "item", "@title,text,ascending") And by id: Set oSorted = SortXML(oDOM.selectSingleNode("main"), "item", "@id,number,ascending") Now, let's sort by lastname and firstname: Set oSorted = SortXML(oDOM.selectSingleNode("main"), "item", "lname\name,text\text,ascending\ascending") (see how I used \ to delimit the separate sort fields etc) Finally, sort by firstname and lastname but only select records with id less than 3: Set oSorted = SortXML(oDOM.selectSingleNode("main"), "item[@id &lt '3']", "name\lname,text\text,ascending\descending") There you have it. It's not perfect but it works - any suggestions welcome. Jim 11. Here is my library. I use PHP a lot and have brought some nice functions over to ASP Functions: printr_r - will display all of the data in an array. Supports Infinate demensions as well as dictionaries. IsArray - returns true or false whether the variable is an array IsDictionary - returns true or false whether the variable is a dictionary MakeTimestamp - returns a timestamp from a datetime UnMakeTimestamp - returns a datetime from a timestamp DateFormat - returns a date that is formatted to your liking DebugMode - returns true or false based on ?debug=1 in the URL AddSlashes - makes a string usable in SQL by doubling quotes from ' to '' RunQuery - runs a query on the specified database and returns an array of dictionaries containing the results of a query RunNonQuery - runs a query on the specified database and returns nothing ShowSQLError - neatly displays an sql error that occured in RunQuery or RunNonQuery SQLDump - displays a table with all of the data from a RunQuery (may also use print_r for a pure text display) echo - response.write with a line break at the end to help with code formatting Code: <% 'Used by the check form functions dim forms dim errors 'Used to store SQL errors dim sqlerr set sqlerr = Server.CreateObject("Scripting.Dictionary") 'When false sql errors will be displayed only by manual request 'When true sql errors will be displayed when they occur dim AUTO_SQL_ERROR AUTO_SQL_ERROR = false function AddSlashes(str) AddSlashes = replace(str,"'","''") end function 'Checks the URL for ?debug=1 allows for setting up debug sections function DebugMode() if request.querystring("debug") = 1 then DebugMode = true else DebugMode = false end if end function 'Runs an query does not use the global.asa but allows selection of any database. 'returns a 2 dementional array ' array(rownumber)("colname") ' ex: arr(0)("APTCODE") 'allows for all caps and all lowercase colnames all others will not be shown 'if an error occurs it will set the sqlerr variable with all of the information function RunQuery(sql,database) srv = "yourserver" uid = "yourusername" pwd = "yourpassword" connect = "DRIVER={SQL Server};SERVER="&srv&";DATABASE="&database&";UID="&uid&";PWD="&pwd sqlerr.RemoveAll set RQRS = Server.CreateObject("ADODB.RecordSet") on error resume next RQRS.Open sql,connect if err.number > 0 then sqlerr.Add "err",true sqlerr.Add "num",err.number sqlerr.Add "desc",err.Description sqlerr.Add "sql",sql if AUTO_SQL_ERROR then show = ShowSQLError() end if else sqlerr.Add "err",false end if If Err.number <> 0 or temp = -1 Then Err.Clear RunQuery = false else RQArr = array() do until RQRS.EOF if UBOUND(RQArr) = -1 then redim preserve RQArr(0) else redim preserve RQArr(UBOUND(RQArr)+1) end if set RQArr(UBOUND(RQArr)) = Server.CreateObject("Scripting.Dictionary") for stlctr = 0 to RQRS.Fields.count - 1 key = replace(lcase(RQRS.Fields(stlctr).Name)," ","_") val = RQRS.Fields(stlctr) if not IsNumeric(key) then RQArr(UBOUND(RQArr)).Add lcase(key),val RQArr(UBOUND(RQArr)).Add ucase(key),val else RQArr(UBOUND(RQArr)).Add lcase(key),val end if next RQRS.MoveNext loop RQRS.Close set RQRS = nothing RunQuery = RQArr set RQArr = nothing End If On Error Goto 0 end function 'Displays a nice clean description of the error that occured when a query was run. function ShowSQLError() echo "<div style='background: #FFE6E6; border: 1px solid #FDA6A6; padding: 5px; font: 12px verdana; color: #000000;'>" echo " <b>Number:</b> "&sqlerr("num")&"<br>" echo " <b>Description:</b> "&sqlerr("desc")&"<br>" echo " <b>SQL:</b> "&sqlerr("sql") echo "</div>" end function 'Runs the same as RunQuery but does not return anything function RunNonQuery(sql,database) srv = "yourserver" uid = "yourusername" pwd = "yourpassword" connect = "DRIVER={SQL Server};SERVER="&srv&";DATABASE="&database&";UID="&uid&";PWD="&pwd sqlerr.RemoveAll set RQRS = Server.CreateObject("ADODB.RecordSet") on error resume next RQRS.Open sql,connect if err.number > 0 then sqlerr.Add "err",true sqlerr.Add "num",err.number sqlerr.Add "desc",err.Description if AUTO_SQL_ERROR then show = ShowSQLError() end if else sqlerr.Add "err",false end if set RQRS = nothing RunNonQuery = "" set RQArr = nothing on error goto 0 end function 'This will loop through the array supplied by RunQuery and will display a table of all the data that is in the array function SqlDump(obj) if IsArray(obj) = true then response.write("<table border=1 cellpadding=3 cellspacing=0 bordercolor='#000000'><tr>") for each stlctr2 in obj(0) response.write("<td>"&stlctr2&"</td>") next response.write("</tr>") for stlctr = 0 to Ubound(obj) response.write("<tr>") for each stlctr2 in obj(stlctr) if len(obj(stlctr)(stlctr2)) < 100 then response.write("<td nowrap>&nbsp;"&obj(stlctr)(stlctr2)&"</td>") else response.write("<td nowrap>Long Text</td>") end if next response.write("</tr>") next response.write("</table>") else response.write("no data<br><br>") end if end function 'Outputs normally, but adds a line break at the end of the string to help formating function echo(str) response.write(str&vbcrlf) end function 'Returns true if it is an array false if it is not function IsArray(arr) on error resume next temp = ubound(arr) If Err.number <> 0 or temp = -1 Then IsArray = false Err.Clear else IsArray = true End If On Error Goto 0 end function 'Adds a value to an array. This avoids the need for redim function AddArray(byref arr,newval) dim ctr dim newarr newarr = arr if not IsArray(arr) then redim arr(0) arr(0) = newval else redim preserve arr(ubound(arr)+1) arr(ubound(arr)) = newval end if end function 'Used by Print_r function Echor(arr,tablevel) if tablevel = 0 then echo "Array" echo "(" end if dim ctr if not IsDictionary(arr) and not IsArray(arr) then else if IsDictionary(arr) then for each ctr in arr for tabs = 0 to ((tablevel+1)*4) response.write(" ") next if IsArray(arr(ctr)) = true then echo "["&ctr&"] => Array(" x = Echor(arr(ctr),(tablevel+1)) for tabs = 0 to ((tablevel+1)*4) response.write(" ") next echo ")" else if IsDictionary(arr(ctr)) then echo "["&ctr&"] => dictionary(" x = Echor(arr(ctr),(tablevel+1)) for tabs = 0 to ((tablevel+1)*4) response.write(" ") next echo ")" else echo "["&ctr&"] => {"&arr(ctr)&"}" end if end if next else for ctr=0 to ubound(arr) for tabs = 0 to ((tablevel+1)*4) response.write(" ") next if IsArray(arr(ctr)) = true then echo "["&ctr&"] => Array(" x = Echor(arr(ctr),(tablevel+1)) for tabs = 0 to ((tablevel+1)*4) response.write(" ") next echo ")" else if IsDictionary(arr(ctr)) then echo "["&ctr&"] => dictionary(" x = Echor(arr(ctr),(tablevel+1)) for tabs = 0 to ((tablevel+1)*4) response.write(" ") next echo ")" else echo "["&ctr&"] => {"&arr(ctr)&"}" end if end if next end if end if if tablevel = 0 then echo ")" end if end function 'Checks to see if the variable is a Scripting.Dictionary 'returns true if it is, false if it is not function IsDictionary(dictionary) on error resume next for each i in dictionary x = dictionary(i) if err.number > 0 then IsDictionary = false on error goto 0 exit function else IsDictionary = true on error goto 0 exit function end if next on error goto 0 end function 'will display the contents of the supplied array. Used for debugging purposes ' Array( ' [0] = a ' [1] = b ' [2] = c ' [3] = Array ( ' [0] = aa ' [1] = bb ' [2] = cc ' ) ' } function Print_r(arr) x = echor(arr,0) end function 'Returns a Unix Timestamp function MakeTimestamp(datetime) MakeTimestamp = DateDiff("s", "01/01/1970 00:00:00", datetime) end function 'Returns a datetime function UnMakeTimestamp(timestamp) UnMakeTimestamp = DateAdd("s",timestamp, "01/01/1970 00:00:00") end function 'used by DateFormat function AddZeros(num,length) str = num if len(str) <> length then while len(str) <> length str = "0"&str wend end if AddZeros = str end function 'This function takes in a date or a timestamp as well as a format and will return the date in the specified format ' ex: DateFormat("1/1/2005","%M %j %Y") would return Jan 1 2005 function DateFormat(datetime,format) if IsNumeric(datetime) then datein = UnMakeTimestamp(datetime) else if IsDate(datetime) then datein = datetime else DateFormat = "date invalid" exit function end if end if arr = split(datein," ") arr2 = split(arr(0),"/") arr3 = split(arr(1),":") amlow = lcase(arr(2)) amup = ucase(arr(2)) m = AddZeros(arr2(0),2) m2 = arr2(0) mname = monthname(arr2(0)) mshortname = left(monthname(arr2(0)),3) d = AddZeros(arr2(1),2) d2 = arr2(1) hsmall = AddZeros(arr3(0),2) hsmall2 = arr3(0) if amlow = "pm" then hbig = AddZeros(arr3(0)+12,2) hbig2 = arr3(0)+12 else hbig = AddZeros(arr3(0),2) hbig2 = arr3(0) end if mn = AddZeros(arr3(1),2) mn2 = arr3(1) s = AddZeros(arr3(2),2) s2 = arr3(2) y = right(arr2(2),2) y2 = arr2(2) format = replace(format,"%A",amlow) '%A - AM or PM format = replace(format,"%a",amup) '%a - am or pm format = replace(format,"%m",m) '%m - Month with leading zeroes (01 - 12) format = replace(format,"%n",m2) '%n - Month without leading zeroes (1 - 12) format = replace(format,"%F",mname) '%F - Month name (January - December) format = replace(format,"%M",mshortname) '%M - Three letter month name (Jan - Dec) format = replace(format,"%d",d) '$d - Day with leading zeroes (01 - 31)
format = replace(format,"%j",d2)			'%j - Day without leading zeroes (1 - 31)
format = replace(format,"%H",hsmall)		'%H - Hour with leading zeroes (12 hour)
format = replace(format,"%h",hbig)			'%h - Hour with leading zeroes (24 hour)
format = replace(format,"%G",hsmall2)		'%G - Hour without leading zeroes (12 hour)
format = replace(format,"%g",hbig2)			'%g - Hour without leading zeroes (24 hour)
format = replace(format,"%i",mn)			'%i - Minute with leading zeroes (01 to 60)
format = replace(format,"%I",mn2)			'%I - Minute without leading zeroes (1 to 60)
format = replace(format,"%s",s)				'%s - Second with leading zeroes (01 to 60)
format = replace(format,"%S",s2)			'%S - Second without leading zeroes (1 to 60)
format = replace(format,"%y",y)				'%y - Two digit year (03)
format = replace(format,"%Y",y2)			'%Y - Four digit year (2003)

DateFormat = format
end function

'This function is used with CheckForm
'typein is a regex used to test the value
'fail is the message to display when the value fails the test
function RegisterForm(namein,test,errname,fail)
end function

'This function is used with CheckForm
'namein is the name of the field
'fail is the message to display
function RegisterError(namein,errname,fail)
end function

'This function builds an array full of the errors that were contained in the array
'created by RegisterForm. If the IsArray(errors) then the form contained errors.
function CheckForm()
set regex = new regexp
regex.Global = true
regex.IgnoreCase = true

if IsArray(forms) then
for frmctr = 0 to ubound(forms)
regex.Pattern = forms(frmctr)(1)
if not regex.Test(request.form(forms(frmctr)(0))) then
err = RegisterError(forms(frmctr)(0),forms(frmctr)(2),forms(frmctr)(3))
end if
next
end if
end function
%>

12. I do I get it to work

Originally Posted by hillsy
A function to list all files in a site, with hyperlinks. Useful for search engine crawlers or links pages. I asked about one of these a long time ago and eventually had to write my own

Code:
<%
Dim objFileScripting, objFolder, strDirectoryPath

' Subroutine to recursively list the contents of any subfolders
Sub IterateThroughDirectory(objFolder, strUrlPathName)
Dim objFileCollection
Dim strFilename
Dim objSubFolder

' Return file collection in folder
Set objFileCollection = objFolder.Files

For Each strFilename In objFileCollection
strFilename = Right(strFilename, Len(strFilename) - InStrRev(strFilename, "\"))
Response.Write "<li><a href=""" & strUrlPathName & strFileName & """>" & strFileName & "</a>" & vbCrLf
Next

' Now that we've processed root files, do it for all the subdirectories
For Each objSubFolder in objFolder.SubFolders
IterateThroughDirectory objSubFolder, strUrlPathName & objSubFolder.Name & "/"
Next

' Close the file collection
Set objFileCollection = Nothing
End Sub

' Get file scripting object
Set objFileScripting = CreateObject("Scripting.FileSystemObject")

' Dynamically assign the filesystem path
' Allows the script to use different physical dirs where logical URL path remains the same
strDirectoryPath = Server.MapPath("/site root directory/") & "\"

' Return folder object
Set objFolder = objFileScripting.GetFolder(strDirectoryPath)

' Call the subroutine
IterateThroughDirectory objFolder, ""

' Close all of the open objects
Set objFolder = Nothing
Set objFileScripting = Nothing
%>
Put it between <ol> tags for best effect.

I've put it between <ol> </ol> tags in a file at the root directory, it's not working, what do I have to change in your code to have it work on my website?

13. Are you aware that you are redefining isArray() and DateFormat() in vbscript with your IsArray and DateFormat function below?

Originally Posted by PuritysDisciple
Here is my library. I use PHP a lot and have brought some nice functions over to ASP

Functions:
printr_r - will display all of the data in an array. Supports Infinate demensions as well as dictionaries.
IsArray - returns true or false whether the variable is an array
IsDictionary - returns true or false whether the variable is a dictionary
MakeTimestamp - returns a timestamp from a datetime
UnMakeTimestamp - returns a datetime from a timestamp
DateFormat - returns a date that is formatted to your liking
DebugMode - returns true or false based on ?debug=1 in the URL
AddSlashes - makes a string usable in SQL by doubling quotes from ' to ''
RunQuery - runs a query on the specified database and returns an array of dictionaries containing the results of a query
RunNonQuery - runs a query on the specified database and returns nothing
ShowSQLError - neatly displays an sql error that occured in RunQuery or RunNonQuery
SQLDump - displays a table with all of the data from a RunQuery (may also use print_r for a pure text display)
echo - response.write with a line break at the end to help with code formatting

Code:
<%
'Used by the check form functions
dim forms
dim errors

'Used to store SQL errors
dim sqlerr
set sqlerr = Server.CreateObject("Scripting.Dictionary")

'When false sql errors will be displayed only by manual request
'When true sql errors will be displayed when they occur
dim AUTO_SQL_ERROR
AUTO_SQL_ERROR = false

end function

'Checks the URL for ?debug=1 allows for setting up debug sections
function DebugMode()
if request.querystring("debug") = 1 then
DebugMode = true
else
DebugMode = false
end if
end function

'Runs an query does not use the global.asa but allows selection of any database.
'returns a 2 dementional array
'	array(rownumber)("colname")
'	ex: arr(0)("APTCODE")
'allows for all caps and all lowercase colnames all others will not be shown
'if an error occurs it will set the sqlerr variable with all of the information
function RunQuery(sql,database)
srv = "yourserver"
connect = "DRIVER={SQL Server};SERVER="&srv&";DATABASE="&database&";UID="&uid&";PWD="&pwd
sqlerr.RemoveAll

on error resume next
RQRS.Open sql,connect

if err.number > 0 then
if AUTO_SQL_ERROR then
show = ShowSQLError()
end if
else
end if

If Err.number <> 0 or temp = -1 Then
Err.Clear
RunQuery = false
else
RQArr = array()

do until RQRS.EOF
if UBOUND(RQArr) = -1 then
redim preserve RQArr(0)
else
redim preserve RQArr(UBOUND(RQArr)+1)
end if
set RQArr(UBOUND(RQArr)) = Server.CreateObject("Scripting.Dictionary")
for stlctr = 0 to RQRS.Fields.count - 1
key = replace(lcase(RQRS.Fields(stlctr).Name)," ","_")
val = RQRS.Fields(stlctr)

if not IsNumeric(key) then
else
end if
next
RQRS.MoveNext
loop
RQRS.Close

set RQRS = nothing
RunQuery = RQArr
set RQArr = nothing
End If
On Error Goto 0
end function

'Displays a nice clean description of the error that occured when a query was run.
function ShowSQLError()
echo "<div style='background: #FFE6E6; border: 1px solid #FDA6A6; padding: 5px; font: 12px verdana; color: #000000;'>"
echo "	<b>Number:</b> "&sqlerr("num")&"<br>"
echo "	<b>Description:</b> "&sqlerr("desc")&"<br>"
echo "	<b>SQL:</b> "&sqlerr("sql")
echo "</div>"
end function

'Runs the same as RunQuery but does not return anything
function RunNonQuery(sql,database)
srv = "yourserver"
connect = "DRIVER={SQL Server};SERVER="&srv&";DATABASE="&database&";UID="&uid&";PWD="&pwd
sqlerr.RemoveAll

on error resume next
RQRS.Open sql,connect

if err.number > 0 then
if AUTO_SQL_ERROR then
show = ShowSQLError()
end if
else
end if

set RQRS = nothing
RunNonQuery = ""
set RQArr = nothing
on error goto 0
end function

'This will loop through the array supplied by RunQuery and will display a table of all the data that is in the array
function SqlDump(obj)
if IsArray(obj) = true then
for each stlctr2 in obj(0)
response.write("<td>"&stlctr2&"</td>")
next
response.write("</tr>")
for stlctr = 0 to Ubound(obj)
response.write("<tr>")
for each stlctr2 in obj(stlctr)
if len(obj(stlctr)(stlctr2)) < 100 then
response.write("<td nowrap>&nbsp;"&obj(stlctr)(stlctr2)&"</td>")
else
response.write("<td nowrap>Long Text</td>")
end if
next
response.write("</tr>")
next
response.write("</table>")
else
response.write("no data<br><br>")
end if
end function

'Outputs normally, but adds a line break at the end of the string to help formating
function echo(str)
response.write(str&vbcrlf)
end function

'Returns true if it is an array false if it is not
function IsArray(arr)
on error resume next
temp = ubound(arr)
If Err.number <> 0 or temp = -1 Then
IsArray = false
Err.Clear
else
IsArray = true
End If
On Error Goto 0
end function

'Adds a value to an array. This avoids the need for redim
dim ctr
dim newarr

newarr = arr
if not IsArray(arr) then
redim arr(0)
arr(0) = newval
else
redim preserve arr(ubound(arr)+1)
arr(ubound(arr)) = newval
end if
end function

'Used by Print_r
function Echor(arr,tablevel)
if tablevel = 0 then
echo "Array"
echo "("
end if

dim ctr

if not IsDictionary(arr) and not IsArray(arr) then
else
if IsDictionary(arr) then
for each ctr in arr
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next

if IsArray(arr(ctr)) = true then
echo "["&ctr&"] => Array("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
if IsDictionary(arr(ctr)) then
echo "["&ctr&"] => dictionary("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
echo "["&ctr&"] => {"&arr(ctr)&"}"
end if
end if
next
else
for ctr=0 to ubound(arr)
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next

if IsArray(arr(ctr)) = true then
echo "["&ctr&"] => Array("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
if IsDictionary(arr(ctr)) then
echo "["&ctr&"] => dictionary("
x = Echor(arr(ctr),(tablevel+1))
for tabs = 0 to ((tablevel+1)*4)
response.write(" ")
next
echo ")"
else
echo "["&ctr&"] => {"&arr(ctr)&"}"
end if
end if
next
end if
end if

if tablevel = 0 then
echo ")"
end if
end function

'Checks to see if the variable is a Scripting.Dictionary
'returns true if it is, false if it is not
function IsDictionary(dictionary)
on error resume next
for each i in dictionary
x = dictionary(i)

if err.number > 0 then
IsDictionary = false
on error goto 0
exit function
else
IsDictionary = true
on error goto 0
exit function
end if
next
on error goto 0
end function

'will display the contents of the supplied array. Used for debugging purposes
'	Array(
'			[0] = a
'			[1] = b
'			[2] = c
'			[3] = Array (
'							[0] = aa
'							[1] = bb
'							[2] = cc
'						)
'		 }
function Print_r(arr)
x = echor(arr,0)
end function

'Returns a Unix Timestamp
function MakeTimestamp(datetime)
MakeTimestamp = DateDiff("s", "01/01/1970 00:00:00", datetime)
end function

'Returns a datetime
function UnMakeTimestamp(timestamp)
end function

'used by DateFormat
str = num
if len(str) <> length then
while len(str) <> length
str = "0"&str
wend
end if
end function

'This function takes in a date or a timestamp as well as a format and will return the date in the specified format
'	ex: DateFormat("1/1/2005","%M %j %Y") would return Jan 1 2005
function DateFormat(datetime,format)
if IsNumeric(datetime) then
datein = UnMakeTimestamp(datetime)
else
if IsDate(datetime) then
datein = datetime
else
DateFormat = "date invalid"
exit function
end if
end if

arr = split(datein," ")
arr2 = split(arr(0),"/")
arr3 = split(arr(1),":")

amlow = lcase(arr(2))
amup = ucase(arr(2))
m2 = arr2(0)
mname = monthname(arr2(0))
mshortname = left(monthname(arr2(0)),3)
d2 = arr2(1)
hsmall2 = arr3(0)

if amlow = "pm" then
hbig2 = arr3(0)+12
else
hbig2 = arr3(0)
end if

mn2 = arr3(1)
s2 = arr3(2)
y = right(arr2(2),2)
y2 = arr2(2)

format = replace(format,"%A",amlow)			'%A - AM or PM
format = replace(format,"%a",amup)			'%a - am or pm
format = replace(format,"%m",m)				'%m - Month with leading zeroes (01 - 12)
format = replace(format,"%n",m2)			'%n - Month without leading zeroes (1 - 12)
format = replace(format,"%F",mname)			'%F - Month name (January - December)
format = replace(format,"%M",mshortname)	'%M - Three letter month name (Jan - Dec)
format = replace(format,"%d",d)				'\$d - Day with leading zeroes (01 - 31)
format = replace(format,"%j",d2)			'%j - Day without leading zeroes (1 - 31)
format = replace(format,"%H",hsmall)		'%H - Hour with leading zeroes (12 hour)
format = replace(format,"%h",hbig)			'%h - Hour with leading zeroes (24 hour)
format = replace(format,"%G",hsmall2)		'%G - Hour without leading zeroes (12 hour)
format = replace(format,"%g",hbig2)			'%g - Hour without leading zeroes (24 hour)
format = replace(format,"%i",mn)			'%i - Minute with leading zeroes (01 to 60)
format = replace(format,"%I",mn2)			'%I - Minute without leading zeroes (1 to 60)
format = replace(format,"%s",s)				'%s - Second with leading zeroes (01 to 60)
format = replace(format,"%S",s2)			'%S - Second without leading zeroes (1 to 60)
format = replace(format,"%y",y)				'%y - Two digit year (03)
format = replace(format,"%Y",y2)			'%Y - Four digit year (2003)

DateFormat = format
end function

'This function is used with CheckForm
'typein is a regex used to test the value
'fail is the message to display when the value fails the test
function RegisterForm(namein,test,errname,fail)
end function

'This function is used with CheckForm
'namein is the name of the field
'fail is the message to display
function RegisterError(namein,errname,fail)
end function

'This function builds an array full of the errors that were contained in the array
'created by RegisterForm. If the IsArray(errors) then the form contained errors.
function CheckForm()
set regex = new regexp
regex.Global = true
regex.IgnoreCase = true

if IsArray(forms) then
for frmctr = 0 to ubound(forms)
regex.Pattern = forms(frmctr)(1)
if not regex.Test(request.form(forms(frmctr)(0))) then
err = RegisterError(forms(frmctr)(0),forms(frmctr)(2),forms(frmctr)(3))
end if
next
end if
end function
%>

14. Here is a function i created to open a ASP file and execute its contents (instead of using an Include):

Code:
Function GetConfig(strConfigFilePath)
'Get the new settings
Dim fso
Dim stream
Dim strConfigText

Set fso = Server.CreateObject("Scripting.FileSystemObject")

Set stream = fso.OpenTextFile(strConfigFilePath)

stream.Close
Set stream = Nothing
Set fso = Nothing

'Remove open and close ASP tags
strConfigText = Replace(strConfigText, "<" & "%", "")
strConfigText = Replace(strConfigText, "%" & ">", "")

Execute strConfigText
End Function
To use:

Code:
Call GetConfig(Server.MapPath("aspfile.asp"))

15. But this function won't work if the file its gonna execute doesn't contain only ASP code, is it?

16. reformatting bbcode tags

Excuse me if I'm way off here. I've only had one cup of coffee so far and my brain isn't up to speed yet but couldn't you use Server.Execute() instead?

Code ASP:
<%
include = aspfile.asp
Server.Execute(include)
%>

17. asp_funda,
The page has to be pure ASP code or it will error out.

awasson,

The problem with Server.Execute() is that it just executes the code, but you can not use any of the variables or functions within your page that you are executing it.

18. Of course

I ran into that problem about a month ago and ended up using includes and calling the subroutines. I'll have to play around with that function of yours.

Thanks,

19. Keyword Function

This is a clunky function I wrote to strip out the keywords from common search engine referrals to my site, as per this article:

Code ASP:
<%
''---------------------------------------------------
''SPLIT OUT THE KEYWORDS
''---------------------------------------------------

Function keywords(str)

fr = str
fr_len = len(fr)

str_y =    InStr(fr,"yahoo")
str_m =    InStr(fr,"msn")
str_a =    InStr(fr,"aol")

if str_g > 0 then tag = "google"
if str_y > 0 then tag = "yahoo"
if str_w > 0 then tag = "wanadoo"
if str_m > 0 then tag = "msn"
if str_a > 0 then tag = "aol"

if str_g = 0 AND str_y = 0 AND str_w = 0 AND str_m = 0 AND str_a = 0 then
keywords = "<a href="""&str&""">" &left(fr,50)& "</a>"
end if

mail =     InStr(fr,"mail")

if str_g > 0 OR str_w > 0 OR str_m > 0 then qs = "q=" AND offset = 1
if str_y > 0 then qs = "p=" AND offset = 1
if str_a > 0 then qs = "query=" AND offset = 5

if str_g > 0 OR str_w > 0 OR str_m > 0 OR str_y > 0 then
offset = 1
else
offset = 5
end if

if (str_g>0 OR str_y>0 OR str_w>0 OR str_m>0 OR str_a>0) AND mail = 0 then

a01 = instr(fr,qs)
a02 = instr(fr,"&")

a2 = right(fr,(fr_len-a01)-offset)
a3 = instr(a2,"&")

if a3 > 0 then
a4 = len(a2)
a5 = left(a2,a3-1)
a6 = replace(a5,"+"," ")
else
a6 = replace(a2,"+"," ")
end if

keywords = "<a href="""&str&""">" & tag & "</a> - " & a6

end if

End Function
%>

Clean Form Data

I use this one a lot to "clean" form data before putting it into the db:

Code ASP:
Function newstr(str)
newstr = Server.HTMLencode(str)
newstr = Replace(newstr, "'","''")
newstr = Replace(newstr, "\","\\")
newstr = Replace(newstr, chr(10), "<br />")
End Function

e.g. form_description = newstr(request.form("form_stuff")

Debug

I use this one quite a lot to debug variables:

Code ASP:
Sub debug( varName )
Dim varValue
varValue = Eval( varName )
response.write "<p style=""border-bottom:1px solid #ccc;border-top:1px solid #eaeaea;background-color:white;padding:10px;color:red;text-align:left;""><strong>" & varName & "</strong>: " & varvalue & "</p>"
End Sub

e.g.

the_date = now()
debug "the_date"

I know I could just use:

response.write "the_date: " & the_date

but my way seemed a bit quicker

And finally, I use the following to conver hyperlinks into clickable links. It originates from here:
http://www.4guysfromrolla.com/webtec...110900-1.shtml

And I just tweaked it a bit to produce a sensible length of URL if the URL is over 50 chars, and also to not convert email addresses to hyperlinks, but instead convert them to "bob [at] site [dot] com" formats

Code ASP:
'----------------------------------------------
'URL function
'----------------------------------------------

Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd

strBuf = ""
iStart = 1
iEnd = 1
Set objRegExp = New RegExp

objRegExp.Pattern = "\b(www|http|\S+@)\S+\b"  ' Match URLs and emails
objRegExp.IgnoreCase = True                   ' Set case insensitivity.
objRegExp.Global = True                       ' Set global applicability.
Set objMatches = objRegExp.Execute(inText)
For Each objMatch in objMatches
iEnd = objMatch.FirstIndex
strBuf = strBuf & Mid(inText, iStart, iEnd-iStart+1)
If InStr(1, objMatch.Value, "@") Then
strBuf = strBuf & GetHref(objMatch.Value, "EMAIL", "_BLANK")
Else
strBuf = strBuf & GetHref(objMatch.Value, "WEB", "_BLANK")
End If
iStart = iEnd+objMatch.Length+1
Next
strBuf = strBuf & Mid(inText, iStart)
End Function

Function GetHref(url, urlType, Target)
Dim strBuf

lenurl = len(url)
if lenurl > 50 then
lenurl1 = left(url,40)
lenurl2 = right(url,10)
url2 = lenurl1 & "..." & lenurl2
else
url2 = url
end if
strBuf = "<b><a href="""
If UCase(urlType) = "WEB" Then
If LCase(Left(url, 3)) = "www" Then
strBuf = "<a href=""http://" & url & """>" & url2 & "</a>"
Else
strBuf = "<a href=""" & url & """>" & url2 & "</a>"
End If
ElseIf UCase(urlType) = "EMAIL" Then
strBuf = url
strBuf = Replace(strBuf, "@", " [at] " )
strBuf = Replace(strBuf, "."," [dot] ")
strBuf = "<strong>" & strBuf & "</strong>"
End If

GetHref = strBuf

End Function

20. In the spirit of sharing, here are a couple of scripts that don't seem to be on here yet

Decodes a URL encoded string
Code ASP:
Function GUrlDecode (ByVal arg)
Dim Pos, pPos

arg = Replace(arg, "+", " ")

On Error Resume Next
Dim Stream: Set Stream = CreateObject("ADODB.Stream")
If err = 0 Then
On Error GoTo 0
Stream.Type = 2 'String
Stream.Open

Pos = InStr(1, arg, "%")
pPos = 1
Do While Pos > 0
Stream.WriteText Mid(arg, pPos, Pos - pPos) + _
Chr(CLng("&H" & Mid(arg, Pos + 1, 2)))
pPos = Pos + 3
Pos = InStr(pPos, arg, "%")
Loop
Stream.WriteText Mid(arg, pPos)

Stream.Position = 0

Stream.Close
Else
on error goto 0
Pos = InStr(1, arg, "%")
Do While Pos>0
arg = Left(arg, Pos-1) + _
Chr(Clng("&H" & Mid(arg, Pos+1, 2))) + _
Mid(arg, Pos+3)
Pos = InStr(Pos+1, arg, "%")
Loop
GUrlDecode = arg
End If
End Function

Adds working days to a date
Code ASP:
Function GDateAddWorkingDays(ByVal intDays, ByVal dtmDate)

Dim dtmReturnDate		' We return this date
Dim intDayCount			' Loop counter
Dim intUnit				' Either +1 day or -1 day

If intDays >= 0 Then
intUnit = +1
Else
intUnit = -1
End If

If IsNumeric( intDays ) AND IsDate( dtmDate ) Then

intDays			= Abs( intDays )
intDayCount		= 0
dtmReturnDate	= dtmDate

Do Until( intDayCount >= intDays ) AND GIsWorkingDay( dtmReturnDate )
If GIsWorkingDay( dtmReturnDate ) Then
intDayCount = intDayCount + 1
End If
Loop
Else
dtmReturnDate = False
End If

End Function

Checks to see if a date is a working day
Code ASP:
Function GIsWorkingDay( ByVal dateToCheck )
Dim theDay

theDay = Weekday( dateToCheck )

If theDay = vbSaturday Or theDay = vbSunday Then
GIsWorkingDay = False
Else
GIsWorkingDay = True
End If

End Function

I also saw a post on here about executing a file, well the function below will handle files that aren't 100% asp code. Any none asp code is wrapped by a response.write

Execute a file
Code ASP:
'=======================================================
' Get file contents
'=======================================================

Function getFileContents(strFilename)
'response.write "-Openfile-"

' Setup File System Object
Dim fso
Set fso = Server.CreateObject("Scripting.FilesystemObject")

' Open Text File
Dim ts

ts.close

' Clean Up
Set ts = nothing
Set fso = Nothing
End Function

'=======================================================
' Convert a string to ASP code
'=======================================================

Function convertStringToASP(strContents)

' Declare Variables
Dim output, pos1, pos2, before, middle, after

' Setup variables
output = ""

' Find First ASP Start Tag
pos1 = instr(strContents,"<%")

' Find First ASP End Tag
pos2 = instr(strContents,"%"& ">")

' Start Tag Exists
if pos1 > 0 then

' Get Plain Text Before ASP Start Tag
before = mid(strContents, 1, pos1-1)

' Remove Line Breaks
before = Replace(Replace(before, """", """"""), vbcrlf, """& vbcrlf & _"& vbcrlf &"""")

' Build ASP String
If before <> "" Then
before = vbcrlf &"Response.Write """& before &""""& vbcrlf
End If

' Get ASP Code Between ASP Start & End Tags
middle = mid(strContents, pos1+2,(pos2-pos1-2))

If Left(middle, 1) = "=" Then
middle = "Response.Write "& Right(middle, Len(middle)-1)
End If

' Get Plain Text After ASP End Tag
after = mid(strContents, pos2+2, len(strContents))

' Recurse Through Remaining String
output = before & middle & convertStringToASP(after)

' No ASP Start Tag Found
else
If LTrim(RTrim(strContents)) <> "" Then
' Remove Line Breaks
strContents = Replace(Replace(strContents, """", """"""), vbcrlf, """& vbcrlf & _"& vbcrlf &"""")
output = vbcrlf &"Response.Write """& strContents &""""& vbcrlf & "Response.Flush()"
End If
end if

' Return Output
convertStringToASP = output

End Function

'=======================================================
' Execute a file from within an ASP page
'=======================================================

Function executeFile(strFilename)

' Declare Variables
Dim strContents

strContents = getFileContents(strFilename)

' Convert To ASP
strContents = convertStringToASP(strContents)

'Response.Write(strContents)

' Execute
execute(strContents)

End Function

Hopefully they are pretty self explanatory

21. Haven't seen this one posted here, but maybe useful:

Code ASP:
Function PadLeft(sString, nReturnLength, sPadChar)
''============================
'' pad string with zeros (0's) or other char

If nReturnLength > Len(sString) Then
Else
End If

End Function

Code VB:
FUNCTION addToQuerystring(qs,param,value)
Dim newqs, amp
IF isNull(qs) THEN qs = "" END IF
IF Len(qs) = 0 THEN
amp = ""
ELSE
amp = "&"
END IF
addToQuerystring = qs & amp & param & "=" & value
END FUNCTION

Remove from query string.

Code VB:
FUNCTION removeFromQuerystring(qs,param)
Dim arrQS,pair,newqs, arrPairs
arrQS = split(qs,"&")
FOR EACH pair IN arrQS
arrPairs = split(pair,"=")
IF arrPairs(0) <> param THEN
newqs = newqs & pair & "&"
END IF
NEXT
IF Len(newqs) > 0 THEN
newqs = Left(newqs, Len(newqs)-1)
END IF
removeFromQuerystring = newqs
END FUNCTION

23. In Array Function

I found the following function at: http://www.visualbasicscript.com/m41079.aspx

I though this was a unique way to check an array because rather than taking an obvious approach of looping through the array it uses InStr().

It takes an array and a key and returns a boolean (true/false) if the key is found in the array.

Code ASP:
Function InArray(oItem,sSearchString)
InArray = False
If IsNull(sSearchString) OR IsNull(oItem) Then Exit Function End If
If IsArray(oItem) Then
If InStr(LCase(Chr(7)&Join(oItem,Chr(7))&Chr(7)),Chr(7) & LCase(sSearchString) & Chr(7)) <> 0 Then InArray = True
Else
If InStr(LCase(oItem),LCase(sSearchString)) <> 0 Then InArray = True
End If
End Function

24. Here's a neat little snippet that I found sometime ago when all the SQL injections were being attempted on our webiste. Hopefully you will find this useful.

Code ASP:
<%
function cleanInput(str)
dim re
set re = new RegExp
'(</?(?:u|i|b|a\s+href="[^">]*"|(?<=/)a)>)|</?[^>]*>
re.Pattern = "[^0-9a-zA-Z\s\@\:\.\,\-\_\!\?\+]"
re.Global = True
cleanInput = re.Replace(str, "")
set re = nothing
end function
%>

used like this:

I use them for all form submissions
Code ASP:
<%MyValue=cleanInput(Request.Form("SubmittedVariable"))%>`

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•