<% Function ReplaceNull(ByVal varValue, ByVal varReplace) If isNull(varValue) Or varValue = "" Then ReplaceNull = varReplace Else ReplaceNull = varValue End If End Function ' ------------------------------------------------------------------------------------------- function snippet(text, noWords) Dim wordcount Dim tempcount Dim char wordCount = 1 If not isnull(text) Then text = stripHTML(text) snippet = "" for tempCount = 1 to len(text) char = mid(text,tempcount,1) if char = " " then wordCount = wordCount + 1 if wordCount = noWords then exit for end if end if snippet = snippet & char next End if end function ' ------------------------------------------------------------------------------------------- function stripHTML(html) Dim startPos Dim EndPos Dim ignoring Dim char Dim tempCount startPos = 0 EndPos = 0 ignoring = false char = "" stripHTML = "" for tempCount = 1 to len(html) char = mid(html,tempCount,1) if char = "<" then ignoring = true end if if char = ">" then ignoring = false end if if not ignoring and char <> ">" then stripHTML = stripHTML & char end if next end function ' ------------------------------------------------------------------------------------------- function getErrorHTML(ErrorType, ErrorDescription, TryAgainLink) template = application("errorHTML") template = replace(template,"",ErrorType) template = replace(template,"",errorDescription) if TryAgainLink <> "" then tryAgain = application("errorTryAgainLink") tryAgain = replace(tryAgain,"",tryAgainLink) template = replace(template,"",tryAgain) else template = replace(template,"","") end if getErrorHTML = template ' email error to IBL Support if application("emailErrors") then msg = application("errorEmail") msg = replace(msg,"",application("applicationName")) msg = replace(msg,"",session("executing_script")) msg = replace(msg,"",template) msg = replace(msg,"",Request.ServerVariables("HTTP_HOST")) formvariables = "" for each key in Request.Form formvariables = formvariables & key & "=" & request(key) & "
" next querystring = "" for each key in Request.QueryString querystring = querystring & key & "=" & request(key) & "
" next sessionVariables = "" for each key in session.Contents sessionVariables = sessionVariables & key & "=" & session(key) & "
" next serverVariables = "" for each key in Request.ServerVariables serverVariables = serverVariables & key & "=" & Request.ServerVariables(key) & "
" next msg = replace(msg,"",formVariables) msg = replace(msg,"",queryString) msg = replace(msg,"",sessionVariables) msg = replace(msg,"",serverVariables) result = sendMail("support@ibltd.com",application("emailErrorsTo"),"An Error Occured in application " & application("applicationName"),msg) end if end function function SendmailCDO(ByRef strFrom, ByRef strTo, ByRef strSubject, ByRef strBody, ByRef blnHTMLFormat) On Error resume Next If strFrom = "" Then strFrom = application("defaultEmailFrom") Dim objCDO Set objCDO = Server.CreateObject("CDO.Message") With objCDO .To = strTo .From = strFrom .Subject = strSubject If CBool(blnHTMLFormat) Then .HTMLBody = strBody Else .TextBody = strBody End If If CBool(application("SMTP_RemoteHost")) Then ' ******* Configuration options (for sending via remote server) ********* .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Name or IP of remote SMTP server .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = application("SMTPMailServer") 'Server port .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")= application("SMTPport") .Configuration.Fields.Update End If .Send End With 'Cleanup Set objCDO = Nothing End function ' ------------------------------------------------------------------------------------------- function CountDelimeteredItems(TheList, theDelim) TheCount=1 for i=1 to len(TheList) temp=mid(TheList,i,1) if temp=theDelim then TheCount=TheCount+1 end if next CountDelimeteredItems=TheCount end function ' ------------------------------------------------------------------------------------------- Function attachment(FileAttachment,Fullpath,LocalURLpath) If FileAttachment <> "" and isnull(FileAttachment) = False then 'find the file extension letters of file name. dot = instr(FileAttachment,".") If dot > 0 Then extension = mid(FileAttachment,dot) Select case extension case ".mdb" iconname = "icon_mdb.gif" case ".doc" iconname = "icon_doc.gif" case ".pdf" iconname = "icon_pdf.gif" case ".txt" iconname = "icon_txt.gif" case ".xls" iconname = "icon_xls.gif" case ".zip" iconname = "icon_zip.gif" case ".ppt" iconname = "icon_ppt.gif" End select If iconname = "" Then iconname = "icon_other.gif" End if attHTML = "" attHTML = attHTML & "" attHTML = attHTML & "" attHTML = attHTML & "

" & FileAttachment & " " 'get file size. Set mfo=server.createobject("scripting.filesystemobject") Thisfile = FullPath & FileAttachment set myfile = mfo.getfile(thisfile) attHTML = attHTML & "File Size : " & (myfile.Size / 1000) set mfo=nothing attHTML = attHTML & " KB

