<%@ Language=VBScript %> <% ' sample from here 'http://www.4guysfromrolla.com/webtech/041600-2.shtml 'put the sessionid into this variable, get it from the QS, 'if the QS isnt available we will retrieve the SessionID from 'the database & put it into this variable 'dim ID 'ID = Request.Querystring("SessionID") '******************************* ' Function to clean up Strings * '******************************* ' SAMPLE/TEST 'theString = "Welcome Mike O'Conner" & chr(10) & " how is ya?" & chr(13) 'cleanString = dbCleanString(theString) 'Response.Write "Starting String: " & theString & "
" 'Response.Write "Cleaned String: " & cleanString & "
" Function dBCleanString(str) if not str = "" or not str = Null then cleanString = Replace(Str,chr(39),chr(39)& chr(39),1,-1,1) 'replace (') with ('') cleanString = Replace(cleanString,chr(10),"",1,-1,1) 'Replase LineFeed w/blank cleanString = Replace(cleanString,chr(13),"",1,-1,1) 'Replace CR w/Blank end if dBCleanString = cleanString end Function '******************************* ' Create a New Session in dB * '******************************* function newsession() set GUIDConn = Server.CreateObject ("ADODB.Connection") GUIDConn.ConnectionString = "driver={SQL Server};" & _ "server=Hugger;uid=webuser;pwd=asknow;" & _ "database=websitedata;" dim usripaddr usripaddr = request.servervariables("REMOTE_ADDR") MySQL = "Execute NewSession '" & usripaddr & "'" GUIDConn.Open SET ORS = GUIDConn.Execute (MySQL) newsession = ORS("SESSIONID") ORS.Close GUIDConn.Close 'set conn = nothing 'Response.Write "NewSession was Called" & newsession & "
" end function '************************************* ' Check the QuesryString for Session * '************************************* '############## EXAMPLE ############## ' checkqs(SESSIONID) '##################################### function checkqs(byVal sessionid) if sessionid = "" then set GUIDConn = Server.CreateObject ("ADODB.Connection") GUIDConn.ConnectionString = "driver={SQL Server};" & _ "server=Hugger;uid=WEBUSER;pwd=asknow;" & _ "database=WebSiteData;" GUIDConn.open 'the sessionid is gone, we need to retrieve it from the DB dim ipAddr ipAddr = Request.Servervariables("REMOTE_ADDR") dim mySQL mySQL = "Execute retrieve_GUID '" & ipAddr & "'" set ors = GUIDConn.execute (mySQL) ID = ors("SESSIONID") 'Response.Write ID & "
" If isEmpty(ID) then ID = newsession() 'Response.write "NewSession has Run
" end if 'Response.write "NewSession Did NOT run
" checkqs = ID ors.close GUIDConn.close Else checkqs = sessionid 'GUIDConn.close End If 'set conn = nothing 'Response.Write "checkqs " & checkqs & "
" end function '******************* ' Add Session Data * '******************* '####################### EXAMPLE ############################### 'input_session Request.Cookies("SessionID"), "VarName", "The'Value" '############################################################### function input_session(byVal Sessionid, byVal Dataname, ByVal Data) sessionid = checkqs(sessionid)'verify the session is active Dataname = dbCleanString(Dataname) Data = dbCleanString(Data) set GUIDConn = Server.CreateObject ("ADODB.Connection") GUIDConn.ConnectionString = "driver={SQL Server};" & _ "server=Hugger;uid=WEBUSER;pwd=asknow;" & _ "database=WebSiteData;" GUIDConn.open sql = "Execute sessiondata '" & Sessionid & "','" & Dataname & "','" & data & "'" 'Response.Write SQL & "
" 'Response.Write sql GUIDConn.execute (sql) GUIDConn.close 'set Conn = nothing End Function '************************************* ' Get the Session Data out of the dB * '************************************* '#################### EXAMPLE ####################### ' VarName = retrieve_session (sessionid, "VarName") # '#################################################### Function retrieve_session(byVal Sessionid, ByVal Dataname) on error Resume Next sessionid = checkqs(sessionid)'verify the session is active set GUIDConn = Server.CreateObject ("ADODB.Connection") GUIDConn.ConnectionString = "driver={SQL Server};" & _ "server=Hugger;uid=WebUser;pwd=asknow;" & _ "database=WebSiteData;" GUIDConn.open sql = "Execute retrievesession '" & Sessionid & "','" & Dataname & "'" 'Response.Write SQL & "
" Set ORS = GUIDConn.execute (sql) retrieve_session = ORS("sessionvaldata") ors.close GUIDConn.close 'set conn = nothing End Function '************************ ' Check the Time_Stamp * '************************ Function CheckTime(ByVal SessionID) set GUIDConn = Server.CreateObject ("ADODB.Connection") GUIDConn.ConnectionString = "driver={SQL Server};" & _ "server=Hugger;uid=WEBUSER;pwd=asknow;" & _ "database=WebSiteData;" strSQL = "Select Time_Stamp from Sessions where SessionID = '" &_ SessionID & "'" GUIDConn.Open Set oRS = GUIDConn.execute(strSQL) Response.Write "Sessions Time_Stamp is " & oRS("Time_Stamp") Response.Write "
The experation time is " & DateAdd("n",20,oRS("Time_Stamp")) GUIDConn.close Set GUIDConn =nothing end Function Sub CloseConnection() if GUIDConn.state = 1 then GUIDConn.close set GUIDConn = nothing end if 'Set GUIDConn = nothing end sub '***************** Delete Session Data ******************** Function Delete_session(byVal Sessionid) on error Resume Next sessionid = checkqs(sessionid)'verify the session is active set GUIDConn = Server.CreateObject ("ADODB.Connection") GUIDConn.ConnectionString = "driver={SQL Server};" & _ "server=Hugger;uid=WebUser;pwd=asknow;" & _ "database=WebSiteData;" GUIDConn.open sql = "Execute DeleteSession '" & Sessionid & "'" 'Response.Write SQL & "
" Set ORS = GUIDConn.execute (sql) Delete_session = ORS("ReturnStatus") ors.close GUIDConn.close 'set conn = nothing End Function '********************************************************** %> <% '************************* ' Get the Script Version * ' information * '************************* Function GetScriptEngineInfo() Dim s s = "" ' Build string with necessary info. s = ScriptEngine & " Version " s = s & ScriptEngineMajorVersion & "." s = s & ScriptEngineMinorVersion & "." s = s & ScriptEngineBuildVersion GetScriptEngineInfo = s 'Return the results. End Function '********************** ' Generate HTML table * ' From ADO Recordset * '********************** '############# EXAMPLE ############## ' Call mRSTable(MyRecordset) # '#################################### Function mRSTable(RS) Response.write ("")& VbCrLf '****** Make a loop for Field Names ******** Response.Write ("") for each f in RS.Fields Response.Write ("")&VbCrLf next Response.Write ("") & VbCrLf '********************************************* '******* Make loop for data ***************** do while not rs.EOF Response.Write("") for each f in RS.Fields Response.Write ("" & VbCrLf) next Response.Write("") & VbCrLf RS.MoveNext loop '********************************************** Response.write ("
" & f.Name & "
  " & trim(f.Value) & "  
