ASP Code Snippets

Some useful code if you ever have to use ASP, for some reason :), who knows...

ASP Basics

- To put on top of each page

      <%@ Language="VBScript" %>
      <% Option Explicit %>

- Quick rules  

      - Comments begin with '
      - No semicolons to end a line
      - To continue a statement to a second line use the symbol: "_" at the end of the line
      - To concatenate strings use this symbol: & (ampersand)
      

- Variables  

      Every variable must be declared if you use Option Explicit, 
      otherwise an error will be generated
      
      Dim myvariable  '1st way to declare a variable
      myvariable = 1
      
      Dim myvariable:myvariable = 1  'second way of declaring and assigning a variable
      
      Dim obj
      set obj = MyObject.new 	'declaring and instantiating an object (using set for objects!!)

- Redirect to other pages

      Response.redirect("url to redirect to.asp")
      
      Some IIS implementations allwo Response.Transfer
      
      Response.transfer( "aurl.asp")
  
      (difference of Response.redirect and Response.Transfer form ASP.net perspective:
      http://haacked.com/archive/2004/10/06/ResponseRedirectVerseServerTransfer.aspx

      
- Functions and subprocedures
      
      'A function returns a value. There's no "return" keyword, so to return just equal the 
      'value to return to the function's name
      
      'Arguments can be passed by value (default) or by reference
      
      public function functionTest1( byval arg1, byval arg2, byref arg3 )
          
          'do some stuff...
          
          functionTest1 = "value to return"
      
      end function

Escaping characters for html display

	
dim escapeHTML
escapeHTML =  Server.HTMLEncode(value)

Constants and arrays (one and two dimensions)

	
- Constants example:

   Const EXAMPLE_CONSTANT1 = 1
   Const EXAMPLE_CONSTANT2 = "Some string"
   
- creating an array

   dim list1(9)  'this array can have subscript form 0 to 9 (10 elements in total)

- resizable arrays (redim)

   dim list()
   redim list(0)   'initially reisze an array to 0

   list(0) = "ele1"
   redim preserve list(1)   'use redim preserve to resize without losing data
 
   list(1) = "ele2"   'and so on

- Example of 2 dimensional array

   Dim menu1(7,18)

- Iterating through the elements of an array.

    'This array has 5 elements, from 0 to 4

    dim list2(4)  
	
    list2(0) = "a"
    list2(1)= "b"
    list2(2)= "c"
    list2(3)= "d"
    list2(4)= "e"

- UBound and size of arrays

  ubound gives the largets subscript avaiable for the array, not the number of elements (upper bound)

    dim z
    for z=0 to ubound( list2 ) 
	response.write("ele: " & list2(z)  )
    next


- 2 dimensional arrays

     Dim matrix1(1,2)	
     matrix1(0,0) = 1
     matrix1(0,1) = "entry 1"
     matrix1(0,2) = "ABC"	

     matrix1(0,0) = 2
     matrix1(0,1) = "entry 2"
     matrix1(0,2) = "DEF"

     dim z,i
     for z=0 to ubound( matrix1)	  'gives ubound of 1st dimension
		 for i=0 to ubound( matrix1, 2)   'gives ubound of 2nd dimension
			response.write("-----" & matrix1(z,i) & "---<br>" )
		next
     next

Including external files

	
	'normal include	
	<!-- #include file="includes/header.asp" -->	

	'virtual include
	<!-- #include virtual="/includes/header.asp" -->

Preventing Page caching: Forcing the browser not to cache a page

	
	Response.Expires = -1
	Response.Expiresabsolute = Now() - 1
	Response.AddHeader "pragma","no-cache"
	Response.AddHeader "cache-control","private"
	Response.CacheControl = "no-cache"

Sending emails with CDO and CDONTS

	

- Emails using CDO (Prefered way)
			
    public function sendEmailCDO(  fromemail, fromname, toemail, subject, content, ccemail  )
			
                dim sch:sch = "http://schemas.microsoft.com/cdo/configuration/" 
                dim cdoConfig, cdoMessage
                Set cdoConfig = CreateObject("CDO.Configuration") 
                
                With cdoConfig.Fields 
                  .Item(sch & "sendusing") = 2 ' cdoSendUsingPort 
                  .Item(sch & "smtpserver") = "localhost" 
                  .update 
                End With 
                
                  
                'replace newlines with br tags
                 content = Replace(  content , chr(10), "<br />")
                
                
                Set cdoMessage = CreateObject("CDO.Message") 
                
                With cdoMessage 
                  Set .Configuration = cdoConfig 
                  '.From = fromemail & " <" & fromname & ">"
                  .From = fromemail 
                  .To = toemail
                  .Subject = subject
                  .Cc = ccemail
                  '.TextBody = content
                  
                  .HTMLBody = content
                  on error resume next
                  .Send 
                  
                  If Err.Number <> 0 then
                    sendEmail2 = Err.Description  'error desription
                    Error.Clear
                    exit function
                  End If
                  
                End With 
                
                Set cdoMessage = Nothing 
                Set cdoConfig = Nothing 
                
                
                sendEmailCDO = ""
           
    
    end function


- Emails using CDONTS    
  
  public function sendCDONTS(  fromemail, fromname, toemail, subject, content  )
  
              'on error resume next
              
              'create object
              Dim ObjMail
              Set ObjMail = Server.CreateObject("CDONTS.NewMail")
              
              'prepare email fields
              objMail.From = fromemail & " <" & fromname & ">"
              objMail.To = toemail
              objMail.Subject = subject
              objMail.Body =  content  
               
              objMail.Send
              
              Set objMail = Nothing
              
              sendCDONTS = ""
              
    end function

Creating and using dictionaries

	
  dim dictionary1
  set dictionary1 = CreateObject("Scripting.Dictionary") 

  - storing values
  
	dictionary1('akey') = 'avalue'
  
  - to retrive a value
  
   dim temp
   temp = dictionary1('akey')

Getting Request POST and GET values


- Get a variable through POST or GET

  'This function tries to get a parameter from POST first and then from GET.
  'POST has precendence in the function. Can return empty if the parameter was not sent.

      function getParameter( varToRead )
      
                Dim aval
                
                'Try go get parameter from POST
                aval = Request.Form( varToRead  )
                
                if ( aval = "" ) then
                      'If the post was empty, try reading it from the get
                       aval = Request.QueryString( varToRead )   
                end if
    
                getParameter =  aval ' return a value or empty
               
      end function
	
- Showing sent POST values    
		
      dim ix, formElementName, formElementValue
      
      For ix = 1 to Request.Form.Count
      
        formElementName = Request.Form.Key(ix)
        formElementValue = Request.Form.Item(ix) 
        response.write("Received " & formElementName & "=" & formElementValue & "<br>" & vbcrlf )
        
      next

Testing regular expressions

  
- Function to test regular expression


      Function isCorrectRE( value, pattern, acase )
      
                RegExpTest = false
                Dim regEx, retVal
                Set regEx = New RegExp
                
                ' Create regular expression:
                regEx.Pattern = pattern 
                
                ' Set pattern:
                regEx.IgnoreCase = acase
                
                ' Set case sensitivity.
                retVal = regEx.Test( value)
                
                If not retVal Then
                  isCorrectRE = false
                exit function
                End If
                
                isCorrectRE = true
      
      End Function

- Regular expressions examples
      
        'testing 5 digits zip code
        isCorrectRE( value, "^[\d]{5}$" , true )
        
        'testing us phone format
        isCorrectRE( value, "^[\d]{3}-[\d]{3}-[\d]{4}$" , true )		
        
        'testing email address (no ip testing!!!)
        isCorrectRE( value, "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,4}$", true )

Reading text files

	
- reading a text file (line by line) using Scripting.FileSystemObject

    dim fs, wfile, aline
    Set fs = CreateObject("Scripting.FileSystemObject")

    response.write("will open file: " & file & "<br>")
    Set wfile = fs.OpenTextFile(file) 


    do while not wfile.AtEndOfStream 

        aline= trim( wfile.readline )
        response.write("line: " & aline )
        
   loop 

   wfile.close 
   Set wfile=nothing 
   Set fs=nothing

Writing text files


- Writing a file using Scripting.FileSystemObject

      dim oFs
      set oFs = server.createobject("Scripting.FileSystemObject")
      dim oTextFile
          
      set oTextFile = oFs.OpenTextFile( "c:\myfile1.txt" , 2, True)
      
      oTextFile.Write "aline"
      
      oTextFile.Close
          
      set oTextFile = nothing
      set oFS = nothing

XML - writing documents 

	

- Xml writing using Microsoft.XMLDOM

        response.contentType = "text/xml"	

        dim obj, objRoot, objPI,ele
        Set obj = Server.CreateObject("Microsoft.XMLDOM")
        
        Set objRoot = obj.createElement("items")
        obj.appendChild objRoot
        
        dim c1
        Set c1 = obj.createElement("item")
        objRoot.appendChild c1	
        
        dim ele1
        set ele1 = obj.createElement("name")
        ele1.text = "item1 name goes here"
        c1.appendChild( ele1 )
        
        dim c2
        Set c2 = obj.createElement("item")
        objRoot.appendChild c2	
        
        
        dim ele2
        set ele2 = obj.createElement("name")
        ele2.text = "item2 name goes here"
        c2.appendChild( ele2 )
        
        
        Set objPI = obj.createProcessingInstruction("xml","version='1.0'")
        
        obj.insertBefore objPI, obj.childNodes(0)
        
        obj.save( response )  'write to the response output stream   
        
        
        OUTPUT
        
        <?xml version="1.0"?>
          <items>
              <item>
                  <name>item1 name goes here</name>
               </item>
               <item>
                   <name>item2 name goes here</name>
               </item>
        </items>

XML reading (parsing)


      This can be used to parse a xml string, like one returned by a REST web service
  
      dim strGetString,objHTTP, objXML , i, items
      set objHTTP = Server.CreateObject("Microsoft.XMLHTTP")
      
      objHTTP.open "GET", "http://someserver.com/rest1", false
      objHTTP.Send
      Set objXML = objHTTP.ResponseXML
      
      
      set items = objXML.getElementsByTagName("item")

      for  i=0 to items.length - 1
      
          'get the name value for instance (assuming position 0)
          
          dim val:val = ""
          if (  items(i).childNodes(0).childNodes.length > 0 ) then
              val = items(i).childNodes(0).childNodes(0).nodeValue  
              response.write("Got name: " & val & "<br>" )
          end if
      
      
      next

String Manipulation

	
- XReplace new lines with html <br> tags

      'replace newlines with br tags
      content = Replace(  content , chr(10), "<br />")

Database connections, queries, etc

	
- Open a ADODB Conneciton

          dim Conn,aconnectionString
          aconnectionString ="your custom connection string goes here..."
          
          'example connection string: 
            
          aconnectionString =  "PROVIDER=SQLOLEDB;" & _
                               "data source=db;" & _	
                               "persist security info=False;" &_
                               "initial catalog=database1name;" & _
                               "user id=someuser;" & _
                               "password=somepass;"
          
          
          set Conn = server.createobject("ADODB.Connection")
          me.Conn.open aconnectionString
          If Err.Number <> 0 then
              response.write( "there was an " &  Err.description )
          end if
    
          '--execute a query here!!
    
          Conn.Close
          set me.Conn = Nothing
          
- Executing a sql query and getting a Recordset

          'Conn mus be a valid and open db connection
          (watch out for sql injection!!!)
 
          dim rs, sql
          sql = "select * from sometable"
          set rs = Server.CreateObject("ADODB.recordset")
          rs.Open sql, Conn

- Executing a sql non-query          
          
          dim sql:sql = "Delete from loans where loan_id < 20"
          'Execute non-query statements
          Conn.Execute sql, -1, -1	

- Executing Stored procedures as sql          

          dim sql
          'execute stored procedure
          sql = "exec someProc1(..)"
          Conn.Execute sql, -1, 4

- Iterating through the rows of a recordset

          'rs must be a valid/open recordset
  
          'iterating a recordset
          dim temp
          Do While Not rs.EOF
              temp = rs.Fields("avalue").value  'getting a value from a recordset
              rs.MoveNext
          loop

- Showing a recordset using a html table

          Response.Write "<P><TABLE BORDER=0 cellpadding=""0"" cellspacing=""0""   >" & vbCrLf
          Response.Write "<TR>" & vbCrLf
          
          ' -- Make a table column for each field in the query
          For intFields = 0 to rstData.Fields.Count - 1
              Response.Write "<TD class=""header"">" & rs.Fields(intFields).Name & "</TD>" & vbCrLf
          Next
          
          Do While Not rs.EOF
                Response.Write "<TR>" & vbCrLf
                ' -- Display the value for each field in the query
          
                For intFields = 0 to rs.Fields.Count - 1
                    value =   rs.Fields(intFields).Value 
                    if ( isNull( value) )then
                        value = " "
                    end if
                    Response.Write "<TD>" & value & "</TD>" &	vbCrLf
                Next
                Response.Write "</TR>" & vbCrLf
                rs.MoveNext
          loop
          
          Response.Write "</table>"


- Examples of query strings for some databases
   
      - SQL Server 2000

      dim connstr1:connstr1 =  "PROVIDER=SQLOLEDB;" & _
                               "data source=db;" & _	
                               "persist security info=False;" &_
                               "initial catalog=database1name;" & _
                               "user id=someuser;" & _
                               "password=somepass;"
      
      - Oracle Connection Example

      
      'There must be a service name defined in the tnsnames.ora file for this to work

      dim  connstr2:connstr2 = "Driver={Microsoft ODBC for Oracle};" & _
                               "Server=SERVICE_NAME_IN_TNSNAMES_ORA_FILE;" & _
                               "Uid=someuser;" & _
                               "Pwd=somepass;"

      Links:
      http://www.mavweb.net/asp-samples/database-connection-strings.asp

      
      
- getting last insert identity column (sql server) or next sequence (oracle)

      
        'Asumming valid/open recordset rs
        'a recordset object!
        
        dim rs
        set rs = query( "Select @@IDENTITY as avalue")
        getIdentityColumnSQLServer = rs.Fields("avalue").value
        
        
        dim rs
        set rs = query( "Select " & asequence & ".NEXTVAL as avalue from dual")
        getOracleNextValSequence = rs.Fields("avalue").value
        rs.Close

Objects in Vbscript

	

- Class Example
          
          class MyObject1
          
              'public instance variables
              dim name
              dim age
          
              '----------------------------------------------------------------------------
              ' 0-argument constructor. Similar to asp.net sub new, but can't receive arguments
              '----------------------------------------------------------------------------
          
              public sub class_Initialize   
                  me.name = "cris"
                  me.age = 28	
              end sub
          
              '
              public sub instanceMethod1
                  response.write("my name is " & me.name )
              end sub
          
              '		
              public function instanceMethod2
          
              end function
          
       end class


- Using the class example
       
      'INSTANTIATING AN OBJECT
      
      dim temp
      set temp = new MyObject1
      temp.name = "someoneelse"
      temp.instanceMethod1

Dates and Time functions

	

- Get current date in ANSI format

      public function getDateANSI()
      
            dim toreturn
            dim d, m, y
            
            y = DatePart("yyyy", Now())
            m = DatePart("m", Now())
            d = DatePart("d", Now())
        
            if ( m < 10 ) then
                m = "0" & m
            end if
        
            if ( d < 10) then
              d = "0" & d
            end if
              
        
            getDateANSI = y & "-" & m  & "-" & d
            
      end function
      

- Time formatting example      
      
      public function getTime1
      
            dim toreturn
            dim d:d = "."
      
            toreturn = DatePart("yyyy", Now()) & d & Da tePart("m", Now()) & d & _
                      DatePart("d", Now()) & d & DatePart("h", Now()) & d & DatePart("n", Now()) & _
                      d & DatePart("s", Now())  
      
            getTime1 = toreturn
            
      end function

Random functions

	
- Function that returns a random value between two numbers 

        'random function 
        
        function getRandom( min, max ) 
        
                  Randomize
                  dim val
                  dim diff
                  
                  diff = max - min
                  
                  val = (int)( diff * Rnd() )  
                  
                  getRandom  = min + val
            
        end function

- Function that returns a random string of variable size using the above getRandom function         
        
	
        function randomString1( size )
        
              dim atype, i
              dim buffer
              buffer = ""
        
              for i=0 to size -1
                  atype = getRandom( 1, 3)  'get a number between 1 and 2 inclusive
                  if atype = 1 then  'numbers
                      buffer = buffer + chr( getRandom( 65, 91 ) )
                  elseif atype = 2 then 'letters
                      buffer = buffer + chr( getRandom( 48, 58 ) )
                  end if
              next
        
              randomString1 = buffer  'this is how values are returned from functions (no return keyword!!)
        
        end function

Cookies

	
- Setting a cookie        
          
        Response.Cookies("username") = "earthskater"
        Response.Cookies("username").Expires = Date + 365
        
        'In the example above a cookie named "username" was created.
        'Then the expiry date was set using the Expires property. The cookie was set to 
        'expire 1 year from the days date. 
        'When the cookie expires it is deleted from the user's Web computer. 
        
- Retrieving cookies         
            
        'To retrieve cookies we use Request.Cookies. 
        
        username = Request.Cookies("username")
        response.write("Username: " & username)
       
- Cookies arrays           
        
        'set array
        
        Response.Cookies("user")("realname") = "John Doe"
        Response.Cookies("user")("username") = "johnny55"
        Response.Cookies("user")("age") = "55"
        
        'get values back
        
        realname = Response.Cookies("user")("realname")
        username = Response.Cookies("user")("username")
        age = Response.Cookies("user")("age")
          
- Show all cookies found for current user          
       
       
        Dim x,y
        
        For Each x in Request.Cookies
        
                Response.Write("<p>")
                If Request.Cookies(x).HasKeys Then
                
                      For Each y in Request.Cookies(x)
                      Response.Write(x & ":" & y & "=" & Request.Cookies(x)(y))
                      Response.Write("<br />")
                      Next
                      
                Else
                      Response.Write(x & "=" & Request.Cookies(x) & "<br />")
                End If
                
                Response.Write "</p>"
                
        Next

Sessions

	
  Session Reference page

- Setting a session variable        
          
        Session("username")="cristhian"
        Session("age")=28

- Removing session variables

        Session.Contents.Remove("username")

- Removing ALL session variables

      Session.Contents.RemoveAll()
      
- Show all variables in the session      

      dim i
      For Each i in Session.Contents
          Response.Write(i & "<br />")
      Next

      
      'OR
      
      dim i
      dim j
      j=Session.Contents.Count
      Response.Write("Session variables: " & j)
      For i=1 to j
          Response.Write(Session.Contents(i) & "<br />")
      Next

ASP code to force a file download


- Sending a  File to the user for download  (small files. Can have response buffer overflow)       

        Reference:
        
        http://psacake.com/web/if.asp
        
        Response.Buffer = True
        Dim strFilePath, strFileSize, strFileName
        
        Const adTypeBinary = 1
        
        strFilePath = "C:\ whatever the path is "
        strFileSize = ... the size of file .. optional
        strFileName = "the file name" 
        
        Response.Clear
        
        '*******************************8
        ' Requires MDAC 2.5 to be stable
        '*******************************8
        
        Set objStream = Server.CreateObject("ADODB.Stream")
        objStream.Open
        objStream.Type = adTypeBinary
        objStream.LoadFromFile strFilePath
        
        strFileType = lcase(Right(strFileName, 4))
                
        'Add more type handlers if necessary
        Select Case strFileType
              Case ".xls"
                  ContentType = "application/vnd.ms-excel"
              Case Else
                  'Handle All Other Files
                  ContentType = "application/octet-stream"
        End Select
        
        Response.AddHeader "Content-Disposition", "attachment; filename= strFileName
        Response.AddHeader "Content-Length", strFileSize
        
        
        Response.Charset = "UTF-8"
        Response.ContentType = ContentType
        
        Response.BinaryWrite objStream.Read
        Response.Flush
        
        objStream.Close
        Set objStream = Nothing
        
        
- Sending a  File to the user for download  (BIG FIlES, reading chunks at a time to avoid overflow)             


        'Send headers and show file

          dim ContentType
          dim strFilePath 
          dim strFileName  
          dim strFileNameAlias 'for the client only
          dim strFileSize
          const adTypeBinary = 1
          dim relativePath

          strFilePath  = "localtion of the file, example C:\files\"
          strFileName   = "Filename, example: bigmovie.mpeg"
          strFileNameAlias  = "movie1"
          

          '*******************************8
          ' Requires MDAC 2.5 to be stable
          '*******************************8

            dim objStream
            Set objStream = Server.CreateObject("ADODB.Stream")
            objStream.Open
            objStream.Type = adTypeBinary
            objStream.LoadFromFile   strFilePath  &  strFileName
            dim chunk:chunk = 2048  'define chuncks to read from file

            dim	iSz:iSz = objStream.Size   'total size of file



            ContentType = "application/octet-stream"



            Response.Charset = "UTF-8"
            Response.ContentType = ContentType
            Response.AddHeader "Content-Disposition", "attachment; filename= " & strFileNameAlias
            Response.AddHeader "Content-length", iSz
            'on error resume next
            

            'Read only certain bytes at a time, then flush response and keep reading next chunck

            dim i
            For i = 1 To iSz \ chunk 
                    If Not Response.IsClientConnected Then Exit For 
                    Response.BinaryWrite objStream.Read(chunk) 
                    Response.Flush
            Next 

            'Write remaining portion of file
            
            If iSz Mod chunk > 0 Then 
                  If Response.IsClientConnected Then 
                        Response.BinaryWrite objStream.Read(iSz Mod chunk)
                  Response.Flush
            
            End If 

            objStream.Close
            Set objStream = Nothing