" End if End if attachment = attHTML End Function '--------------------------------------------------- Function fnGetPageVars(ByRef strRecordID, ByRef strPageNo) strRecordID = Session("RecordID") strPageNo = Session("PageNo") End Function Function fnGetPageNoParameter(ByRef strPageNo, ByRef strParameter, ByVal varDefaultValue) Dim intStartPos, intEndPos Dim strParameterValue intStartPos = Instr(1, strPageNo, strParameter) If intStartPos > 0 Then intEndPos = Instr(intStartPos, strPageNo, "_") strParameterValue = Mid(strPageNo, (intStartPos+Len(strParameter)), intEndPos - (intStartPos+Len(strParameter))) Else strParameterValue = varDefaultValue End If fnGetPageNoParameter = strParameterValue End Function Function ConvertDate(byVal dtmDate, byVal intFormat) If Not IsDate(dtmDate) Then ConvertDate = Null Exit Function End If ' Calculate components Dim intDay, intMonth, intYear, intFullYear, intHour, intMinute, intSecond, dtmConvertedDate intDay = Right("00" & Day(dtmDate), 2) intMonth = Right("00" & Month(dtmDate), 2) intYear = Right(Year(dtmDate), 2) intFullYear = Year(dtmDate) intHour = Right("00" & Hour(dtmDate), 2) intMinute = Right("00" & Minute(dtmDate), 2) intSecond = Right("00" & Second(dtmDate), 2) ' Build date Select Case CInt(intFormat) Case 1'UK_DATE dtmConvertedDate = intDay & "/" & intMonth & "/" & intYear Case 2'UK_DATETIME dtmConvertedDate = intDay & "/" & intMonth & "/" & intYear & " " & intHour & ":" & intMinute & ":" & intSecond Case 3'STRING_DATE dtmConvertedDate = intDay & " " & MonthName(intMonth, True) & " " & intFullYear Case 4'STRING_DATE_SHORT_YEAR dtmConvertedDate = intDay & " " & MonthName(intMonth, True) & " " & intYear Case 12'STRING_DATE_NO_YEAR dtmConvertedDate = intDay & " " & MonthName(intMonth, True) Case 5'STRING_DATETIME If CStr(intHour) = "00" And CStr(intMinute) = "00" And CStr(intSecond) = "00" Then dtmConvertedDate = intDay & " " & MonthName(intMonth, True) & " " & intFullYear Else dtmConvertedDate = intDay & " " & MonthName(intMonth, True) & " " & intFullYear & " " & intHour & ":" & intMinute & ":" & intSecond End If Case 6'STRING_TIME dtmConvertedDate = intHour & ":" & intMinute & ":" & intSecond Case 7'STRING_DAYNAME_DATE dtmConvertedDate = weekDayName(weekDay(dtmDate,2), True, 2) & " " & intDay & "-" & MonthName(intMonth, True) & "-" & intFullYear Case 8'STRING_DAYNAME_DATETIME dtmConvertedDate = weekDayName(weekDay(dtmDate,2), True, 2) & " " & intDay & "-" & MonthName(intMonth, True) & "-" & intFullYear & " " & intHour & ":" & intMinute & ":" & intSecond Case 9'STRING_DAYNAME_DATE_NO_YEAR dtmConvertedDate = weekDayName(weekDay(dtmDate,2), True, 2) & " " & intDay & "-" & MonthName(intMonth, True) Case 10'ISO_STANDARD dtmConvertedDate = intFullYear & "-" & intMonth & "-" & intDay Case 11'DATABASE_SAFE dtmConvertedDate = intDay & " " & MonthName(intMonth, False) & " " & intFullYear Case Else dtmConvertedDate = Null End Select ConvertDate = dtmConvertedDate End Function ' Gets a numeric form input and converts it to the appropriate type Function fnGetNumericFormInput(ByRef strFieldName, ByRef strFieldType, ByRef strNumberType, ByVal vntDefaultValue) Dim vntFieldValue Select Case UCase(strFieldType) Case "FORM", "QUERYSTRING" Case Else : strFieldType = "Form" End Select Select Case UCase(strNumberType) Case "CLNG", "CINT", "CBOOL", "CBYTE", "CDBL", "CSNG", "CCUR" Case Else : strNumberType = "CLng" End Select Execute "vntFieldValue = Trim(Request." & strFieldType & "(strFieldName))" If IsNumeric(vntFieldValue) Then Execute "vntFieldValue = " & strNumberType & "(vntFieldValue)" Else vntFieldValue = vntDefaultValue End If fnGetNumericFormInput = vntFieldValue End Function Function fnSetLoginCookie(lngUserID) ' the shopping center session has been used and make it part of the key dim ShoppingCentreUser shoppingCentreUser = Session("ShoppingCentreName")& "User" Response.Cookies(shoppingCentreUser).Expires = DateAdd("d", 365, Date()) Response.Cookies(shoppingCentreUser)("user_id") = lngUserID Response.Cookies(shoppingCentreUser).Secure = False End Function %>