") & VbCrLf end Function Function rsTable(RS) Response.Write("") & chr(13) Response.Write("") & chr(13) '**** loop through the rs to get all the field names ********* for each f in RS.Fields Response.Write("") & chr(13) next Response.Write("") & chr(13) Response.Write("") & chr(13) '******** loop through all the fields to get the values ********* for each f in RS.Fields Response.Write("") & chr(13) next Response.Write("") & chr(13) Response.Write "
" & trim(f.Name) & "
" & trim(f.Value) & "

" End Function '****************************** ' Generate list of elements * ' from and array * ' note: no Fiels Lables * '****************************** '############# EXAMPLE ############## ' ShowMyArray = doLst(MyArray) # ' Response.Write ShowMyArray # '#################################### 'loop HTML Table from Array Function doLst(sArray) NumCols = Ubound(sArray,1) NumRows = Ubound(sArray,2) doLst = doLst For RowCounter = 0 to NumRows doLst = doLst & "" & VbCrLf For colCounter = 0 to NumCols thisField = sArray(colCounter,RowCounter) doLst = doLst & " ["' & VbCrLf doLst = doLst & thisField doLst = doLst & "(" &_ colCounter & "," &_ RowCounter & ")]
" & VbCrLf next doLst = doLst & "
" & VbCrLf next end function '************************ ' Generate Html Table * ' from and array * ' note: no Fiels Lables * '************************ '############# EXAMPLE ############## ' ShowMyArray = doTbl(MyArray) # ' Response.Write ShowMyArray # '#################################### Function doTbl(sArray) ' Could add Split to take String of ' Field Lables to populate table ' 'doTbl = sArray(3,0) NumCols = Ubound(sArray,1) NumRows = Ubound(sArray,2) doTbl = "" For RowCounter = 0 to NumRows doTbl = doTbl & "" & VbCrLf For colCounter = 0 to NumCols thisField = sArray(colCounter,RowCounter) doTbl = doTbl & "" & VbCrL next doTbl = doTbl & "" & VbCrL next doTbl = doTbl & "
" & VbCrL doTbl = doTbl & thisField doTbl = doTbl & "
" & VbCrL end Function '******************* ' Validate email * '******************* '##################### EXAMPLE ######################## ' If ValidateEmail(Request.Form("Email")) = True Then # ' Valid # ' Else # ' strEmail = "Invalid" # ' End If # '###################################################### Function ValidateEmail(Expression) Dim objRegExp Set objRegExp = new RegExp objRegExp.Pattern = "^[\w\.-]+@[\w\.-]+\.[a-zA-Z]+$" ValidateEmail = objRegExp.Test(Expression) Set objRegExp = nothing End Function '***************************** ' SubString Date and convert * '***************************** '############# EXAMPLE ############### ' CheckTheDate = makeDate(2,31,1900) # ' Response.Write CheckTheDate # '##################################### function makeDate(m,d,y) mDate = m & "/" & d & "/" & y 'mDate="#" & Trim(mDate) & "#" mDate=Trim(mDate) 'Response.Write mDate checkDate = isDate(mDate) if checkDate = true then 'cDate(mDate) makeDate = cDate(mDate) else makeDate = False end if end function '*********************************** ' Clear the Date String for SQL * ' Specilized Function to prep Date * ' for SQL. Field MUST accept nulls * '*********************************** '################## EXAMPLE ################# ' MyDateValue = " / / " # ' MySQLDate = Clear_DateString(MyDateValue) # '-- MySQLDate in now equal to null -- # '############################################ Function Clear_DateString(Value) Select Case Value Case "//" Clear_DateString = null case else Clear_DateString = Value end select Clear_DateString = Clear_DateString end Function '******************* ' Validate phone * '******************* '######################## EXAMPLE ####################### ' MyPhoneNumber = "123-1234" # ' CheckThePhoneNumber = ValidatePhone(MyPhoneNumber) # ' if CheckThePhoneNumber = False then # ' PhoneIsNotValid # ' else # ' PhoneIsTrue # ' End if # '######################################################## Function ValidatePhone(Phone) Dim objRegExp Set objRegExp = New RegExp objRegExp.Pattern = "^\d{3}-\d{4}$" ValidatePhone = objRegExp.Test(Phone) End Function '******************* ' Validate UID * '******************* '######################## EXAMPLE ####################### ' MyUIN = "123456789" # ' CheckTheUIN = ValidateUIN(MyUIN) # ' if CheckTheUIN = False then # ' UINIsNotValid # ' else # ' UINIsTrue # ' End if # '######################################################## Function ValidateUID(UID) Dim objRegExp Set objRegExp = New RegExp objRegExp.Pattern = "^\d{9}$" ValidateUID = objRegExp.Test(UID) End Function '******************** ' Validate Zip code * ' US/Canada * '******************** ' Will validate a US or Canadian postal code. ' The '( |-)' syntax matches either a space or a hyphen. ' The '?' indicates that the preceding sub expression may occur zero on one time. ' For US postal codes, we look for 5 digits '\d{5}', ' followed optionally with a hyphen or space and 4 more digits. ' For Canadian postal codes, we look for Alpha-Numeric-Alpha, ' a space or a hyphen, and then Numeric-Alpha-Numeric. Function ValidateZIP(ZIP) Dim objRegExp Set objRegExp = New RegExp objRegExp.Pattern = "^(\d{5}(( |-)\d{4})?)|([A-Za-z]\d[A-Za-z]( |-)\d[A-Za-z]\d)$" ValidateZIP = objRegExp.Test(ZIP) End Function '********************** ' Replace sgl quotes * ' in textareas * '********************** 'in = prep for dB Entry 'out = Display for HTML '################# Example ################### ' populates a TextArea on a page: # ' QuoteReplace(Trim(Request("MyVar")),"out") # '############################################# Function QuoteReplace(Str,inOut) Select case lCase(inOut) case "in" cleanString = Replace(Str,chr(39),chr(39)& chr(39),1,-1,1) 'replace (') with ('') cleanString = Replace(cleanString,chr(10),"",1,-1,1) cleanString = Replace(cleanString,chr(13),"",1,-1,1) case "out" cleanString = Replace(Str,chr(39)& chr(39),chr(39),1,-1,1) ' replace ('') with (') end select QuoteReplace = cleanString end function '***************** ' Makes a string * ' Proper case * '***************** '################# Example ################# ' tmpString = Request.Form("pCaseString") # ' ShowTheName = ProperName(tmpString) # ' Response.Write ShowTheName & "
" # '########################################### Function ProperName(ByVal sName) Dim vaNameSplit Dim i 'On Error Resume Next vaNameSplit = Split(sName, " ") For i = LBound(vaNameSplit) to UBound(vaNameSplit) IF vaNameSplit(i) <> "" THEN wordLen = len(vaNameSplit(i)) firstLetter = Ucase(mid(vaNameSplit(i),1,1)) lastPart = Lcase(right(vaNameSplit(i),(wordLen-1))) theWord = firstLetter & lastPart vaNameSplit(i) = theWord END IF Next ProperName = Join(vaNameSplit, " ") END Function '************************* ' Formats HS Fullname * ' Last, First MI becomes * ' First MI Last * '************************* Function FormatFullName(FullName) aFullName = Split(FullName," ") for i=0 to Ubound(aFullName) aFullName(i) = Replace(aFullName(i),",","") next FullName = aFullName(1) & " " & aFullName(2) & " " & aFullName(0) FormatFullName = ProperName(FullName) end Function '************************ ' Send an Email Message * '************************ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '!!!!!! Requires the Jmail Componet to be !!!!!! '!!!!!! installed on the server !!!!!! '!!!!!! http://tech.dimac.net/ !!!!!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Function SendEmail(eMail,Sender,Subject,Attach,Body) Set JMail = Server.CreateObject("JMail.SMTPMail") JMail.ServerAddress = "express-smtp.cites.uiuc.edu"'"mx2.housing.uiuc.edu" JMail.Sender = Sender JMail.Subject = Subject '****************************************** 'NEW 04/19/2002 ECB: addded capacity for 'mulitable recievers aAddrs = Split(eMail,";") for i=0 to Ubound(aAddrs) 'Response.Write aAddrs(i) & "
" Jmail.AddRecipient aAddrs(i) 'On Error Resume Next next '******************************************* 'Jmail.AddRecipient eMail 'Jmail.AddRecipient "e-brady@uiuc.edu" dim Timestamp timeStamp=NOW MailServer = JMail.ServerAddress '******************** email body ********************* Jmail.AppendText Body & chr(13) If Attach <> "" then MessageBody = Server.MapPath (Attach) '& " " & timestamp Jmail.AppendBodyFromFile(MessageBody) end if Jmail.AppendText chr(13) & chr(13) & TimeStamp & chr(13) '***************************************************** JMail.Priority = 2 JMail.AddHeader "Originating-IP", Request.ServerVariables("REMOTE_ADDR") JMail.Execute 'On Error Resume Next 'parm_msg = Err.number 'Response.Write parm_msg 'ErrorVBScriptReport(parm_msg) Set Jmail=nothing end function '************************ ' Send an Email Message * '************************ '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '!!!!!! Requires the Jmail Componet to be !!!!!! '!!!!!! installed on the server !!!!!! '!!!!!! http://tech.dimac.net/ !!!!!! '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Function SendHTMLEmail(eMail,Sender,Subject,Attach,Body) Set JMail = Server.CreateObject("JMail.SMTPMail") JMail.ServerAddress = "express-smtp.cites.uiuc.edu"'"mx2.housing.uiuc.edu" JMail.Sender = Sender JMail.Subject = Subject '****************************************** 'NEW 04/19/2002 ECB: addded capacity for 'mulitable recievers aAddrs = Split(eMail,";") for i=0 to Ubound(aAddrs) 'Response.Write aAddrs(i) & "
" Jmail.AddRecipient aAddrs(i) next '******************************************* 'Jmail.AddRecipient eMail 'Jmail.AddRecipient "e-brady@uiuc.edu" dim Timestamp timeStamp=NOW MailServer = JMail.ServerAddress Jmail.ContentType ="text/html" '******************** email body ********************* Jmail.AppendText Body & chr(13) If Attach <> "" then MessageBody = Server.MapPath (Attach) '& " " & timestamp Jmail.AppendBodyFromFile(MessageBody) end if Jmail.AppendText chr(13) & chr(13) & "Sent at: " & TimeStamp & "" & chr(13) '***************************************************** JMail.Priority = 3 JMail.AddHeader "Originating-IP", Request.ServerVariables("REMOTE_ADDR") On Error Resume Next parm_msg = Err.number ErrorVBScriptReport(parm_msg) JMail.Execute Set Jmail=nothing end function '***************** ' Error Handling * '***************** '############## EXAMPLE ############## 'Function MyFunction() ' on error resume next ' 'Some code here blah ' err.Raise(6) ' ErrorVBScriptReport("there was an error") ' err.Clear 'End Function 'MyFunction() '###################################### SUB ErrorVBScriptReport(parm_msg) If err.number=0 then ' exit sub end if theServer = Request.ServerVariables("HTTP_Host") Browser = Request.ServerVariables ("HTTP_USER_AGENT") Err.Description = parm_msg Err.Source = Request.ServerVariables("PATH_INFO") body = "|| The error number is (" & Err.number & chr(13) & VbCrLf &_ ") The Server is (" & theServer & chr(13) &_ ") The Browser is [" & Browser & chr(13) &_ "] ||" eMailLink = "Send email" err.helpfile = eMailLink pad="    " response.write "
Errors Occured!
" response.write parm_msg & "
" response.write pad & "Error Number= " & err.number & "
" response.write pad & "Error Desc.= " & err.description & "
" response.write pad & "Help Context= " & err.HelpContext & "
" response.write pad & "Report error " & err.helpfile & "
" response.write pad & "Error Source= " & err.source & "
" END SUB SUB ErrorADOReport(parm_msg,parm_conn) HowManyErrs=parm_conn.errors.count IF HowManyErrs=0 then 'exit sub END IF pad="    " response.write "ADO Reports these Database Error(s) executing:
" response.write SQLstmt & "
" for counter= 0 to HowManyErrs-1 errornum=parm_conn.errors(counter).number errordesc=parm_conn.errors(counter).description response.write pad & "Error#=" & errornum & "
" response.write pad & "Error description=" response.write errordesc & "

