SitePoint Sponsor

User Tag List

Page 5 of 6 FirstFirst 123456 LastLast
Results 101 to 125 of 127
  1. #101
    SitePoint Enthusiast
    Join Date
    Sep 2004
    Location
    california, usa
    Posts
    50
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    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(3) = "deadbeef0123456789bad"
    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
    deadbeef0123456789bad : 1.68251264662152E+25
    : -2
    : -2
    hex : -1

  2. #102
    ♪♪ ♪ ♪ ♪ ♪♪ ♪ ♪♪ Markdidj's Avatar
    Join Date
    Sep 2002
    Location
    Bournemouth, South UK
    Posts
    1,551
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Faster reading of text files

    Just a little tip......

    Text files are slow to read when using the
    Code:
    do while textFileOpen.AtEndOfStream=false
    text=textFileOpen.readline
    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
    LiveScript: Putting the "Live" Back into JavaScript
    if live output_as_javascript else output_as_html end if

  3. #103
    SitePoint Member
    Join Date
    Nov 2004
    Location
    India
    Posts
    9
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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. #104
    SitePoint Member
    Join Date
    Jan 2005
    Location
    Northern Ireland
    Posts
    3
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Get the user name only (drop domain name)

    one line version:
    useridonly = MID(request.servervariables("LOGON_USER"), INSTR(USername,"\")+1, LEN(request.servervariables("LOGON_USER")))


    USername = request.servervariables("LOGON_USER") ' Get the username
    Lenusername = LEN(USername) ' get the length of the username
    findslashinst = INSTR(USername,"\") 'find out where abouts the \ is
    findslashinst = findslashinst + 1 ' increment the value so it starts where the actual userid is.
    useridonly = MID(USername, findslashinst,lenusername) ' extract the userid only

  5. #105
    Also available in Large Si's Avatar
    Join Date
    Sep 2002
    Location
    Walsall, UK
    Posts
    1,911
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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)
    Si
    Are you a Photoshop Jedi Master? Prove it!

    Is funky house your bag? You'll love this!

    Voice
    , eyes, ears, body and hands.


  6. #106
    SitePoint Enthusiast
    Join Date
    Feb 2005
    Posts
    53
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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 conn = CreateObject("ADODB.Connection")
    	Set cmd = CreateObject("ADODB.Command")
    	conn.Provider = "ADSDSOObject"
    	conn.Open "Active Directory Provider","DC=domainName,CN=ValidAccount","AccountPassword"
    	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.
    	'		 If there are any questions, suggestions, comments, or modifications made, 
    	'        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 "<thead>" & vbCrLf
    	Response.Write "<tr>" & vbCrLf
    	Response.Write "<th>Index</th>" & vbCrLf
    	Response.Write "<th>Value</th>" & vbCrLf
    	Response.Write "</tr>" & vbCrLf
    	Response.Write "</thead>" & 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. #107
    SitePoint Enthusiast wavman's Avatar
    Join Date
    Jul 2002
    Location
    Isle of Wight
    Posts
    59
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Red face

    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. #108
    SitePoint Wizard bronze trophy
    Join Date
    Oct 2001
    Location
    Vancouver BC Canada
    Posts
    2,037
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)
    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.
    Andrew Wasson | www.lunadesign.org
    Principal / Internet Development

  9. #109
    SitePoint Member mcjimbo's Avatar
    Join Date
    Mar 2005
    Location
    Milwaukee
    Posts
    14
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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. #110
    SitePoint Wizard
    Join Date
    Nov 2004
    Location
    Nelson BC
    Posts
    2,310
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    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. #111
    SitePoint Enthusiast
    Join Date
    Jun 2005
    Posts
    36
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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)
    	AddArray forms,array(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)
    	AddArray errors,array(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. #112
    SitePoint Evangelist asprookie's Avatar
    Join Date
    May 2005
    Posts
    539
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    I do I get it to work

    Quote 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
    
    		' Create the links
    		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. #113
    SitePoint Member
    Join Date
    Sep 2005
    Posts
    1
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Exclamation

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

    Quote 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
    
    
    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)
    	AddArray forms,array(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)
    	AddArray errors,array(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. #114
    SitePoint Addict MadDog's Avatar
    Join Date
    Aug 2002
    Location
    Oregon, USA
    Posts
    247
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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)
     
     	strConfigText = stream.ReadAll()
     
     	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"))
    Last edited by MadDog; Feb 10, 2006 at 13:08. Reason: updated code
    Drew Gauderman
    ASP/MSSQL/AJAX-Javascript/HTML/CSS Coder
    iPortalX The most secure FREE ASP portal!

  15. #115
    SitePoint Wizard silver trophybronze trophy asp_funda's Avatar
    Join Date
    Jun 2003
    Location
    ether
    Posts
    4,497
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Cool

    But this function won't work if the file its gonna execute doesn't contain only ASP code, is it?
    Our lives teach us who we are.
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Me - Photo Blog - Personal Blog - Dev Blog
    iG:Syntax Hiliter -- Colourize your code in WordPress!!

  16. #116
    SitePoint Wizard bronze trophy
    Join Date
    Oct 2001
    Location
    Vancouver BC Canada
    Posts
    2,037
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    reformatting bbcode tags

    MadDog,
    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)
    %>
    Last edited by Mittineague; Nov 15, 2010 at 22:50.
    Andrew Wasson | www.lunadesign.org
    Principal / Internet Development

  17. #117
    SitePoint Addict MadDog's Avatar
    Join Date
    Aug 2002
    Location
    Oregon, USA
    Posts
    247
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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.
    Drew Gauderman
    ASP/MSSQL/AJAX-Javascript/HTML/CSS Coder
    iPortalX The most secure FREE ASP portal!

  18. #118
    SitePoint Wizard bronze trophy
    Join Date
    Oct 2001
    Location
    Vancouver BC Canada
    Posts
    2,037
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)
    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,
    Andrew Wasson | www.lunadesign.org
    Principal / Internet Development

  19. #119
    SitePoint Evangelist
    Join Date
    Dec 2004
    Posts
    419
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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:
    <snip/> - broken link removed

    Code ASP:
    <%
    ''---------------------------------------------------
    ''SPLIT OUT THE KEYWORDS
    ''---------------------------------------------------
     
    Function keywords(str)
     
    	fr = str
    	fr_len = len(fr)
     
    	str_g =    InStr(fr,"google")
    	str_y =    InStr(fr,"yahoo")
    	str_w =    InStr(fr,"wanadoo")
    	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

    Convert Hyperlinks

    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
    '----------------------------------------------
     
    Function InsertHyperlinks(inText)
    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)
      InsertHyperlinks = strBuf
    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
    Last edited by Mittineague; Nov 15, 2010 at 22:44. Reason: reformatting bbcode tags

  20. #120
    SitePoint Member
    Join Date
    Feb 2007
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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
     
    		GUrlDecode = Stream.ReadText
     
    		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 )
    			dtmReturnDate = DateAdd("d", intUnit, dtmReturnDate)
    			If GIsWorkingDay( dtmReturnDate ) Then
    				intDayCount = intDayCount + 1
    			End If
    		Loop
    	Else
    		dtmReturnDate = False
    	End If
     
    	GDateAddWorkingDays = dtmReturnDate
     
    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-"
    	Const ForReading = 1
     
    	' Setup File System Object
    	Dim fso
    	Set fso = Server.CreateObject("Scripting.FilesystemObject")
     
    	' Open Text File
    	Dim ts
    	Set ts = fso.OpenTextFile(Server.MapPath(strFilename), ForReading)
     
    	' Read File Contents
    	getFileContents = ts.ReadAll
    	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
     
    	' Load File Contents
    	strContents = getFileContents(strFilename)
     
    	' Convert To ASP
    	strContents = convertStringToASP(strContents)
     
    	'Response.Write(strContents)
     
    	' Execute
    	execute(strContents)
     
    End Function

    Hopefully they are pretty self explanatory
    Last edited by Mittineague; Nov 15, 2010 at 22:35. Reason: reformatting bbcode tags

  21. #121
    SitePoint Zealot
    Join Date
    Nov 2001
    Location
    RI, USA
    Posts
    140
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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
      PadLeft = sString & String(nReturnLength - Len(sString), sPadChar)  
    Else
      PadLeft = Left(sString, nReturnLength)
    End If
     
    End Function
    Last edited by Mittineague; Nov 15, 2010 at 22:30. Reason: reformatting bbcode tags
    in1.com | Bootply - Bootstrap playground

  22. #122
    SitePoint Member gabru's Avatar
    Join Date
    Jul 2007
    Posts
    22
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    ajaxed Library - Free Ajax Library for classic ASP
    execute server side procedures directly from client side
    ajaxed - the first classic ASP Ajax Library

  23. #123
    SitePoint Member
    Join Date
    Mar 2009
    Location
    St Helens - Merseyside
    Posts
    4
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Add to query string.

    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

  24. #124
    SitePoint Wizard bronze trophy
    Join Date
    Oct 2001
    Location
    Vancouver BC Canada
    Posts
    2,037
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)
    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
    Last edited by Mittineague; Nov 15, 2010 at 22:24. Reason: reformatting bbcode tags
    Andrew Wasson | www.lunadesign.org
    Principal / Internet Development

  25. #125
    SitePoint Member
    Join Date
    Jan 2010
    Posts
    1
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    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"))%>
    Last edited by Mittineague; Nov 15, 2010 at 22:18. Reason: reformatting bbcode tags


Bookmarks

Posting Permissions

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