" next END SUB '****************** ' Resolve Housing * ' Errors from dB * '****************** 'doError(1,0) = error Code number 'doError(2,0) = Client description (Error Msg for Client) 'doError(3,0) = Developer message Function doHousingError(errNum) SQL = "exec get_status_message " & errNum Set errConn = Server.CreateObject ("ADODB.Connection") Set errRs = Server.CreateObject ("Adodb.Recordset") errConn.Open = "driver=SQL Server;" & _ "server=Atlas;uid=webuser;pwd=asknow;" & _ "database=Housing_Systems;" errRs.ActiveConnection = errConn errRs.Open SQL if not errRs.eof then doHousingError = errRs.GetRows else doHousingError = errNum end if errRs.close errConn.Close Set errRS = Nothing Set errConn = Nothing end function '********************** ' Resolve Housing * ' Errors from dB * ' Requires a ADO * ' connection obj * '********************** '**************** EXAMPLE ************** 'aError = doHousingErrorConn(-101,Conn) '**************************************** 'aError(1,0) = error Code number 'aError(2,0) = Client description (Error Msg for Client) 'aError(3,0) = Developer message Function doHousingErrorConn(errNum,Connection) SQL = "exec get_status_message " & cInt(errNum) 'Response.Write SQL & "

" Set errRs = Server.CreateObject ("Adodb.Recordset") 'check object if TypeName(Connection) = "Connection" then Connection.Open errRs.ActiveConnection = Connection 'Response.Write Connection.State else doHousingErrorConn = "No Connection Object" end if errRs.Open SQL if not errRs.eof then doHousingErrorConn = errRs.GetRows else doHousingErrorConn = errNum end if errRs.close Connection.Close Set errRS = Nothing Set Connection = Nothing end function '****************************** ' Uses the Status_messages db * ' MUST pass App Name as pram * '****************************** Function doHousingErrorAppName(errNum,AppName) SQL = "exec get_status_message '" & errNum & "','" & AppName & "'" 'Response.Write SQL Set errConn = Server.CreateObject ("ADODB.Connection") Set errRs = Server.CreateObject ("Adodb.Recordset") errConn.Open = "driver=SQL Server;" & _ "server=hugger;uid=webuser;pwd=asknow;" & _ "database=Status_messages;" errRs.ActiveConnection = errConn errRs.Open SQL if not errRs.eof then doHousingErrorAppName = errRs.GetRows 'Response.Write VarType(doHousingErrorAppName) else doHousingErrorAppName = Array(errNum,"The Error Number provided was not in the dB.","The Status_Messages dB requires an UPDATE") 'Response.Write VarType(doHousingErrorAppName) end if errRs.close errConn.Close Set errRS = Nothing Set errConn = Nothing end function '********************* ' Error Processing * '********************* Function doReturnErrorArray(errNum,AppName) SQL = "exec get_status_message " & errNum & ",'" & AppName & "'" 'Response.Write SQL & "
" Set errConn = Server.CreateObject ("ADODB.Connection") Set errRs = Server.CreateObject ("Adodb.Recordset") errConn.Open = "driver=SQL Server;" & _ "server=hugger;uid=webuser;pwd=asknow;" & _ "database=Status_messages;" errRs.ActiveConnection = errConn errRs.Open SQL if not errRs.eof then doReturnErrorArray = errRs.GetRows else dim aTmp(2,1)'(1,3) aMsg2 = Array(errNum,"The Error Number provided was not in the dB.","The Status_Messages dB requires an UPDATE") 'Response.Write Ubound(aMsg2) for i=0 to Ubound(aMsg2) 'Response.Write aMsg2(i) & "
" aTmp(i,0)=aMsg2(i) ' redim preserve aTmp(0,aMsg2(i)) next 'reDim preserve aTmp(0,0)= -1 'Response.Write aTmp(0,1) &"
" doReturnErrorArray = aTmp end if errRs.close errConn.Close Set errRS = Nothing Set errConn = Nothing end function '************************** ' Print ServerSide errors * '************************** '############# EXAMPLE ############# ' Call doErrorReport(MessageArray) # '################################### Function doErrorReport(ErrorString) MessageArray = Split(ErrorString,",",-1,1) for i = 0 to Ubound(MessageArray) with response .Write "
" .Write MessageArray(i) .Write "
" end with next end function '*************************** ' Simple DEBUG functions * ' Prints QS and Form Items * ' to the screen * '*************************** Function PrintFormItems() Response.Write "
Form vars follow:
" For Each item in Request.Form Response.Write item & " = " & Request.Form(item) & "
" next Response.Write "
" end Function Function PrintQSItems() Response.Write "
QueryString vars follow:
" For Each item in Request.QueryString Response.Write item & " = " & Request.QueryString(item) & "
" next Response.Write "
" end Function Sub PrintArray(theArray) for i=0 to Ubound(theArray) Response.Write i & " = " & theArray(i) & "
" next Response.Write "
" end sub '*********************** ' Prints out an * ' MultiDimential array * ' to the screen * '*********************** Sub PrintMDarray(MDArray) Response.Write "" numcols=ubound(MDArray,1) numrows=ubound(MDArray,2) FOR rowcounter= 0 TO numrows response.write "" & vbcrlf FOR colcounter=0 to numcols thisfield=MDArray(colcounter,rowcounter) if isnull(thisfield) then thisfield=shownull end if if trim(thisfield)="" then thisfield=showblank end if response.write "" & vbcrlf NEXT response.write "" & vbcrlf NEXT Response.Write "
" response.write thisfield & "(" & colcounter & "," & rowcounter & ")" response.write "
" end sub '************************** ' Strip Non-Numeric Chars * '************************** Function StripNonNumeric(sString) Dim i, sChar, sNonNumeric sNonNumeric = "" For i = 1 To Len(sString) sChar = Mid(sString, i, 1) If Asc(sChar) > 47 And Asc(sChar) < 58 Then sNonNumeric = sNonNumeric & sChar End If Next StripNonNumeric = sNonNumeric End Function '************************** ' Build Simpe Select List * '************************** ' Build 2 arrays: ' One for the Value of the options ' One for the Displayed option '############################ EXAMPLE #################################### ' aLibraryValue = Array("1","2","3","Not_Sure") # ' aLibraryName = Array("Allen","Busey-Evans","FAR","Not Sure") # ' Call BuildSelect(aLibraryValue,aLibraryName,"LibraryApplyingFor","",1) # '######################################################################### Function BuildSelect(aValues,aNames,fldName,Selected,TabIdx) Response.Write "" End Function Function BuildSelectJAVA(aValues,aNames,fldName,Selected,TabIdx,Java) Response.Write "" End Function '---------------------------------+ '>>>>>> Phillip Tackett <<<<<<<< | ' 2001 | '---------------------------------+ '************************** ' Build Simpe Select List * '************************** ' Build 2 arrays: ' One for the Values of the options ' One for the Displayed option '############################ EXAMPLE #################################################### 'aLibraryValue = Array("1","2","3","Not_Sure") '# 'aLibraryName = Array("Allen","Busey-Evans","FAR","Not Sure") '# 'Call BuildSelectWC(aLibraryValue,aLibraryName,"LibraryApplyingFor","FirstChoice","",1) '# '######################################################################################### Function BuildSelectWC(aValues,aNames,fldName,FirstChoice,Selected,TabIdx) Response.Write "" End Function '*********************** ' Conditionaly inclued * ' a file * '*********************** 'Orginal Artical: 'http://www.activeserverpages.com/learn/includedynamic.asp '############ EXAMPLE BELOW ##################### ' whichfile="/Common/Default.htm" # ' Call ReadDisplayFile(whichfile) # '################################################ Function ReadDisplayFile(FileToRead) whichfile=server.mappath(FileToRead) Set fs = CreateObject("Scripting.FileSystemObject") Set thisfile = fs.OpenTextFile(whichfile, 1, False) tempSTR=thisfile.readall response.write tempSTR thisfile.Close set thisfile=nothing set fs=nothing END function '*********************** ' Get the html output ' from another html page '*********************** 'Orginal Artical: 'http://www.4guysfromrolla.com/webtech/110100-1.shtml '############ EXAMPLE BELOW ##################### ' SAMPLE = Call GetHTML("http://www.atmos.uiuc.edu/weather/insets/cmiobs_housing.html") '################################################ Function GetHTML(Page) Response.Buffer = True Dim objXMLHTTP, xml ' Create an xmlhttp object: Set xml = Server.CreateObject("Microsoft.XMLHTTP") 'Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP") xml.Open "GET", Page, False ' Actually Sends the request and returns the data: xml.Send Response.Write xml.responseText Set xml = Nothing end Function '************************************* ' List the File in a given directory * ' with FileDate and Bullet options * '************************************* '############### EXAMPLE ####################################################################################### ' call ListFiles("/HousingWeb/Documents/Tips","doc,xls,gif,jpg,asp","") ' -- Lists file with an image for a bullet ' call ListFiles("/Common","","") ' -- plain and simple listing '############################################################################################################### Function ListFiles(path,exclude,bullet) mypath= path Set filesystem = CreateObject("Scripting.FileSystemObject") Set folder = filesystem.GetFolder(server.mappath(mypath)) Set filecollection = folder.Files 'Build an array of the files to exclude from the display ExcludedFiles = Split(exclude, ",",-1,1) Set DicObject = CreateObject("Scripting.Dictionary") 'Create a Dictionary object to store the array For i = lBound(ExcludedFiles)to Ubound(ExcludedFiles) DicObject.Add ExcludedFiles(i), i ' Response.Write ExcludedFiles(i)&"
" next 'for each Item in DicObject ' Response.Write "key=" & item & " Item = " & DicObject(Item) & "
" 'next For Each file in filecollection FileExt = right(File.Name,3) lFileName = len(file.name)-4 ShortName = Mid(file.Name,1,lFileName) FileDate = File.DateCreated if DicObject.Exists(FileExt)= False then Response.Write Bullet & "" &_ ShortName & "  " &_ FileDate & "
" end if Next set filesystem=nothing set folder=nothing set filecollection=nothing Set DicObject = nothing end Function '********************** ' Generate JavaScript * ' to open confiration * ' pop-up * '********************** '##################### EXAMPLE ###################### ' --! NOTE the form MUST be validated before the call ! -- ' if Validate = true then ' Call ComfirmPopUp("http://wwwdev.housing.uiuc.edu/dstodgel/HousingSite/online/","/dstodgel/HousingSite/online/text/Text.htm") ' else ' Response.Write ErrorMsg & "
" ' end if '#################################################### Function ComfirmPopUp(ReturnPage,ConfirmTextFile) jsFunctionName = "window_onunload" ' jsFunctionName = FormName & "_onsubmit" with Response .Write "" & VbCrLf '.Write "" & VbCrLf end with end Function '************************ ' Generate HTML Breaks * '************************ '######### EXAMPLE ############ ' Call DanaBreaks(10) ' this will write 10 breaks '############################## Function DanaBreaks(NumberOfBreaks) For i = 0 to NumberOfBreaks Response.Write "
" next end Function '********************************* ' Check to see if user has login * '********************************* '############# EXAMPLE ############# ' Call WebLoginCheck() '################################### Function WebLoginCheckORG() ServerName = Request.ServerVariables ("Server_Name") PageName = Request.ServerVariables ("Script_Name") Select Case Request.ServerVariables ("HTTPS") Case "on" isSSL = "https://" Case Else isSSL = "http://" end Select ReturnPage = isSSL & ServerName & PageName 'IF Len(Request.QueryString ("SessionID"))<> 36 _ If Len(Request.Cookies("SessionID"))<> 36 then ' Add SessionID/IP checking? ' un-comment the line below to ' When new server get in place ' and running. 'ReDirectURL = isSSL & ServerName & "/Common/iCard/WebLogin/WebLogin.asp" 'Remove line below after server instalition. 'ReDirectURL = "https://wwwstaff-s.housing.uiuc.edu/Common/iCard/WebLogin/WebLogin.asp" ReDirectURL = "https://www-s.housing.uiuc.edu/Common/iCard/WebLogin/WebLogin.asp" ReDirectURL = ReDirectURL & "?ReturnPage=" & Server.URLEncode (ReturnPage) Response.Redirect ReDirectURL ''Response.Write ReDirectURL 'Else 'SessionID = Request.Cookies("SessionID") 'StayputURL = ReturnPage & "?SessionID=" & SessionID 'Response.Write StayputURL 'Response.Redirect StayputURL End if end Function '############# EXAMPLE ############# ' Call WebLoginCheckTEST() '################################### Function WebLoginCheck() ServerName = Request.ServerVariables ("Server_Name") PageName = Request.ServerVariables ("Script_Name") Select Case Request.ServerVariables ("HTTPS") Case "on" isSSL = "https://" Case Else isSSL = "http://" end Select ReturnPage = isSSL & ServerName & PageName If Len(Request.Cookies("SessionID"))<> 36 then 'ReDirectURL = "https://wwwstaff-s.housing.uiuc.edu/Common/iCard/WebLogin/WebLogin.asp" ReDirectURL = "https://www-s.housing.uiuc.edu/Common/iCard/WebLogin/WebLogin.asp" ReDirectURL = ReDirectURL & "?ReturnPage=" & Server.URLEncode (ReturnPage) Response.Redirect ReDirectURL End if end Function '******************************** ' Clears out the Param from a * ' Fin Trans * '******************************** Function ClearTransParams(TransID) SQL = "Exec FT_ClearTransParams @TransactionID='" & TransID & "'" Set TransConn = Server.CreateObject ("ADODB.Connection") Set TransRs = Server.CreateObject ("Adodb.Recordset") TransConn.Open = "driver=SQL Server;" & _ "server=hugger;uid=webuser;pwd=asknow;" & _ "database=Housing_System;" TransRs.ActiveConnection = transConn TransRS.Open(SQL) 'response.Write SQL if TransRS("ReturnStatus") <> 1 then aError = doReturnErrorArray(TransRS("ReturnStatus"),"FT") Response.Write "" & aError(2,0) & "" TransRS.Close Set TransRs = nothing TransConn.Close Set TransConn = Nothing Exit Function end if TransRS.Close Set TransRs = nothing TransConn.Close Set TransConn = Nothing End Function '************************* ' Standared Funk to * ' close a site/service * '************************* Function CloseSite(ReturnDate,AppName) Response.Redirect("/Common/SiteClosed.asp?ReturnDate=" & ReturnDate & "&AppName=" & appName) end Function Function KillSession() Response.Cookies("SessionID") = "" Response.Cookies("SessionID").Path = "/" Response.Cookies ("SessionID").Secure = False Response.Cookies("SessionID").Domain = ".housing.uiuc.edu" Response.Cookies("FullName") = "else" 'retrieve_session(SessionID,"FullName") Response.Cookies("FullName").Path = "/" Response.Cookies ("FullName").Secure = False Response.Cookies("FullName").Domain = ".housing.uiuc.edu" 'Response.AddHeader "pragma","no-cache" 'Response.AddHeader "cache-control","private" 'Response.CacheControl = "no-cache" 'Response.Flush Response.Expires = 0 Response.Expiresabsolute = Now() - 1 end Function %> amenities/services
University of Illinois @ Urbana-Champaign. University Housing home page.  
. QUICK LINKS . . APPLY FOR HOUSING . . STUDENT'S CORNER . . SERVICE DESK
Living with Us.
  amenities/services
List Amenities
Recycling
Mailing Addresses
Newsletters
Group of Students.
. Prospective Students
. Current Students
. Parents & Family
. Staff
Amenities/Services .
Academic Resources .
Programs .
Staff .
 
LIVING . Movie Channel . Get Involved
WITH US . Menus . Important Dates
QUICK LINKS . Feedback . Frequently Asked Questions
 

University Apartment Residents
Select an apartment complex to view a quick guide of available programs and services.


Ashton woods

 

 

Ashton Woods offers apartments for graduate students, students with families, and undergraduates with at least 30 or more credits.


Goodwin-Green

 

 

Goodwin-Green apartments are primarily available to graduate students, faculty, and staff who are either single, married, or in a domestic partnership.


Orchard Downs



Orchard Downs apartments are primarily available to graduate students, faculty, and staff who are either married, in a domestic partnership, or have children. Single graduate students are eligible to share their apartment with another single eligible student of the same gender as co-tenants.

 


 
 Search
 
Connect. Learn. Achieve. Student Affairs at Illinois.