<%

cCharset = "Windows-1252"

response.Charset=cCharset

dDebug=false
useAJAX=true
suggestAllContent=true

Session.LCID = 1033
session.codepage=1252

dSQL=""

strDatabaseType = "MYSQL"

Set tables_data = CreateObject("Scripting.Dictionary")

%>
<%

'//	locale settings

'	locale settings

set locale_info = CreateObject("Scripting.Dictionary")

'	date settings
locale_info.Add "LOCALE_ICENTURY", "1"
locale_info.Add "LOCALE_IDATE", "0"
locale_info.Add "LOCALE_ILDATE", "0"
locale_info.Add "LOCALE_SDATE", "/"
locale_info.Add "LOCALE_SLONGDATE", "dddd, MMMM dd, yyyy"
locale_info.Add "LOCALE_SSHORTDATE", "M/d/yyyy"
'	weekday names
locale_info.Add "LOCALE_IFIRSTDAYOFWEEK", "6"
locale_info.Add "LOCALE_SDAYNAME1", "Monday"
locale_info.Add "LOCALE_SDAYNAME2", "Tuesday"
locale_info.Add "LOCALE_SDAYNAME3", "Wednesday"
locale_info.Add "LOCALE_SDAYNAME4", "Thursday"
locale_info.Add "LOCALE_SDAYNAME5", "Friday"
locale_info.Add "LOCALE_SDAYNAME6", "Saturday"
locale_info.Add "LOCALE_SDAYNAME7", "Sunday"
locale_info.Add "LOCALE_SABBREVDAYNAME1", "Mon"
locale_info.Add "LOCALE_SABBREVDAYNAME2", "Tue"
locale_info.Add "LOCALE_SABBREVDAYNAME3", "Wed"
locale_info.Add "LOCALE_SABBREVDAYNAME4", "Thu"
locale_info.Add "LOCALE_SABBREVDAYNAME5", "Fri"
locale_info.Add "LOCALE_SABBREVDAYNAME6", "Sat"
locale_info.Add "LOCALE_SABBREVDAYNAME7", "Sun"
'	month names
locale_info.Add "LOCALE_SMONTHNAME1", "January"
locale_info.Add "LOCALE_SMONTHNAME2", "February"
locale_info.Add "LOCALE_SMONTHNAME3", "March"
locale_info.Add "LOCALE_SMONTHNAME4", "April"
locale_info.Add "LOCALE_SMONTHNAME5", "May"
locale_info.Add "LOCALE_SMONTHNAME6", "June"
locale_info.Add "LOCALE_SMONTHNAME7", "July"
locale_info.Add "LOCALE_SMONTHNAME8", "August"
locale_info.Add "LOCALE_SMONTHNAME9", "September"
locale_info.Add "LOCALE_SMONTHNAME10", "October"
locale_info.Add "LOCALE_SMONTHNAME11", "November"
locale_info.Add "LOCALE_SMONTHNAME12", "December"
locale_info.Add "LOCALE_SABBREVMONTHNAME1", "Jan"
locale_info.Add "LOCALE_SABBREVMONTHNAME2", "Feb"
locale_info.Add "LOCALE_SABBREVMONTHNAME3", "Mar"
locale_info.Add "LOCALE_SABBREVMONTHNAME4", "Apr"
locale_info.Add "LOCALE_SABBREVMONTHNAME5", "May"
locale_info.Add "LOCALE_SABBREVMONTHNAME6", "Jun"
locale_info.Add "LOCALE_SABBREVMONTHNAME7", "Jul"
locale_info.Add "LOCALE_SABBREVMONTHNAME8", "Aug"
locale_info.Add "LOCALE_SABBREVMONTHNAME9", "Sep"
locale_info.Add "LOCALE_SABBREVMONTHNAME10", "Oct"
locale_info.Add "LOCALE_SABBREVMONTHNAME11", "Nov"
locale_info.Add "LOCALE_SABBREVMONTHNAME12", "Dec"
'	time settings
locale_info.Add "LOCALE_ITIME", "0"
locale_info.Add "LOCALE_ITIMEMARKPOSN", "0"
locale_info.Add "LOCALE_ITLZERO", "0"
locale_info.Add "LOCALE_S1159", "AM"
locale_info.Add "LOCALE_S2359", "PM"
locale_info.Add "LOCALE_STIME", ":"
locale_info.Add "LOCALE_STIMEFORMAT", "h:mm:ss tt"
'	currency settings
locale_info.Add "LOCALE_ICURRDIGITS", "2"
locale_info.Add "LOCALE_ICURRENCY", "0"
locale_info.Add "LOCALE_INEGCURR", "0"
locale_info.Add "LOCALE_SCURRENCY", "$"
locale_info.Add "LOCALE_SMONDECIMALSEP", "."
locale_info.Add "LOCALE_SMONGROUPING", "3;0"
locale_info.Add "LOCALE_SMONTHOUSANDSEP", ","
'	numbers formatting settings
locale_info.Add "LOCALE_IDIGITS", "2"
locale_info.Add "LOCALE_INEGNUMBER", "1"
locale_info.Add "LOCALE_SDECIMAL", "."
locale_info.Add "LOCALE_SGROUPING", "3;0"
locale_info.Add "LOCALE_SNEGATIVESIGN", "-"
locale_info.Add "LOCALE_SPOSITIVESIGN", ""
locale_info.Add "LOCALE_STHOUSAND", ","


locale_info("LOCALE_ILONGDATE")=GetLongDateFormat()
 
'//	locale functions
'//	number, currency, date & time functions


function fformat_number(val)
	dim sign, vint, frac, out, ptr, gi, fmul, i, sfrac
	dim grouping
	if not isNumeric(val) then 
		fformat_number=val
		exit function
	end if
	if val>=0 then
	  sign=1
	  vint = int(val)
	  frac = val-vint
	else 
	  sign=-1
	  vint = int(-val)
	  frac = -val-vint
	end if
	out = formatnumber(vint,0)
'//	grouping
    grouping=split(locale_info("LOCALE_SGROUPING"),";")
	if uBound(grouping)>0 and grouping(0)<>"" then
		ptr=len(out)
		for gi=0 to uBound(grouping)-1
			if not grouping(gi)<>"" then gi=gi-1
			if ptr<=grouping(gi) then
				ptr=0
				exit for
			end if
			out=substr(out,1,ptr-grouping(gi)) & locale_info("LOCALE_STHOUSAND") & substr(out,ptr-grouping(gi))
			ptr=ptr-grouping(gi)
		next
	end if
''//	fractional digits
    if locale_info("LOCALE_IDIGITS")>0 then
      fmul=1
      for i=0 to locale_info("LOCALE_IDIGITS")-1
        fmul=fmul*10
      next
      frac=round(frac*fmul)
	  sfrac=cstr(frac)
	  dl=len(sfrac)
	  while dl<cint(locale_info("LOCALE_IDIGITS"))
	    sfrac="0" & sfrac
	    dl=dl+1
	  wend
	  out=out & locale_info("LOCALE_SDECIMAL") & sfrac
    end if
''//	format output
	if sign>0 then
		fformat_number = locale_info("LOCALE_SPOSITIVESIGN") & out
		exit function
	else
		select case locale_info("LOCALE_INEGNUMBER")
			case 0 fformat_number = "(" & out & ")"
								exit function
			case 1 fformat_number = "-" & out
								exit function
			case 2 fformat_number = "- " & out
								exit function
			case 3 fformat_number = out & "-"
								exit function
			case 4 fformat_number = out & " -"
								exit function
		end select
	end if
	fformat_number=val
end function


function fformat_currency(val)
	dim sign, vint, frac, out, ptr, gi, fmul, sfrac
	dim grouping
	if not isNumeric(val) then format_currency = val
	if val>=0 then
		sign=1
		vint = int(val)
		frac = val-vint
	else 
	  sign=-1
	  vint = int(-val)
	  frac = -val-vint
	end if
	out = formatnumber(vint,0)
'//	grouping
    grouping=split(locale_info("LOCALE_SMONGROUPING"),";")
	if uBound(grouping)>0 and grouping(0)<>"" then
		ptr=len(out)
		for gi=0 to uBound(grouping)-1
			if not grouping(gi)<>"" then gi=gi-1
			if ptr<=grouping(gi) then
				ptr=0
				exit for
			end if
			out=substr(out,1,ptr-grouping(gi)) & locale_info("LOCALE_SMONTHOUSANDSEP") & substr(out,ptr-grouping(gi))
			ptr=ptr-grouping(gi)
		next
	end if
'//	fractional digits
    if locale_info("LOCALE_ICURRDIGITS")>0 then
      fmul=1
      for i=0 to locale_info("LOCALE_ICURRDIGITS")-1
        fmul=fmul*10
      next
      frac=round(frac*fmul)
	  sfrac=cstr(frac)
	  dl=len(sfrac)
	  while dl<cint(locale_info("LOCALE_ICURRDIGITS"))
	    sfrac="0" & sfrac
	    dl=dl+1
	  wend
	  out=out & locale_info("LOCALE_SMONDECIMALSEP") & sfrac
    end if
'//	format output
	if sign>0 then
		select case locale_info("LOCALE_ICURRENCY")
			case 0 fformat_currency = cstr(locale_info("LOCALE_SCURRENCY")) & cstr(out)
								exit function
			case 1 fformat_currency = cstr(out) & cstr(locale_info("LOCALE_SCURRENCY"))
								exit function
			case 2 fformat_currency = cstr(locale_info("LOCALE_SCURRENCY")) & " " & cstr(out)
								exit function
			case 3 fformat_currency = cstr(out) & " " & cstr(locale_info("LOCALE_SCURRENCY"))
								exit function
		end select
	else
		select case locale_info("LOCALE_INEGCURR")
			case 0 fformat_currency = "(" & cstr(locale_info("LOCALE_SCURRENCY")) & cstr(out) & ")"
								exit function
			case 1 fformat_currency = "-" & cstr(locale_info("LOCALE_SCURRENCY")) & cstr(out)
								exit function
			case 2 fformat_currency = cstr(locale_info("LOCALE_SCURRENCY")) & "-" & cstr(out)
								exit function
			case 3 fformat_currency = cstr(locale_info("LOCALE_SCURRENCY")) & cstr(out)
								exit function
			case 4 fformat_currency = "(" & cstr(out) & cstr(locale_info("LOCALE_SCURRENCY")) & ")"
								exit function
			case 5 fformat_currency = "-" & cstr(out) & cstr(locale_info("LOCALE_SCURRENCY"))
								exit function
			case 6 fformat_currency = cstr(out) & "-" & cstr(locale_info("LOCALE_SCURRENCY"))
								exit function
			case 7 fformat_currency = cstr(out) & cstr(locale_info("LOCALE_SCURRENCY")) & "-"
								exit function
			case 8 fformat_currency = "-" & cstr(out) & " " & cstr(locale_info("LOCALE_SCURRENCY"))
								exit function
			case 9 fformat_currency = "-" & cstr(locale_info("LOCALE_SCURRENCY")) & " " & cstr(out)
								exit function
			case 10 fformat_currency = cstr(out) & " " & cstr(locale_info("LOCALE_SCURRENCY")) & "-"
								exit function
			case 11 fformat_currency = cstr(locale_info("LOCALE_SCURRENCY")) & " " & cstr(out) & "-"
								exit function
			case 12 fformat_currency = cstr(locale_info("LOCALE_SCURRENCY")) & " -" & cstr(out)
								exit function
			case 13 fformat_currency = cstr(out) & "- " & cstr(locale_info("LOCALE_SCURRENCY"))
								exit function
			case 14 fformat_currency = "(" & cstr(locale_info("LOCALE_SCURRENCY")) & " " & cstr(out) & ")"
								exit function
			case 15 fformat_currency = "(" & cstr(out) & " " & cstr(locale_info("LOCALE_SCURRENCY")) & ")"
								exit function
		end select
	end if
	fformat_currency = val
end function


'//	converts mysql datetime to array(year,month,day,hour,minute,second)
function db2time(val)
	dim arr(6)
	arr(0)=""
	arr(1)=""
	arr(2)=""
	arr(3)=""
	arr(4)=""
	arr(5)=""
	if isnull(val) then
		db2time=arr
		exit function
	end if
	if isdate(val) then
		arr(0)=year(val)
		arr(1)=month(val)
		arr(2)=day(val)
		arr(3)=hour(val)
		arr(4)=minute(val)
		arr(5)=second(val)
		db2time=arr
		exit function
	end if
	str=CStr(val)
		dim isdst, havedate, havetime, pattern, y, mo, d, h, mi, s, vlen
	dim vnow(3)
	Dim regEx, Match, Matches
	Dim matchesCount
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Global = True
	pattern=""
	vnow(0)=year(now)
	vnow(1)=month(now)
	vnow(2)=day(now)
	
    havedate=0
	havetime=0
	if isNumeric(str) then
'//	timestamp
		havedate=1
		vlen=len(str)
		if vlen>=10 then havetime=1
		select case vlen
		  case 14 pattern="(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})"
		  case 12 pattern="(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})"
		  case 10 pattern="(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})"
		  case 8 pattern="(\d{4})(\d{2})(\d{2})"
		  case 6 pattern="(\d{2})(\d{2})(\d{2})"
		  case 4 pattern="(\d{2})(\d{2})"
		  case 2 pattern="(\d{2})"
	      case else
	        db2time = arr
		    exit function
	    end select
	    regEx.Pattern = pattern

		Set Matches = regEx.Execute(str)
		matchesCount = Matches.Count

		If matchesCount > 0 Then 
			set m=Matches(0)
			y = subMatches(0).Value

			If matchesCount > 1 Then
				mo = m.subMatches(1)
			Else
				mo = 1
			End If
			If matchesCount > 2 Then
				d = m.subMatches(2)
			Else
				d = 1
			End If
			If matchesCount > 3 Then
				h = m.subMatches(3)
			Else
				h = 0
			End If
			If matchesCount > 4 Then
				mi = m.subMatches(4)
			Else
				mi = 0
			end if
			If matchesCount > 5 Then
				s = m.subMatches(5)
			Else
				s = 0
			End If
		else
			db2time = arr
		    exit function
		end if
	else 
		if not isNumeric(str) and not isnull(str) and trim(str)<>"" then
	'// date,time,datetime
'			str=year(str) & "-" & month(str) & "-" & day(str) & " " & hour(str) & ":" & minute(str) & ":" & second(str)
			regEx.Pattern = "(\d{4})-(\d{1,2})-(\d{1,2}) (\d{1,2}):(\d{1,2}):(\d{1,2})"

			Set Matches = regEx.Execute(str)
			matchesCount = Matches.Count

			If matchesCount > 0 Then 
				set m=Matches(0)
				y = m.subMatches(0)
				mo = m.subMatches(1)
				d = m.subMatches(2)
				h = m.subMatches(3)
				mi = m.subMatches(4)
				s = m.subMatches(5)
				havedate=1
				havetime=1
			else 
				regEx.Pattern = "(\d{4})-(\d{1,2})-(\d{1,2})"
				Set Matches = regEx.Execute(str)
				matchesCount = Matches.Count

				If matchesCount > 0 Then 
					set m=Matches(0)
					y = m.subMatches(0)
					mo = m.subMatches(1)
					d = m.subMatches(2)
					h = 0
					mi = 0
					s = 0
					havedate=1
				else 
					regEx.Pattern = "(\d{2})-(\d{1,2})-(\d{1,2})"
					Set Matches = regEx.Execute(str)
					matchesCount = Matches.Count

					If matchesCount > 0 Then
						set m=Matches(0)
						y=vnow(0)
						mo=vnow(1)+1
						d=vnow(2)
						h = m.subMatches(3)
						mi = m.subMatches(4)
						s = m.subMatches(5)
						havetime=1
					else 
						db2time = arr
						exit function
					end if
				end if
			end if
		else
			db2time = arr
			exit function
		end if
	end if
	if havetime=0 then
		h=0
		mi=0
		s=0
	end if
	if havedate=0 then
		y=vnow(0)
		mo=vnow("1")+1
		d=vnow("2")
	end if
	arr(0)=y
	arr(1)=mo
	arr(2)=d
	arr(3)=h
	arr(4)=mi
	arr(5)=s
	db2time = arr
end function

function format_datetime(ttime())
	format_datetime = format_datetime_custom(ttime,locale_info("LOCALE_SSHORTDATE") & " " & locale_info("LOCALE_STIMEFORMAT"))
end function

function fformat_time(ttime())
	fformat_time = format_datetime_custom(ttime,locale_info("LOCALE_STIMEFORMAT"))
end function

function format_shortdate(ttime())
	format_shortdate = format_datetime_custom(ttime,locale_info("LOCALE_SSHORTDATE"))
end function

function format_longdate(ttime())
	format_longdate = format_datetime_custom(ttime,locale_info("LOCALE_SLONGDATE"))
end function

function simpledate2db(strdate,formatid)
	dim sstr, mmonth, dday, yyear
	dim numbers
	sstr=strdate
	numbers=parsenumbers(sstr)
	if uBound(numbers)=0 then simpledate2db = strdate 
	while uBound(numbers)<3
		numbers(uBound(numbers)+1)=1
	wend
	if formatid=0 then
		mmonth=numbers(0)
		dday=numbers(1)
		yyear=numbers(2)
	else 
		if formatid=1 then
			dday=numbers(0)
			mmonth=numbers(1)
			yyear=numbers(2)
		else 
			if formatid=2 then
				yyear=numbers(0)
				mmonth=numbers(1)
				dday=numbers(2)
			else
				simpledate2db = strdate
			end if
		end if
	end if
	if yyear<100 then
		if yyear<60 then
			yyear=yyear+2000
		else
			yyear=yyear+1900
		end if
	end if
	simpledate2db = yyear & "-" & mmonth & "-" & dday
end function


function localdate2db(strdate)
	localdate2db = simpledate2db(strdate,locale_info("LOCALE_IDATE"))
end function

function localtime2db(strtime)
'//	check if we use 12hours clock
	dim use12, pos, pm, amstr, pmstr, str, h, k
	dim numbers
	use12=0
	pos=instr(1,locale_info("LOCALE_STIMEFORMAT"),"h" & locale_info("LOCALE_STIME"))
	if pos>0 then 
		use12=1
'	determine am/pm
		pm=0
		amstr=locale_info("LOCALE_S1159")
		pmstr=locale_info("LOCALE_S2359")
		posam=instr(1,strtime,amstr)
		pospm=instr(1,strtime,pmstr)
		
		if posam=0 and pospm>0 then
			pm=1
		elseif posam>0 and pospm=0 then
			pm=0
		elseif posam=0 and pospm=0 then
			use12=0
		else
			if posam>pospm then _
				pm=1
		end if
	end if
	str=strtime
	numbers=parsenumbers(str)
	k=uBound(numbers)
	while k<3
		redim Preserve numbers(k+1)
		numbers(k)=0
		k=k+1
	wend
	h=numbers(0)
	m=numbers(1)
	s=numbers(2)
	if use12<>0 and h<>0 then
		if pm=0 and h=12 then h=0
		if pm=1 and h<12 then h=h+12
	end if
	localtime2db = cstr(h) & ":" & cstr(m) & ":" & cstr(s)
end function


function localdatetime2db(strdatetime,format)
	dim use12, locale_idate, pm, amstr, pmstr, pos, tm, mmonth, dday, yyear, h, m, s, l
	dim numbers
	locale_idate=locale_info("LOCALE_IDATE")
	if format="dmy" then locale_idate=1
	if format="mdy" then locale_idate=0
	if format="ymd" then locale_idate=2
'	check if we use 12hours clock
	use12=0
	pos=instr(1,locale_info("LOCALE_STIMEFORMAT"),"h" & locale_info("LOCALE_STIME"))
	if pos>0 then 
		use12=1
'	determine am/pm
		pm=0
		amstr=locale_info("LOCALE_S1159")
		pmstr=locale_info("LOCALE_S2359")
		posam=instr(1,strdatetime,amstr)
		pospm=instr(1,strdatetime,pmstr)
		
		if posam=0 and pospm>0 then
			pm=1
		elseif posam>0 and pospm=0 then
			pm=0
		elseif posam=0 and pospm=0 then
			use12=0
		else
			if posam>pospm then _
				pm=1
		end if
	end if
	numbers=parsenumbers(strdatetime)
	if isArray(numbers) then
		if uBound(numbers)<2 then	
			localdatetime2db = null
			exit function
		end if
	else
		localdatetime2db = null
		exit function
	end if
'//	add current year if not specified
	if uBound(numbers)<3 then
		if locale_idate<>1 then
			mmonth=numbers(0)
			dday=numbers(1)
		else
			mmonth=numbers(1)
			dday=numbers(0)
		end if
		yyear=year(now)
	else
		if locale_idate=0 then	
			mmonth=numbers(0)
			dday=numbers(1)
			yyear=numbers(2)
		else 
			if locale_idate=1 then
				dday=numbers(0)
				mmonth=numbers(1)
				yyear=numbers(2)
			else 
				if locale_idate=2 then
					yyear=numbers(0)
					mmonth=numbers(1)
					dday=numbers(2)
				end if
			end if
		end if
	end if
	if mmonth=0 or dday=0 then 
		localdatetime2db = null
		exit function
	end if
	l=uBound(numbers)
	while l<6
		redim preserve numbers(l+1)
		numbers(l)=0
		l=l+1
	wend
	h=numbers(3)
	m=numbers(4)
	s=numbers(5)
	if use12=1 and h<>0 then
		if pm=0 and h=12 then h=0
		if pm=1 and h<12 then h=h+12
	end if
	if yyear<100 then
		if yyear<60 then 
			yyear=yyear+2000
		else
			yyear=yyear+1900
		end if
	end if
	localdatetime2db = yyear & "-" & mmonth & "-" & dday & " " & h & ":" & m & ":" & s
end function

function parsenumbers(str)
	dim i, num, pos, j
	dim ret()
	i=1
	num=0
	pos=1
	j=0
	if len(str)=0 or isnull(str) then
		redim ret(0)
		parsenumbers = ret
		exit function
	end if
	while i<=len(str)
		if isNumeric(mid(str,i,1)) and num=0 then
			num=1
			pos=i
		else 
			if not isNumeric(mid(str,i,1)) and num<>0 then
				reDim Preserve ret(j+1)
				ret(j)=cint(mid(str,pos,i-pos))
				j=j+1
				num=0
			end if
		end if
		i=i+1
	wend
	if num<>0 then 
		reDim Preserve ret(j+1)
		ret(j)=cint(mid(cstr(str),pos,i-pos+1))
		j=j+1
	end if
	if j=0 then
		redim ret(0)
		parsenumbers = ret
		exit function
	end if
	parsenumbers = ret
end function

'//	returns day of week (1-7) for (monday-sunday)
function format_datetime_custom(ttime(),format)
	dim i,weekday, hour12, am, out, inquot, n
	dim keys
	Set subst = CreateObject("Scripting.Dictionary")
	if isnull(ttime) then
		format_datetime_custom = ""
		exit function
	else
		if uBound(ttime)<3 or ttime(0)="" then 
			format_datetime_custom = ""
			exit function
		end if
	end if
	if ttime(1)=0 then _
		ttime(1)=1
	i=1
	weekday=getdayofweek(ttime)

	subst.Add "dddd",locale_info("LOCALE_SDAYNAME" & weekday)
	subst.Add "ddd",locale_info("LOCALE_SABBREVDAYNAME" & weekday)
	if len(cstr(ttime(2)))=1 then 
		subst.Add "dd","0" & cstr(ttime(2))
	else
		subst.Add "dd",cstr(ttime(2))
	end if
	subst.Add "d",ttime(2)
	subst.Add "MMMM",locale_info("LOCALE_SMONTHNAME" & ttime(1))
	subst.Add "MMM",locale_info("LOCALE_SABBREVMONTHNAME" & ttime(1))
	if len(cstr(ttime(1)))=1 then 
		subst.Add "MM","0" & cstr(ttime(1))
	else
		subst.Add "MM",cstr(ttime(1))
	end if
	subst.Add "M",ttime(1)

	var = CStr(ttime(0))
	while len(var)<4
	     var = "0" & var
	wend 
	subst.Add "yyyy", var
	
	var = CStr((ttime(0) mod 100))
	while len(var)<2
	     var = "0" & var
	wend 
	subst.Add "yy", var

	subst.Add "y",(ttime(0) mod 10)
	subst.Add "gg",""
	if len(cstr(ttime(3)))=1 then 
		subst.Add "HH","0" & cstr(ttime(3))
	else
		subst.Add "HH",cstr(ttime(3))
	end if
	subst.Add "H",ttime(3)
	if len(cstr(ttime(4)))=1 then 
		subst.Add "mm","0" & cstr(ttime(4))
	else
		subst.Add "mm",cstr(ttime(4))
	end if
	subst.Add "m",ttime(4)
	if len(cstr(ttime(5)))=1 then 
		subst.Add "ss","0" & cstr(ttime(5))
	else
		subst.Add "ss",cstr(ttime(5))
	end if
	subst.Add "s",ttime(5)
	hour12=ttime(3)
	am=1
	if hour12>=12 then
		am=0
		hour12=hour12-12
	end if
	if hour12=0 then hour12=12
	subst.Add "hh",cstr(hour12)
	subst.Add "h",hour12
	if am=1 then
		subst.Add "tt",locale_info("LOCALE_S1159")
		subst.Add "t",mid(locale_info("LOCALE_S1159"),1,1)
	else
		subst.Add "tt",locale_info("LOCALE_S2359")
		subst.Add "t",mid(locale_info("LOCALE_S2359"),1,1)
	end if
	out=format
	inquot=0
	while i<=len(out)
		if mid(out,i,1)="'" then
			inquot=1-inquot
			out=mid(out,1,i) & mid(out,i+2)
			flag=1
		else 
			if inquot=0 then
				for each key in subst
					if mid(out,i,len(key))=key then
						out=mid(out,1,i-1) & subst(key) & mid(out,len(key)+i)
						i=i+len(subst(key))-1
						exit for
					end if
				next
			end if
		end if
		i=i+1
	wend
	format_datetime_custom = out
end function

function getdayofweek(ttime())
	dim daydif, i
'//	January 1, 2004 - Thursday
'//	Get the differewnce in days between January 1, 2004 and January 1 of given year
	daydif=0
	if ttime(0)>=2004 then
		for i=2004 to ttime(0)-1
			if isleapyear(i) then
				daydif=daydif+366
			else
				daydif=daydif+365
			end if
		next
	else
		for i=2003 to ttime(0) step -1
			if isleapyear(i) then
				daydif=daydif-366
			else
				daydif=daydif-365
			end if
		next
	end if
'//	to given month
	dim mdays(13)
	mdays(1)=31
	mdays(2)=28
	mdays(3)=31
	mdays(4)=30
	mdays(5)=31
	mdays(6)=30
	mdays(7)=31
	mdays(8)=31
	mdays(9)=30
	mdays(10)=31
	mdays(11)=30
	mdays(12)=31
	
	if isleapyear(ttime(0)) then mdays(2)=29
	
	for i=1 to ttime(1)-1
		daydif=daydif+mdays(i)
	next
'//	to given day
	daydif=daydif+ttime(2)-1
	if daydif>0 then 
		getdayofweek = (4+daydif-1) mod 7 + 1
		exit function
	end if
	getdayofweek = 7-(3-daydif) mod 7
end function

function getweeknumber(ttime())
	dim daydif, i
	if locale_info("LOCALE_IFIRSTDAYOFWEEK")<=3 then
		startweekday=3-locale_info("LOCALE_IFIRSTDAYOFWEEK")
	else
		startweekday=10-locale_info("LOCALE_IFIRSTDAYOFWEEK")
	end if

'//	January 1, 2004 - Thursday
'//	Get the differewnce in days between January 1, 2004 and January 1 of given year
	daydif=0
	if ttime(0)>=2004 then
		for i=2004 to ttime(0)-1
			if isleapyear(i) then
				daydif=daydif+366
			else
				daydif=daydif+365
			end if
		next
	else
		for i=2003 to ttime(0) step -1
			if isleapyear(i) then
				daydif=daydif-366
			else
				daydif=daydif-365
			end if
		next
	end if
'//	to given month
	dim mdays(13)
	mdays(1)=31
	mdays(2)=28
	mdays(3)=31
	mdays(4)=30
	mdays(5)=31
	mdays(6)=30
	mdays(7)=31
	mdays(8)=31
	mdays(9)=30
	mdays(10)=31
	mdays(11)=30
	mdays(12)=31
	
	if isleapyear(ttime(0)) then mdays(2)=29
	
	for i=1 to ttime(1)-1
		daydif=daydif+mdays(i)
	next
'//	to given day
	daydif=daydif+ttime(2)-1

	daydif=daydif+startweekday
	daydif = daydif-(daydif mod 7)
	getweeknumber=daydif/7
end function


function isleapyear(y)
	if y mod 4 <>0 then 
		isleapyear = false
		exit function
	end if
	if y mod 100 <>0 then 
		isleapyear = true
		exit function
	end if
	if (y/100) mod 4 <> 0 then 
		isleapyear = false
		exit function
	end if
	isleapyear = true
end function

function GetLongDateFormat()
	dim format, dstart, inquote, dindex, mindex, yindex, i, c, f

	format=locale_info("LOCALE_SLONGDATE")

'//	dd,d - day
'//	MMMM, MMM, MM, M - month
'//	yyyy, yy, y - year
'//	dddd, ddd - day of week, ignore it
'//	'sdsd' - quoted string, ignore it.
	dstart=-1
	inquote=false
	dindex=-1
	mindex=-1
	yindex=-1
	i=0
	f=1
	while f=1
		c=""
		if i<len(format) then c=mid(format,i+1,1)
		if dstart>=0 and c<>"d" then
			if i-dstart<=2 then dindex=dstart
			dstart=-1
		end if
		if not inquote and c="\'" then
			inquote=true
		else 
			if c="\'" then
				inquote=false
			else 
				if not inquote then
					if dindex<0 and c="d" then
						if dstart<0 then dstart=i
					end if
					if yindex<0 and c="y" then yindex=i
					if mindex<0 and c="M" then mindex=i
				end if
			end if
		end if
		if i>=len(format) then f=0
		i=i+1
	wend
	if dindex<0 or mindex<0 or yindex<0 then 
		GetLongDateFormat = -1
		exit function
	end if
	if dindex<mindex and mindex<yindex then 
		GetLongDateFormat = 1	'// DMY 
		exit function
	end if
	if mindex<dindex and dindex<yindex then 
		GetLongDateFormat = 0	'// MDY
		exit function
	end if
	if yindex<mindex and mindex<dindex then 
		GetLongDateFormat = 2	'// YMD
		exit function
	end if
	if yindex<dindex and dindex<mindex then 
		GetLongDateFormat = 1	'// YDM
		exit function
	end if
	GetLongDateFormat = -1
end function

%>

<%
%>
<%
'////////////////////////////////////////////////////////////////////////////////
'// table and field info functions
'////////////////////////////////////////////////////////////////////////////////


function GetTableData(atable,key,default)
    dim table
	table=atable
	If atable = "" Then table = strTableName
	if not tables_data.Exists(table) then
		GetTableData = default
		exit function
	end if
	if not tables_data(table).Exists(key) then
		GetTableData = default
		exit function
	end if
	GetTableData = tables_data(table)(key)
end function

function GetFieldData(atable,field,key,default)
    dim table
	table=atable
	If atable = "" Then table = strTableName
	if not tables_data.Exists(table) then
		GetFieldData = default
		exit function
	end if
	if not tables_data(table).Exists(field) then
		GetFieldData = default
		exit function
	end if
	if not tables_data(table)(field).Exists(key) then
		GetFieldData = default
		exit function
	end if
	GetFieldData = tables_data(table)(field)(key)
end function

' return field label
Function Label(field, table)
	Label = GetFieldData(table,field,"Label",field)
end function

' return filename field if any
Function GetFilenameField(field, table)
	GetFilenameField = GetFieldData(table,field,"Filename","")
End Function

'     return hyperlink prefix
Function GetLinkPrefix(field, table)
	GetLinkPrefix = GetFieldData(table,field,"LinkPrefix","")
end function

'     return database field type
'     using ADO DataTypeEnum constants
'     the full list available at:
'     http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdcstdatatypeenum.asp
Function GetFieldType(field, table)
	GetFieldType = GetFieldData(table,field,"FieldType",0)
end function

'     return Edit format
Function GetEditFormat(field, table)
	GetEditFormat = GetFieldData(table,field,"EditFormat","")
end function

'     return View format
Function format(field, table)
	format = GetFieldData(table,field,"ViewFormat","")
end function

'     show time in datepicker or not
Function DateEditShowTime(field, table)
	DateEditShowTime = GetFieldData(table,field,"ShowTime",false)
end function

'	use FastType Lookup wizard or not
Function FastType(field, table)
	FastType = GetFieldData(table,field,"FastType",false)
end function

'	is Lookup wizard with multiple selection
function Multiselect(field,table)
	Multiselect = GetFieldData(table,field,"Multiselect",false)
end function

function ShowThumbnail(field,table)
	ShowThumbnail = GetFieldData(table,field,"ShowThumbnail",false)
end function

function GetImageWidth(field,table)
	GetImageWidth = GetFieldData(table,field,"ImageWidth",0)
end function

function GetImageHeight(field,table)
	GetImageHeight = GetFieldData(table,field,"ImageHeight",0)
end function

'	return Lookup Wizard Where expression
function GetLWWhere(field,atable)
    dim table
	table=atable
	If atable = "" Then table = strTableName
	GetLWWhere=""
	exit function
end function

function GetLookupType(field,table)
	GetLookupType =  GetFieldData(table,field,"LookupType",0)
end function

function GetLookupTable(field,table)
	GetLookupTable= GetFieldData(table,field,"LookupTable","")
end function

function GetLWLinkField(field,table)
	GetLWLinkField= GetFieldData(table,field,"LinkField","")
end function

function GetLWLinkFieldType(field,table)
	GetLWLinkFieldType= GetFieldData(table,field,"LinkFieldType",0)
end function

function GetLWDisplayField(field,table)
	GetLWDisplayField= GetFieldData(table,field,"DisplayField","")
end function

function NeedEncode(field,table)
	NeedEncode= GetFieldData(table,field,"NeedEncode",false)
end function

sub GetTablesList(arr)
 	arr.RemoveAll
	arr(arr.count)="evevents"
	arr(arr.count)="evcategories"
	arr(arr.count)="evtellfriend"
end sub

sub GetFieldsList(atable,arr)
 	arr.RemoveAll
    dim table
	table=atable
	If atable = "" Then table = strTableName

	
	if not tables_data.Exists(table) then
		exit sub
	end if
	for each fld in tables_data(table).Keys
		if left(fld,1)<>"." then _
			arr(arr.count) = fld
	next
end sub

sub GetNBFieldsList(table,arr)
 	arr.RemoveAll
	dim arr1
	set arr1=server.createobject("Scripting.Dictionary")
	GetFieldsList table,arr1
	for each f in arr1.Items
		if not IsBinaryType(GetFieldType(f,table)) then
			arr(arr.count)=f
		end if
	next
end sub


'	is Lookup wizard dependent or not
Function UseCategory(field, table)
	UseCategory = GetFieldData(table,field,"UseCategory",false)
end function

'	Category Control field for dependent dropdowns
Function CategoryControl(field, table)
	CategoryControl = GetFieldData(table,field,"CategoryControl","")
end function

'	create Thumbnail or not
function GetCreateThumbnail(field,table)
	GetCreateThumbnail = GetFieldData(table,field,"CreateThumbnail",false)
end function

'	return Thumbnail prefix
function GetThumbnailPrefix(field,table)
	GetThumbnailPrefix = GetFieldData(table,field,"ThumbnailPrefix","")
end function

'     return field name
Function GetFieldByGoodFieldName(field, atable)
    dim table
	table=atable
	If atable = "" Then table = strTableName
	if not tables_data.Exists(table) then
		GetFieldByGoodFieldName = ""
		exit function
	end if

	for each f in tables_data(table)
		if VarType(tables_data(table)(f)) = 9 then
			if tables_data(table)(f)("GoodName")=field then
				GetFieldByGoodFieldName = f
				exit function
			end if 
		end if
	next
	GetFieldByGoodFieldName = ""
end function

'     return the full database field original name
Function GetFullFieldName(field, table)
	dim fname
	fname=AddTableWrappers(GetOriginalTableName(table)) & "." & AddFieldWrappers(field)
	GetFullFieldName = GetFieldData(table,field,"FullName",fname)
end function

'     return height of text area
Function GetNRows(field, table)
	GetNRows = GetFieldData(table,field,"nRows",field)
end function

'     return width of text area
Function GetNCols(field, table)
	GetNCols = GetFieldData(table,field,"nCols",field)
end function

'     return number of chars to show before More... link
Function GetNumberOfChars(table)
	GetNumberOfChars = GetTableData(table,".NumberOfChars",0)
end function

'     return table short name
Function GetTableURL(atable)
	dim table
	table=atable
	If atable = "" Then table = strTableName

        If "evevents" = table Then
                GetTableURL = "evevents"
                Exit Function
        End If
        If "evcategories" = table Then
                GetTableURL = "evcategories"
                Exit Function
        End If
        If "evtellfriend" = table Then
                GetTableURL = "evtellfriend"
                Exit Function
        End If
End Function

'     return table Owner ID field
Function GetTableOwnerID()
	GetTableOwnerID = GetTableData(strTableName,".OwnerID","")
end function

sub GetTableKeys(atable, keys)
	keys.RemoveAll
    dim table
	table=atable
	If atable = "" Then table = strTableName
	if not tables_data.Exists(table) then
		exit sub
	end if
	if not tables_data(table).Exists(".Keys") then
		exit sub
	end if
	dim k
	for each k in tables_data(table)(".Keys").Keys
		keys(k)=tables_data(table)(".Keys")(k)
	next
end sub

'	return original table name
Function GetOriginalTableName(atable)
	dim table
	table=atable
	If atable = "" Then table = strTableName
	GetOriginalTableName = GetTableData(table,".OriginalTable",table)
End Function


'     is field marked as required
Function IsRequired(field, table)
	IsRequired = GetFieldData(table,field,"IsRequired",false)
end function

'     use Rich Text Editor or not
Function UseRTE(field, table)
	UseRTE = GetFieldData(table,field,"UseRTE",false)
end function


'     add timestamp to filename when uploading files or not
Function UseTimestamp(field, table)
	UseTimestamp = GetFieldData(table,field,"UseTimestamp",false)
end function

Function GetUploadFolder(field, table)
	Dim path
	path = GetFieldData(table,field,"UploadFolder","")
	If Len(path) > 0 then
		if Mid(path, Len(path)) <> "/" Then path = path & "/"
	end if
	GetUploadFolder = path
End Function

Function GetFieldIndex(field, table)
	GetFieldIndex = GetFieldData(table,field,"Index",0)
End Function

'     return Date field edit type
Function DateEditType(field, table)
	DateEditType=GetFieldData(table,field,"DateEditType",0)
end function

' returns text edit parameters
Function GetEditParams(field, table)
	GetEditParams=GetFieldData(table,field,"EditParams","")
end function

'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
'// data output functions
'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//

'     format field value for output
Function GetData(data, field, fformat)
	GetData=GetDataInt(data(field),data, field, fformat)
end function

' GetData Internal
Function GetDataInt(value,data, field, fformat)
	
        Dim ret, numbers, l, fso, link, title, iquery, thumbnailed,thumbprefix
        Dim arr(6)
        Set fso = CreateObject("Scripting.FileSystemObject")
        ret = ""
' long binary data?
        If IsBinaryType(GetFieldType(field,"")) Then
                GetDataInt="LONG BINARY DATA - CANNOT BE DISPLAYED"
                Exit Function
        Else
			if GetFieldType(field,"") <> 205 then
				if GetFieldType(field,"")=19 then
					ret = CLng(value)
				else
					ret = value 
				end if
			end if
        End If
		If isnull(ret) Then
                GetDataInt = ""
                Exit Function
        End If
		if vartype(ret)=11 then
			if ret=false then
                GetDataInt = ""
                Exit Function
			end if
        End If
        
        If fformat = FORMAT_DATE_SHORT Then
                ret = format_shortdate(db2time(value))
        Elseif fformat = FORMAT_DATE_LONG Then
			ret = format_longdate(db2time(value))
		ElseIf fformat = FORMAT_DATE_TIME Then
			ret = format_datetime(db2time(value))
		ElseIf fformat = FORMAT_TIME Then
			If IsDateFieldType(GetFieldType(field,"")) Then
				ret = fformat_time(db2time(value))
			Else
				numbers = parsenumbers(value)
				If UBound(numbers) = 0 Then
					GetDataInt = ""
					Exit Function
				End If
				l = UBound(numbers)
				While l < 3
					ReDim Preserve numbers(l + 1)
					numbers(l) = 0
					l=l+1
				Wend
				arr(0) = 0
				arr(1) = 0
				arr(2) = 0
				arr(3) = numbers(0)
				arr(4) = numbers(1)
				arr(5) = numbers(2)
				ret = fformat_time(arr)
			End If
		ElseIf fformat = FORMAT_NUMBER Then
			ret = FormatNumber(CSmartDbl(value))
		ElseIf fformat = FORMAT_CURRENCY Then
			ret = FormatCurrency(CSmartDbl(value))
		ElseIf fformat = FORMAT_CHECKBOX Then
			If CStr(value) <> "" And CStr(value) <> "0" Then
				l = "yes"
			Else
				l = "no"
			End If
			ret = "<img src=""images/check_" & l & ".gif"" border=0>"
		ElseIf fformat = FORMAT_PERCENT Then
			ret=""
			if isNumeric(value) or vartype(value)=14 then ret = (CSmartDbl(value) * 100) & "%"	
		ElseIf fformat = FORMAT_PHONE_NUMBER Then
			If Len(ret) = 7 Then
				ret = Mid(ret, 1, 3) & "-" & Mid(ret, 4)
			Else
				If Len(ret) = 10 Then ret = "(" & Mid(ret, 1, 3) & ") " & Mid(ret, 4, 3) & "-" & mid(ret, 7)
			End If
		ElseIf fformat = FORMAT_FILE_IMAGE Then
			If not CheckImageExtension(ret) Then
				GetDataInt = ""
				Exit Function
			End If
			thumbnailed=false
			thumbprefix=""
			if thumbnailed then
		 ' show thumbnail
				thumbname = thumbprefix & ret
				if mid(GetLinkPrefix(field,""),1,7)<>"http://" then
					if not fso.FileExists(server.MapPath(AddLinkPrefix(field,thumbname,""))) then _
						thumbname = ret
				end if
				ret="<a target=_blank href=""" & my_htmlspecialchars(AddLinkPrefix(field,ret,""))& """>"
				ret= ret & "<img border=0"
				ret=ret & " src=""" & my_htmlspecialchars(AddLinkPrefix(field,thumbname,"")) & """></a>"
			else
				ret = "<img src=""" & AddLinkPrefix(field, ret,"") & """ border=0>"
			end if
		ElseIf fformat = FORMAT_HYPERLINK Then
			ret = GetHyperlink(ret, field, data, strTableName)
		ElseIf fformat = FORMAT_EMAILHYPERLINK Then
			link = ret
			title = ret
			If Mid(ret, 1, 7) = "mailto:" Then
				title = Mid(ret, 8)
			Else
				link = "mailto:" & link
			End If
			ret = "<a href=""" & link & """>" & title & "</a>"
		ElseIf fformat = FORMAT_FILE Then
			iquery = "field=" & SafeURLEncode(field)
			If strTableName = "evevents" Then
				iquery = iquery & "&key1=" & SafeURLEncode(dbvalue(data("EventID")))
			End If
			If strTableName = "evcategories" Then
				iquery = iquery & "&key1=" & SafeURLEncode(dbvalue(data("Category")))
			End If
			If strTableName = "evtellfriend" Then
			End If
			GetDataInt = "<a href=""" & GetTableURL(strTableName) & "_download.asp?" & iquery & """.>" & ret & "</a>"
			Exit Function
		ElseIf GetEditFormat(field,"") = EDIT_FORMAT_CHECKBOX And fformat = FORMAT_NONE Then
			If ret <> "" And ret <> 0 Then
				ret="Yes"
			Else
				ret="No"
			End If
		ElseIf fformat = FORMAT_CUSTOM Then 
			ret = CustomExpression(value,data, field, strTableName)
		End If
        GetDataInt = ret
End Function

'     return custom expression
Function CustomExpression(strValue, data, field, table)
        If table = "" Then table = strTableName
        CustomExpression = strValue
End Function

Function my_htmlspecialchars(str)
        Dim ret
        if IsArray(str) then 
			ret = str(0)
        else
			ret=str
		end if	
        if len(ret)>0 then
			ret = Replace(ret, "&", "&amp;")
			ret = Replace(ret, """", "&quot;")
			ret = Replace(ret, "'", "&#039;")
			ret = Replace(ret, "<", "&lt;")
			ret = Replace(ret, ">", "&gt;")
		end if
        my_htmlspecialchars = ret
End Function

Function ProcessLargeText(strValue, iquery, table, mode)
	Dim cNumberOfChars, ret, ind
	If mode = "" Then mode = MODE_LIST

	cNumberOfChars = GetNumberOfChars(table)
	If Mid(strValue, 1, 8) = "<a href=" Then
		ProcessLargeText = strValue
		Exit Function
	End If
	If Mid(strValue, 1, 23) = "<img src=""images/check_" Then
		ProcessLargeText = strValue
		Exit Function
	End If
	If cNumberOfChars > 0 And Len(strValue) > cNumberOfChars And (Len(strValue) < 200 Or Len(iquery)=0) And mode = MODE_LIST Then
		ret = Mid(strValue, 1, cNumberOfChars)
		ret = my_htmlspecialchars(ret)
		ret = ret & " <a href=""#"" onClick=""javascript: pwin = window.open('',null,'height=300,width=400,status=yes,resizable=yes,toolbar=no,menubar=no,location=no,left=150,top=200,scrollbars=yes');" 
		ind = 1
		ret = ret & "pwin.document.write('" & my_htmlspecialchars(jsreplace(Replace(Mid(strValue, 1, 801), vbcrlf, "<br>"))) & "');" 
		ret=ret & "pwin.document.write('<br><hr size=1 noshade><a href=# onClick=\'window.close();return false;\'>" & "Close window" & "</a>');" 
		ret=ret & "return false;"">" & "More" & " ...</a>"
	Elseif cNumberOfChars > 0 And Len(strValue) > cNumberOfChars And mode = MODE_LIST Then
		table = GetTableURL(table)
		ret = Mid(strValue, 1, cNumberOfChars)
		ret = my_htmlspecialchars(ret)
		ret = ret & " <a href=#  onClick=""javascript: pwin = window.open('',null,'height=300,width=400,status=yes,resizable=yes,toolbar=no,menubar=no,location=no,left=150,top=200,scrollbars=yes');" 
		ret=ret & " pwin.location='" & table & "_fulltext.asp?" & iquery & "'; return false;"">" & "More" & " ...</a>" 
	Elseif cNumberOfChars > 0 And Len(strValue) > cNumberOfChars And mode = MODE_PRINT Then
		ret = Mid(strValue, 1, cNumberOfChars)
		ret = my_htmlspecialchars(ret)
		If Len(strValue) > cNumberOfChars Then ret = ret & " ..."
	Else
		ret = my_htmlspecialchars(strValue)
	End If
	if not isnull(ret) then _
		ret = replace(ret,vbcrlf,"<br>")
	ProcessLargeText = ret
End Function

'     construct hyperlink
Function GetHyperlink(str, field, data, table)
        Dim ret, title, link, i, target, ttype
        If Len(table) = 0 Then table = strTableName
        If Len(str) = 0 Then
                GetHyperlink = ""
                Exit Function
        End If
        ret = str
        title = ret
        link = ret
        If Mid(ret, Len(ret)) = "#" Then
                i = InStr(1, ret, "#")
				if i<Len(ret) then
	                title = Mid(ret, 1, i - 1)
    	            link = Mid(ret, i + 1, Len(ret) - i - 1)
        	        If title = "" Then title = link
				end if
        End If
        target = ""
        
        If "evevents" = table Then
                If field = "Map" Then
                                        target = " target=_blank"
                        ttype = 1
                        If ttype = 1 Then title = "See Map"
                        If ttype = 2 Then title = data("See Map")
                        prefix = ""
                End If
        End If
        If InStr(1, link, "://") = 0 And Mid(link, 1, 7) <> "mailto:" Then link = prefix & link
        ret = "<a href=""" & link & """" & target & ">" & title & "</a>"
        GetHyperlink = ret
End Function

'     add prefix to the URL
Function AddLinkPrefix(field, link, table)
        If InStr(1, link, "://") = 0 And Mid(link, 1, 7) <> "mailto:" Then
                AddLinkPrefix = GetLinkPrefix(field, table) & link
                Exit Function
        End If
                AddLinkPrefix = link
End Function

'     return Totals string
Function GetTotals(field,value, stype, iNumberOfRows, sFormat)
        If stype = "AVERAGE" Then
                If iNumberOfRows <> 0 Then
                        value = round(value / iNumberOfRows,2)
                Else
                        GetTotals = ""
                        Exit Function
                End If
        End If
		dim sValue
		sValue=""
        If sFormat = FORMAT_CURRENCY Then
            sValue = fformat_currency(value)
        ElseIf sFormat = FORMAT_NUMBER Then 
			sValue = fformat_number(value)
		ElseIf sFormat = FORMAT_PERCENT Then 	
			sValue = fformat_number(value*100) & "%"	
		ElseIf sFormat = FORMAT_CUSTOM Then 	
			set tarr=CreateObject("Scripting.Dictionary")
			tarr(field)=value
			sValue = GetData(tarr,field,sFormat)
        ElseIf sFormat = FORMAT_NONE Then 
			sValue = value
        End If

        If stype = "COUNT" Then
                GetTotals = value
                Exit Function
        End If
        If stype = "TOTAL" Then
                GetTotals = sValue
                Exit Function
        End If
        If stype = "AVERAGE" Then
                GetTotals = sValue
                Exit Function
        End If
        GetTotals = ""
End Function

'	display Lookup Wizard value in List/View mode
function DisplayLookupWizard(field, value, data, keylink, mode)
	if isnull(value) then
		DisplayLookupWizard = ""
		exit function
	end if
	if CStr(value)="" then
		DisplayLookupWizard = ""
		exit function
	end if
	dim LookupSQL
	dim where
	dim lookupvalue
	
	LookupSQL="SELECT "
	LookupSQL = LookupSQL & GetLWDisplayField(field,"")
	LookupSQL = LookupSQL & " FROM " & AddTableWrappers(GetLookupTable(field,"")) & " WHERE "
	where=""
	lookupvalue=value
	dim rss
   	Set rss = server.CreateObject("ADODB.Recordset")

	if Multiselect(field,"") then
		dim numeric
		dim ftype
		dim arr
		arr = splitvalues(value)
		numeric=true
		ftype = GetLWLinkFieldType(field,"")
		if ftype=0 then
			for each val in arr
				if val<>"" and not isNumeric(val) then
					numeric=false
					exit for
				end if
			next
		else
			numeric =  not NeedQuotes(ftype)
		end if
		dim strIn
		strIn=""
		for each val in arr
			if not numeric or val<>"" then
				if strIn<>"" then _
					strIn = strIn & ","
				if numeric then
					strIn = strIn & CStr(CSmartDbl(val))
				else
					strIn= strIn & "'" & db_addslashes(val) & "'"
				end if
			end if
		next
		if strIn<>"" then
			LookupSQL = LookupSQL & GetLWLinkField(field,"") & " in (" & strIn & ")"
			where = GetLWWhere(field,"")
			if where <>"" then _
				LookupSQL= LookupSQL & " and ("& where & ")"
			
			LogInfo(LookupSQL)
			rss.open LookupSQL,dbConnection 
			call ReportError
			dim out
			out=""
			if not rss.eof then
				while not rss.eof
					if out<>"" then _
						out = out & ","
					out = out & GetDataInt(dbvalue(rss(0).value),rss,field, Format(field,""))
					rss.MoveNext
				wend
				rss.close
				set rss=nothing
				if NeedEncode(field,"") and mode<>MODE_EXPORT then
					DisplayLookupWizard = ProcessLargeText(out,"field=" & my_htmlspecialchars(SafeURLEncode(field))& keylink,"",mode)
				else
					DisplayLookupWizard = out
				end if
				exit function
			end if
		end if
	else
		dim strdata
		strdata = make_db_value(field,value,"","")
		LookupSQL = LookupSQL & GetLWLinkField(field,"") & " = " & strdata
		where = GetLWWhere(field,"")
		if where<>"" then _
			LookupSQL = LookupSQL & " and (" & where & ")"
		LogInfo(LookupSQL)
		rss.open LookupSQL,dbConnection
		call ReportError
		
		if not rss.eof then _
			lookupvalue=dbvalue(rss(0).value)
	end if
	if NeedEncode(field,"") and mode<>MODE_EXPORT then
		value=ProcessLargeText(GetDataInt(lookupvalue,data,field, Format(field,"")),"field=" & my_htmlspecialchars(SafeURLEncode(field)) & keylink,"",mode)
	else
		value=GetDataInt(lookupvalue,data,field, Format(field,""))
	end if
	 DisplayLookupWizard = value
end function

'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
'// miscellaneous functions
'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//


'     return POST or GET value - single value or array

Function postvalue(name) '???
	dim value, i
	dim ret
	if parse<>1 then
		if request.form(name)<>"" then
			value=request.form(name)
			if request.form(name).Count=0 then 
	            postvalue = ""
	            exit function
			end if
			if request.form(name).Count=1 then 
				postvalue = value
				exit function
			end if
			redim ret(request.form(name).Count-1)
			for i=1 to request.form(name).Count
				ret(i-1)=request.form(name).Item(i)
			next
		elseif request.querystring(name)<>"" then
			value=request.querystring(name)
			if request.querystring(name).Count=0 then 
	            postvalue = ""
	            exit function
			end if
			if request.querystring(name).Count=1 then 
				postvalue = value
				exit function
			end if
			redim ret(request.querystring(name).Count-1)
			for i=1 to request.querystring(name).Count
				ret(i-1)=request.querystring(name).Item(i)
			next
		else
            postvalue = ""
            exit function
		end if
        postvalue = ret
        exit function
    else
		if getRequestForm(name & "[]")<>"" then
			name= name & "[]"
			postvalue=getRequestForm(name)
		else
			postvalue=getRequestForm(name)
            exit function
		end if
    end if
       
End Function

'     analog of strrpos function
Function my_strrpos(haystack, needle)
   Dim index
   index = InStrRev(haystack, needle)
   If index = 0 Then
       my_strrpos = False
       Exit Function
   End If
   index = Len(haystack) - Len(needle) - index
   my_strrpos = index
End Function

'     utf-8 analog of strlen function
Function strlen_utf8(str)
        Dim vlen, i, olen, c
        vlen = 0
        i = 0
        olen = Len(str)
        While i < olen
                c = Asc(Mid(str, i + 1, 1))
                If c < 128 Then
                        i = i + 1
                Else
                        If i < olen - 1 And c >= 192 And c <= 223 Then
                                i = i + 2
                        Else
                                If i < olen - 2 And c >= 224 And c <= 239 Then
                                        i = i + 3
                                Else
                                        If i < olen - 3 And c >= 240 Then
                                                i = i + 4
                                        Else
                                                i = olen + 1
                                        End If
                                End If
                        End If
                End If
                vlen = vlen + 1
        Wend
        strlen_utf8 = vlen
End Function

'     utf-8 analog of substr function
Function substr_utf8(str, index, strlen)
        Dim vlen, olen, oindex, c, i
        If strlen <= 0 Then
                substr_utf8 = ""
                Exit Function
        End If
        vlen = 0
        i = 0
        olen = Len(str)
        oindex = -1
        While i < olen
                If vlen = index Then oindex = i
                
                c = Asc(Mid(str, i + 1, 1))
                If c < 128 Then
                        i = i + 1
                Else
                        If i < olen - 1 And c >= 192 And c <= 223 Then
                                i = i + 2
                        Else
                                If i < olen - 2 And c >= 224 And c <= 239 Then
                                        i = i + 3
                                Else
                                        If i < olen - 3 And c >= 240 Then
                                                i = i + 4
                                        Else
                                                c = 200
                                        End If
                                End If
                        End If
                End If
                vlen = vlen + 1
                If oindex >= 0 And vlen = index + strlen Then
                        substr_utf8 = Mid(str, oindex + 1, i - oindex)
                        Exit Function
                End If
        Wend
        If oindex > 0 Then substr_utf8 = Mid(str, oindex + 1, olen - oindex)
        substr_utf8 = ""
End Function

'     read the whole file and return contents
Function myfile_get_contents(filename)
        Dim fso, handle, contents, fsize, f
        Set fso = CreateObject("Scripting.FileSystemObject")
        If Not fso.FileExists(filename) Then
                myfile_get_contents = False
                Exit Function
        End If
        f = fso.GetFile(filename)
        fsize = f.Size
        handle = fso.OpenTextFile(filename, 1, True)
        If handle Is Nothing Then
                myfile_get_contents = False
                Exit Function
        End If
        If fsize > 0 Then
                contents = fso.read(fsize)
        Else
                contents = ""
        End If
        fso.Close
        myfile_get_contents = contents
End Function

'     construct "good" field name
Function GoodFieldName(field)
        Dim i, t, ffield
        ffield=field
        For i = 0 To Len(ffield) - 1
                t = Asc(Mid(ffield, i + 1, 1))
                If (t < Asc("a") Or t > Asc("z")) And (t < Asc("A") Or t > Asc("Z")) And (t < Asc("0") Or t > Asc("9")) Then
                        If i > 0 Then
                                ffield = Left(ffield, i) & "_" & Mid(ffield, i + 2)
                        Else
                                ffield = "_" & Mid(ffield, i + 2)
                        End If
                End If
        Next
        GoodFieldName = ffield
End Function


Function LogInfo(sql)
        dSQL = sql
        If dDebug Then response.Write dSQL & "<br>"
End Function

'     suggest image type by extension
Function SupposeImageType(file)
	If LenB(file) > 1 And MidB(file, 1, 2) = chrb(asc("B")) & chrb(asc("M"))  Then
    	SupposeImageType = "image/bmp"
		Exit Function
	End If
	If LenB(file) > 2 And MidB(file, 1, 3) = chrb(asc("G")) & chrb(asc("I"))& chrb(asc("F"))  Then
		SupposeImageType = "image/gif"
		Exit Function
    End If
	if LenB(file) > 3 and  MidB(file, 1, 3) = chrb(&Hff) & chrb(&Hd8) & chrb(&Hff) then
		SupposeImageType = "image/jpeg"
		Exit Function
    End If
	if LenB(file) > 8 and MidB(file, 1, 8) = chrb(&H89) & chrb(&H50) & chrb(&H4e) & chrb(&H47) _
											& chrb(&H0d) & chrb(&H0a) & chrb(&H1a) & chrb(&H0a)  then
		SupposeImageType = "image/png"
		Exit Function
    End If
    SupposeImageType=""
End Function

'     check if file extension is image extension
Function CheckImageExtension(filename)
        Dim ext
        If Len(filename) < 4 or isnull(filename) Then
                CheckImageExtension = false
                Exit Function
        End If
        ext = UCase(right(filename,4))
        If ext = ".GIF" Or ext = ".JPG" Or ext = "JPEG" Or ext = ".PNG" Or ext = ".BMP" Then
                CheckImageExtension = True
                Exit Function
        End If
        CheckImageExtension = False
End Function


Function RTESafe(strText)
        Dim tmpString
'     returns safe code for preloading in the RTE
        tmpString = ""
        
        tmpString = Trim(strText)
        If tmpString = "" Then RTESafe = ""
        
'     convert all types of single quotes
        tmpString = Replace(tmpString, Chr(145), Chr(39))
        tmpString = Replace(tmpString, Chr(146), Chr(39))
        tmpString = Replace(tmpString, "'", "&#39;")
        
'     convert all types of double quotes
        tmpString = Replace(tmpString, Chr(147), Chr(34))
        tmpString = Replace(tmpString, Chr(148), Chr(34))
        
'     replace carriage returns & line feeds
        tmpString = Replace(tmpString, Chr(10), " ")
        tmpString = Replace(tmpString, Chr(13), " ")
        
        RTESafe = tmpString
End Function


Function tnow()
        tnow = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Time) & ":" & Minute(Time) & ":" & Second(Now)
End Function

Function html_special_decode(str)
        Dim ret
        ret = str
        ret = Replace(ret, "&", "&amp;")
        ret = Replace(ret, """", "&quot;")
        ret = Replace(ret, "'", "&#039;")
        ret = Replace(ret, "<", "&lt;")
        ret = Replace(ret, ">", "&gt;")
        html_special_decode = ret
End Function

Function HTMLDecode(str)
        Dim ret
        ret = str
        ret = Replace(ret, "&amp;", "&")
        ret = Replace(ret, "&quot;", """")
        ret = Replace(ret, "&#039;", "'")
        ret = Replace(ret, "&lt;", "<")
        ret = Replace(ret, "&gt;", ">" )
        HTMLDecode = ret
End Function
''//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
'// database and SQL related functions
'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//

'	add WHERE condition to gstrSQL
function gSQLWhereAdd(where)
	dim sstrWhere
	sstrWhere=whereAdd(gsqlWhere,where)
	if sstrWhere<>"" then _
		sstrWhere=" where " & sstrWhere & " "
	gSQLWhereAdd = gsqlHead & gsqlFrom & sstrWhere & gsqlTail
end function

'	add clause to WHERE expression
function whereAdd(where,clause)
	if clause="" then
		whereAdd=where
		exit function
	end if
	if where="" then
		whereAdd=clause
		exit function
	end if
	whereAdd="(" & where & ") and (" & clause & ")"
end function

'     add WHERE clause to SQL string
Function AddWhere(strSQL, sWhere)
	if sWhere="" or InStr(strSQL, sWhere)>0 then 
		AddWhere = strSQL
		Exit Function
	end if
	n = InStrRev(LCase(strSQL), " where ")
	n1 = InStrRev(LCase(strSQL), " group by ")
	n2 = InStrRev(LCase(strSQL), " order by ")
	if n1=0 then n1=len(strSQL)
	if n2=0 then n2=len(strSQL)
	if n1>n2 then 
		n1=n2
	end if
	if n > 0 then 
		AddWhere = Left(strSQL, n-1+Len(" where ")) & "(" & Mid(strSQL, n+Len(" where ")) & ") and (" & sWhere & ") "
	else
		AddWhere = Left(strSQL,n1) & " where (" & sWhere & ") " & Mid(strSQL,n1+1)
	end if
		
End Function

'     construct WHERE clause with key values
Function KeyWhere(keys(), table)
        Dim strWhere, value
        If table = "" Then table = strTableName
        strWhere = ""

'     evevents
        If table = "evevents" Then
                        value = make_db_value("EventID", keys("EventID"),"","")
                If value="null" Then
                        strWhere = strWhere & GetFullFieldName("EventID","") & " is null"
                Else
                        strWhere = strWhere & GetFullFieldName("EventID","") & "=" & make_db_value("EventID", keys("EventID"),"","")
                End If
        End If

'     evcategories
        If table = "evcategories" Then
                        value = make_db_value("Category", keys("Category"),"","")
                If value="null" Then
                        strWhere = strWhere & GetFullFieldName("Category","") & " is null"
                Else
                        strWhere = strWhere & GetFullFieldName("Category","") & "=" & make_db_value("Category", keys("Category"),"","")
                End If
        End If

'     evtellfriend
        If table = "evtellfriend" Then
        End If
        KeyWhere = strWhere
End Function

'     consctruct SQL WHERE clause for simple search
Function StrWhere(strField, SearchFor, strSearchOption, SearchFor2)
        Dim ttype, strQuote, sSearchFor, sSearchFor2, ttime, ret
        ttype = GetFieldType(strField,"")
        If strSearchOption = "Empty" Then
                If IsCharType(ttype) Then
                        StrWhere = "(" & GetFullFieldName(strField,"") & " is null or " & GetFullFieldName(strField,"") & "='')"
                        Exit Function
                Else
                        StrWhere = GetFullFieldName(strField,"") & " is null"
                        Exit Function
                End If
        End If
        strQuote = ""
        If NeedQuotes(ttype) Then strQuote = "'"
'     return none if trying to compare numeric field and string value
        sSearchFor = SearchFor
        sSearchFor2 = SearchFor2
        If IsBinaryType(ttype) or ttype=13 Then
			StrWhere = ""
			Exit Function
        End If
        If IsDateFieldType(ttype) And strSearchOption <> "Contains" And strSearchOption <> "Starts with ..." Then
                ttime = localdatetime2db(SearchFor,"")
                If IsNull(ttime) Then
                        StrWhere = ""
                        Exit Function
                End If
                sSearchFor = db_datequotes(ttime)
                If strSearchOption = "Between" Then
                        ttime = localdatetime2db(SearchFor2,"")
                        If IsNull(Time) Then
                                sSearchFor2 = ""
                        Else
                                sSearchFor2 = db_datequotes(ttime)
                        End If
                End If
        End If
        
        If strQuote = "" And Not IsNumeric(sSearchFor) And Not IsNumeric(sSearchFor) Then
            StrWhere = ""
            Exit Function
        Elseif strQuote = "" And strSearchOption <> "Contains" And strSearchOption <> "Starts with ..." Then
			sSearchFor = my_numeric(sSearchFor)
            sSearchFor2 = my_numeric(sSearchFor2)
		Elseif Not IsDateFieldType(ttype) And strSearchOption <> "Contains" And strSearchOption <> "Starts with ..." Then
	            sSearchFor = db_upper(strQuote & db_addslashes(sSearchFor) & strQuote)
            If strSearchOption = "Between" And sSearchFor2<>"" Then 
				sSearchFor2 = db_upper(strQuote & db_addslashes(sSearchFor2) & strQuote)
			end if
		Elseif Not IsDateFieldType(ttype) or strSearchOption="Contains" or strSearchOption="Starts with ..." Then 
			sSearchFor = db_addslashes(sSearchFor)
		End If
                                        
	if IsCharType(ttype)  then
		strField=db_upper(GetFullFieldName(strField,""))
	else
		strField=GetFullFieldName(strField,"")
	end if

        ret = ""
        If strSearchOption = "Contains" Then
                if IsCharType(ttype)  then
                        StrWhere = strField & " like " & db_upper("'%" & sSearchFor & "%'")
                        Exit Function
                Else
                        StrWhere = strField & " like '%" & sSearchFor & "%'"
                        Exit Function
                End If
        Elseif strSearchOption = "Equals" Then
			StrWhere = strField & "=" & sSearchFor
			Exit Function
        ElseIf strSearchOption = "Starts with ..." Then
			if IsCharType(ttype)  then
            	StrWhere = strField & " like " & db_upper("'" & sSearchFor & "%'")
			Else
            	StrWhere = strField & " like '" & sSearchFor & "%'"
			End If
            exit function
		Elseif strSearchOption = "More than ..." Then
			StrWhere = strField & ">" & sSearchFor
            Exit Function
        Elseif strSearchOption = "Less than ..." Then
			StrWhere = strField & "<" & sSearchFor
            Exit Function
		Elseif strSearchOption = "Equal or more than ..." Then
			StrWhere = strField & ">=" & sSearchFor
			Exit Function
		Elseif strSearchOption = "Equal or less than ..." Then
			StrWhere = strField & "<=" & sSearchFor
			Exit Function
		Elseif strSearchOption = "Between" Then
			ret = strField & ">=" & sSearchFor
			If sSearchFor2 <> "" Then ret = ret & " and " & strField & "<=" & sSearchFor2
			StrWhere = ret
			Exit Function
		End If
        StrWhere = ""
End Function

'     construct SQL WHERE clause for Advanced search
Function StrWhereAdv(strField, SearchFor, strSearchOption, SearchFor2, etype)
        Dim ttype, ret, value, aSearchFor, i
        ttype = GetFieldType(strField,"")
        If IsBinaryType(ttype) Then
                StrWhereAdv = ""
                Exit Function
        End If
        If strSearchOption = "Empty" Then
                If IsCharType(ttype) Then
                        StrWhereAdv = "(" & GetFullFieldName(strField,"") & " is null or " & GetFullFieldName(strField,"") & "='')"
                        Exit Function
                Else
                        StrWhereAdv = GetFullFieldName(strField,"") & " is null"
                        Exit Function
                End If
        End If
        If GetEditFormat(strField,"") = EDIT_FORMAT_LOOKUP_WIZARD Then
				if Multiselect(strField,"") then
					aSearchFor=splitvalues(SearchFor)
				else
					redim aSearchFor(1)
					aSearchFor(0)=SearchFor
				end if
'                aSearchFor = splitvalues(SearchFor)
                ret = ""
                For i = 0 To UBound(aSearchFor) - 1
                        If Not (aSearchFor(i) = "null" Or aSearchFor(i) = "Null" Or aSearchFor(i) = "") Then
                                If Len(ret) <> 0 Then ret = ret & " or "
                                If strSearchOption = "Equals" Then
                                        aSearchFor(i) = make_db_value(strField, aSearchFor(i),"","")
                                        If Not (aSearchFor(i) = "null" Or aSearchFor(i) = "Null") Then ret = ret & GetFullFieldName(strField,"") & "=" & aSearchFor(i)
                                Else
									value=aSearchFor(i)
									if instr(value,",")>0 or instr(value,"""")>0 then _
										value = """" & replace(value,"""","""""") & """"
									value=db_addslashes(value)
									ret = ret & GetFullFieldName(strField,"") & " = '" & value & "'"
									ret = ret & " or " & GetFullFieldName(strField,"") & " like '%," & value & ",%'"
									ret = ret & " or " & GetFullFieldName(strField,"") & " like '%," & value & "'"
									ret = ret & " or " & GetFullFieldName(strField,"") & " like '" & value & ",%'"
'										aSearchFor(i) = db_addslashes(aSearchFor(i))
'                                       ret = ret & GetFullFieldName(strField,"") & " like '%" & aSearchFor(i) & "%'"
                                End If
                        End If
                Next
                If Len(ret) <> 0 Then ret = "(" & ret & ")"
                StrWhereAdv = ret
				exit function
        End If
        value1 = make_db_value(strField, SearchFor, etype,"")
        value2 = False
        If strSearchOption = "Between" Then value2 = make_db_value(strField, SearchFor2, etype,"")
        If strSearchOption <> "Contains" And strSearchOption <> "Starts with ..." And (IsNull(value1) Or IsNull(value2) or value1="null" or value2="null") Then
                StrWhereAdv = ""
                Exit Function
        End If

        if ischartype(ttype)  then
                value1 = db_upper(value1)
                value2 = db_upper(value2)
                strField = db_upper(GetFullFieldName(strField,""))
	else
		strField=GetFullFieldName(strField,"")
	end if
	ret = ""
	If strSearchOption = "Contains" Then
		if ischartype(ttype)  then
			StrWhereAdv = strField & " like " & db_upper("'%" & db_addslashes(SearchFor) & "%'")
			Exit Function
		Else
			StrWhereAdv = strField & " like '%" & db_addslashes(SearchFor) & "%'"
			Exit Function
		End If
	ElseIf strSearchOption = "Equals" Then
		StrWhereAdv = strField & "=" & value1
		Exit Function
	ElseIf strSearchOption = "Starts with ..." Then
		if ischartype(ttype)  then
			StrWhereAdv = strField & " like " & db_upper("'" & db_addslashes(SearchFor) & "%'")
			Exit Function
		Else
			StrWhereAdv = strField & " like '" & db_addslashes(SearchFor) & "%'"
			Exit Function
		End If
	ElseIf strSearchOption = "More than ..." Then
		StrWhereAdv = strField & ">" & value1
		Exit Function
	ElseIf strSearchOption = "Less than ..." Then
		StrWhereAdv = strField & "<" & value1
		Exit Function
	ElseIf strSearchOption = "Equal or more than ..." Then
		StrWhereAdv = strField & ">=" & value1
		Exit Function
	ElseIf strSearchOption = "Equal or less than ..." Then
		StrWhereAdv = strField & "<=" & value1
		exit function
	ElseIf strSearchOption = "Between" Then
		ret = strField & ">=" & value1
		ret = ret & " and " & strField & "<=" & value2
		StrWhereAdv = ret
		Exit Function
	End If
	StrWhereAdv = ""
End Function


'	get count of rows from the query
function gSQLRowCount(where,groupby)

	dim strWhere
	dim rc,cc
	strWhere=whereAdd(gsqlWhere,where)
	if strWhere<>"" then _
		strWhere=" where " & strWhere & " "
	
	if groupby=0 then
		countstr = "select count(*) " & gsqlFrom & strWhere & gsqlTail
	else
	'	get mysql version number
		dim mysqlversion
		mysqlversion = "4"
		Set rc = server.CreateObject("ADODB.Recordset")
		rc.Open "SHOW VARIABLES LIKE 'version'",dbConnection
		mysqlversion=rc(0).value
		rc.Close
		set rc=nothing
		if mid(mysqlversion,1,1)>"4" then
			countstr = "select count(*) from (" & gSQLWhereAdd(where) & ") a"
		else
			countstr=gSQLWhereAdd(where)
			Set rc = server.CreateObject("ADODB.Recordset")
			rc.Open countstr,dbConnection
			cc=0
			while not rc.eof
				cc=cc+1
				rc.MoveNext
			wend
			rc.Close
			set rc=nothing
			gSQLRowCount=cc
			exit function
		end if
	end if

	Set rc = server.CreateObject("ADODB.Recordset")
	rc.Open countstr,dbConnection
	cc=rc(0).value
	rc.Close
	set rc=nothing
	gSQLRowCount=CLng(cc)
end function

'     get count of rows from the query
Function GetRowCount(strSQL)
	strSQL=replace(strSQL,vbcrlf," ")
	strSQL=replace(strSQL,vblf," ")
	tstr = ucase(strSQL)
	ind1 = instr(tstr,"SELECT ")
	ind2 = instr(tstr," FROM ")
	ind3 = instr(tstr," GROUP BY ")
	if ind3=0 then
		ind3 = instr(tstr," ORDER BY ")
		if ind3=0 then ind3=len(strSQL)
	end if
	countstr=mid(strSQL,1,ind1+6) & " count(*) " & mid(strSQL,ind2+1,ind3-ind2)
	Set rc = server.CreateObject("ADODB.Recordset")
	rc.Open countstr,dbConnection
	cc=rc(0)
	rc.Close
	set rc=nothing
	GetRowCount=CLng(cc)
End Function

'     add MSSQL Server TOP clause
Function AddTop(strSQL, n)
        Dim tstr, ind1
        tstr = UCase(strSQL)
        ind1 = InStr(tstr, "SELECT")
        AddTop = Mid(strSQL, 1, ind1 + 6) & " top " & n & Mid(strSQL, ind1 + 6)
End Function

'     add Oracle ROWNUMBER checking
Function AddRowNumber(strSQL, n)
        AddRowNumber = "select * from (" & strSQL & ") where rownum<" & (n + 1)
End Function

' test database type if values need to be quoted
Function NeedQuotesNumeric(ttype)
    If ttype = 203 Or ttype = 8 Or ttype = 129 Or ttype = 130 Or _
                ttype = 7 Or ttype = 133 Or ttype = 134 Or ttype = 135 Or _
                ttype = 201 Or ttype = 205 Or ttype = 200 Or ttype = 202 Or ttype = 72 Or ttype = 13 Then
                NeedQuotesNumeric = True
        Else
                NeedQuotesNumeric = False
        End If
End Function

'     using ADO DataTypeEnum constants
'     the full list available at:
'     http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ado270/htm/mdcstdatatypeenum.asp

Function IsNumberType(ttype)
        If ttype = 20 Or ttype = 6 Or ttype = 14 Or ttype = 5 Or ttype = 10 _
        Or ttype = 3 Or ttype = 131 Or ttype = 4 Or ttype = 2 Or ttype = 16 _
        Or ttype = 21 Or ttype = 19 Or ttype = 18 Or ttype = 17 Or ttype = 139 or ttype=11 Then
                IsNumberType = True
                Exit Function
        End If
        IsNumberType = False
End Function

Function NeedQuotes(ttype)
        NeedQuotes = Not IsNumberType(ttype)
End Function

Function IsBinaryType(ttype)
		If ttype = 128 Or ttype = 205 Or ttype = 204 Then
                IsBinaryType = True
                Exit Function
        End If
        IsBinaryType = False
End Function

Function IsDateFieldType(ttype)
		If ttype = 7 Or ttype = 133 Or ttype = 135 Then
                IsDateFieldType = True
                Exit Function
        End If
        IsDateFieldType = False
End Function

Function IsCharType(ttype)
        If IsTextType(ttype) Or ttype = 8 Or ttype = 129 Or ttype = 200 Or ttype = 202 Or ttype = 130 Then
                IsCharType = True
                Exit Function
        End If
        IsCharType = False
End Function

Function IsTextType(ttype)
        If ttype = 201 Or ttype = 203 Then
                IsTextType = True
                Exit Function
        End If
        IsTextType = False
End Function



'      return user permissions on the table
'      A - Add
'      D - Delete
'      E - Edit
'      S - List/View/Search
'      P - Print/Export
'      I - Import


function GetUserPermissions(table)
        if table="" then table=strTableName
        if SESSION("AccessLevel") = ACCESS_LEVEL_ADMIN then GetUserPermissions = "ADESPIM"
		dim sUserGroup
        sUserGroup=SESSION("GroupID")
        if table="evevents" and sUserGroup="members" then
                    GetUserPermissions = "SP"
			exit function
		end if
'      default permissions
        if table="evevents" then
			GetUserPermissions = "AEDSPI"
			exit function
		end if
        if table="evcategories" and sUserGroup="members" then
                    GetUserPermissions = ""
			exit function
		end if
'      default permissions
        if table="evcategories" then
			GetUserPermissions = "AEDSPI"
			exit function
		end if
        if table="evtellfriend" and sUserGroup="members" then
                    GetUserPermissions = ""
			exit function
		end if
'      default permissions
        if table="evtellfriend" then
			GetUserPermissions = ""
			exit function
		end if
end function



'      check whether field is viewable
function CheckFieldPermissions(field, table)
	CheckFieldPermissions = GetFieldData(table,field,"FieldPermissions",false)
end function

'
function CheckSecurity(strVal, strAction)
        if SESSION("AccessLevel")=ACCESS_LEVEL_ADMIN then
			CheckSecurity = true
            exit function
        end if
	dim strValue
	strValue=strVal
	if isnull(strValue) then
		strValue=""
	end if

	dim strPerm
	strPerm = GetUserPermissions("")

	if SESSION("AccessLevel")<>ACCESS_LEVEL_ADMINGROUP and instr(1,strPerm,"M")<=0 then
	end if
	'	check user group permissions
	if strAction="Add" and instr(1,strPerm,"A")>0 or _
		strAction="Edit" and instr(1,strPerm, "E")>0 or _
		strAction="Delete" and instr(1,strPerm, "D")>0 or _
		strAction="Search" and instr(1,strPerm, "S")>0 or _
		strAction="Import" and instr(1,strPerm, "I")>0 or _
		strAction="Export" and instr(1,strPerm, "P")>0 then
		CheckSecurity = true
		exit function
	Else
		CheckSecurity = false
		exit function
	end if
	CheckSecurity = true
end function


'      add security WHERE clause to SELECT SQL command
function SecuritySQL(strAction)
	dim ownerid, ret, strPerm
        ownerid=SESSION("_" & strTableName & "_OwnerID")
        ret=""
        if SESSION("AccessLevel")=ACCESS_LEVEL_ADMIN then
                SecuritySQL = ""
                exit function
        end if
        ret=""

        strPerm = GetUserPermissions("")

	if SESSION("AccessLevel")<>ACCESS_LEVEL_ADMINGROUP and instr(1,strPerm,"M")<=0 then
	end if

        if strAction="Edit" and instr(strPerm, "E")>0 or _
           strAction="Delete" and instr(strPerm, "D")>0 or _
           strAction="Search" and instr(strPerm, "S")>0 or _
           strAction="Export" and instr(strPerm, "P")>0 then
                SecuritySQL = ret
        Else
                SecuritySQL = "1=0"
        end if
end function

'//////////////////////////////////////////////////////////////////////////////
'// editing functions
'////////////////////////////////////////////////////////////////////////////////

function make_db_value(field,value,controltype,postfilename)
        dim ret
        ret=prepare_for_db(field,value,controltype,postfilename)
        if vartype(ret)=11 then
			if ret=false then 
				make_db_value=ret
				exit function
			end if
		end if
        make_db_value=add_db_quotes(field,ret)
end function

function add_db_quotes(field,value)
		dim ttype, strvalue
        ttype=GetFieldType(field,"")
        if IsBinaryType(ttype) then
                add_db_quotes = db_addslashesbinary(value)
                exit function
        end if
	if IsNull(value) then
		add_db_quotes = "null"
		exit function
	end if

        if (CStr(value)="" or vartype(value)=11 and CStr(value)="False") and not ischartype(ttype) then
			add_db_quotes = "null"
			exit function
		end if
        if NeedQuotes(ttype) then
                if not IsDateFieldType(ttype) then
                        add_db_quotes="'" & db_addslashes(value) & "'"
                Else
                        add_db_quotes=db_datequotes(value)
                end if
        Else
                strvalue = cstr(value)
                strvalue = replace(strvalue,",",".")
                add_db_quotes=my_numeric(strvalue)
		end if

end function

function prepare_for_db(field,value,controltype,postfilename)
	dim ttype, ttime
	filename=""
	ttype=GetFieldType(field,"")
	if controltype="" or controltype="multiselect" then
		if isArray(value) then value=combinevalues(value)
		if isnull(value) then
			prepare_for_db = ""
			exit function
		end if
		if (CStr(value)="" or vartype(value)=11 and CStr(value)="False") and not ischartype(ttype) then
			prepare_for_db = ""
			exit function
		end if
		prepare_for_db = value
		exit function
	elseif mid(controltype,1,4)="file" then 
		if (trim(value)="" or isnull(value)) and mid(controltype,1,5)<>"file1" then
			prepare_for_db=false
		else
			prepare_for_db=""
		end if
		if trim(postfilename)<>  "" then filename=trim(postfilename)
		exit function
	elseif mid(controltype,1,6)="upload" then
		if mid(controltype,7,1)="0" then 
			prepare_for_db = false
			exit function
		end if
		prepare_for_db = value
		exit function
	elseif controltype="time" then
		if isnull(value) then
			prepare_for_db=""
			exit function
		end if
		if value="" then
			prepare_for_db=""
			exit function
		end if
		vtime=localtime2db(value)
		if IsDateFieldType(GetFieldType(field,"")) then _
			vtime="2000-01-01 " & vtime
		prepare_for_db=vtime
		exit function
	elseif mid(controltype,1,4)="date" then
		dformat=cint(mid(controltype,5))
		if dformat=EDIT_DATE_SIMPLE or dformat=EDIT_DATE_SIMPLE_DP then
			ttime=localdatetime2db(value,"")
			if ttime="null" then
				prepare_for_db = ""
				exit function
			end if
			prepare_for_db = ttime
			exit function
		elseif dformat=EDIT_DATE_DD or dformat=EDIT_DATE_DD_DP then
			dim a
			a=split(value,"-")
			if ubound(a)<2 then
				prepare_for_db = null
				exit function
			Else
				y=a(0)
				m=a(1)
				d=a(2)
			end if
			if y<100 then
				if y<70 then
					y=y+2000
				Else
					y=y+1900
				end if
			end if
			prepare_for_db = cstr(y) & "-" & cstr(m) & "-" & cstr(d)
			exit function
		Else
			prepare_for_db = ""
			exit function
		end if
	elseif mid(controltype,1,8)="checkbox" then
		if value="on" then
			ret=1
		else 
			ret=0
		end if
		prepare_for_db = ret
		exit function
	Else
		prepare_for_db = false
		exit function
	end if
end function


'      combine checked values from multi-select list box

function combinevalues(arr())
        dim ret
        ret=""
        for i=0 to ubound(arr)
                if instr(1,arr(i),",")=0 and instr(1,arr(i),"""")=0 then
                        ret = ret & arr(i)
                Else
                        val = replace(arr(i),"""","""""")
                        ret = ret & """ & val & """
                end if
				if i<ubound(arr) then ret=ret & ","
        next
        combinevalues = ret
end function

'      split values for multi-select list box
function splitvalues(str)

        Dim arr2(200)
		arr2(0)=""
		if IsNULL(str) or str="" then 
			splitvalues = arr2
			exit function
		end if
        start=1
        i=1
		x=0
        inquot=false
        while i<=len(str)
                if i<len(str) and mid(str,i,1)="""" then 
					inquot = not inquot
                elseif i=len(str) or not inquot and mid(str,i,1)="," then
						if mid(str,i,1)<>"," then
							val = mid(str,start,i-start+1)
						else
							val=mid(str,start,i-start)
						end if
                        start=i+1
                        if len(val) and left(val,1)="""" then
                                val=mid(val,2,len(val)-2)
                                val=replace(val,"""""","""")
                        end if
                        arr2(x) = val
						x=x+1
                end if
                i=i+1
        wend
        splitvalues = arr2
end function


'////////////////////////////////////////////////////////////////////////////////
'// edit controls creation functions
'////////////////////////////////////////////////////////////////////////////////
'

'      write days dropdown
function WriteDays(d)
        ret="<option value=""""> </option>"
        for i=1 to 31
			s=""
			if cstr(i)=cstr(d) then s="selected"
            ret=ret & "<option value=""" & i & """ " & s & ">" & i & "</option>"
        next
        WriteDays = ret
end function

'      write months dropdown
function WriteMonths(m)
        dim monthnames(13)
        monthnames(1)="January"
        monthnames(2)="February"
        monthnames(3)="March"
        monthnames(4)="April"
        monthnames(5)="May"
        monthnames(6)="June"
        monthnames(7)="July"
        monthnames(8)="August"
        monthnames(9)="September"
        monthnames(10)="October"
        monthnames(11)="November"
        monthnames(12)="December"
        ret="<option value=""""></option>"
        for i=1 to 12
				s=""
				if cstr(i)=cstr(m) then s="selected"
                ret=ret & "<option value=""" & i & """ " & s & ">"  & monthnames(i) & "</option>"
        next
        WriteMonths = ret
end function

'      write years dropdown
function WriteYears(y)
        ret="<option value=""""> </option>"
        firstyear=year(now)-100
        if y<>0 then
			if firstyear>y-5 then firstyear=y-10
		end if
		lastyear=year(now)+10
        if y<>0 then
			if lastyear<y+5 then lastyear=y+10
		end if
        for i=firstyear to lastyear
			s=""
			if cstr(i)=cstr(y) then s="selected"
			ret=ret & "<option value=""" & i & """ " & s & ">" & i & "</option>"
        next
        WriteYears = ret
end function

'      returns HTML code that represents required Date edit control
function GetDateEdit(field, value, ttype, secondfield,search,record_id)
		if secondfield="" then secondfield=false
		
		if search="" then search=MODE_EDIT
		
        cfieldname=GoodFieldName(field)
        cfield="value_" & GoodFieldName(field)
        ctype="type_" & GoodFieldName(field)
        if secondfield then
                cfield="value1_" & GoodFieldName(field)
                ctype="type1_" & GoodFieldName(field)
        end if
        iname=cfield
        tvalue=value
        dim ttime
        ttime=db2time(tvalue)
        if CStr(ttime(0))="" then
                ttime(0)=0
                ttime(1)=0
                ttime(2)=0
                ttime(3)=0
                ttime(4)=0
                ttime(5)=0
        end if
        dp=0
		dim inline
		inline=false
		if search=MODE_INLINE_ADD or search=MODE_INLINE_EDIT then _
			inline=true

		
		
        select case ttype
                Case EDIT_DATE_SIMPLE_DP
                        ovalue=value
                        if locale_info("LOCALE_IDATE")=1 then
                                fmt="dd" & locale_info("LOCALE_SDATE") & "MM" & locale_info("LOCALE_SDATE") & "yyyy"
                                sundayfirst="false"
                        else 
							if locale_info("LOCALE_IDATE")=0 then
									fmt="MM" & locale_info("LOCALE_SDATE") & "dd" & locale_info("LOCALE_SDATE") & "yyyy"
									sundayfirst="true"
							Else
									fmt="yyyy" & locale_info("LOCALE_SDATE") & "MM" & locale_info("LOCALE_SDATE") & "dd"
									sundayfirst="false"
							end if
						end if
                        if DateEditShowTime(field,"") then
                                if ttime(5)<>0 then
                                        fmt=fmt & " HH:mm:ss"
                                else 
									if ttime(3)<>0 or ttime(4)<>0 then
                                        fmt=fmt & " HH:mm"
                                    end if
                                end if
                        end if
                        if ttime(0)>0 then ovalue=format_datetime_custom(ttime,fmt)
                        ovalue1=ttime(2) & "-" & ttime(1) & "-" & ttime(0)
                        showtime="false"
                        if DateEditShowTime(field,"") then
                                showtime="true"
                                ovalue1=ovalue1 & " " & ttime(3) & ":" & ttime(4) & ":" & ttime(5)
                        end if
						if inline then
							onblur="var dt=parse_datetime(this.value," & locale_info("LOCALE_IDATE") & "); if(dt!=null) $('input#ts" & iname & "_" & record_id & "').get(0).value=print_datetime(dt,-1," & showtime & "); else $('input#ts" & iname & "_" & record_id & "').get(0).value='';"
						else
							onblur="var dt=parse_datetime(this.value," & locale_info("LOCALE_IDATE") & "); if(dt!=null) $('input[@name=ts" & iname & "]').get(0).value=print_datetime(dt,-1," & showtime & "); else $('input[@name=ts" & iname & "]').get(0).value='';"
						end if
                        ret="<input type=""Text"" name=""" & iname & """ size = ""20"" value=""" & ovalue & """ onblur=""" & onblur & """>"
                        ret=ret & "<input type=""Hidden"" name=""ts" & iname & """ value=""" & ovalue1 & """>&nbsp;&nbsp;"
						if inline then
	                        ret=ret & "<a href=""#"" onclick=""javascript:var v=show_calendar('update','" & iname & "','" & record_id & "', $('input#ts" & iname & "_" & record_id & "').get(0).value," & showtime & "," & sundayfirst & "); return false;"">"
	                        ret=ret & "<img src=""images/cal.gif"" width=16 height=16 border=0 alt=""" & "Click Here to Pick up the date" & """></a>"
	                        ret=ret & "<script language=JavaScript> function update" & iname & "_" & record_id & "(newDate){"
	                        ret=ret & "$('input#" & iname & "_" & record_id & "').get(0).value =  print_datetime(newDate," & locale_info("LOCALE_IDATE") & "," & showtime & ");"
	                        ret=ret & "$('input#ts" & iname & "_"& record_id & "').get(0).value =  print_datetime(newDate,-1," & showtime & ");"
	                        ret=ret & " }</script>"
						else
	                        ret=ret & "<a href=""#"" onclick=""javascript:var v=show_calendar('update" & iname & "', '','',$('input[@name=ts" & iname & "]').get(0).value," & showtime & "," & sundayfirst & "); return false;"">"
	                        ret=ret & "<img src=""images/cal.gif"" width=16 height=16 border=0 alt=""" & "Click Here to Pick up the date" & """></a>"
	                        ret=ret & "<script language=JavaScript> function update" & iname & "(newDate){"
	                        ret=ret & "$('input[@name=" & iname &"]').get(0).value =  print_datetime(newDate," & locale_info("LOCALE_IDATE") & "," & showtime & ");"
	                        ret=ret & "$('input[@name=ts" & iname & "]').get(0).value =  print_datetime(newDate,-1," & showtime & ");"
	                        ret=ret & " }</script>"				
						end if
                        response.Write ret
                        exit function
                Case EDIT_DATE_DD,EDIT_DATE_DD_DP
						if ttype=EDIT_DATE_DD_DP then 
							dp=1
						else
							dp=0
						end if
                        ovalue=value
                        if ttime(0)>0 then ovalue=format_datetime_custom(ttime,"yyyy-MM-dd")
						if inline then
	                        retday="<select class=selects name=""day" & iname & """ onchange=""SetDate('" & iname & "','" & record_id & "'); return true;"">" & WriteDays(ttime(2)) & "</select>"

	                        retmonth="<select class=selectm name=""month" & iname & """ onchange=""SetDate('" & iname & "','" & record_id & "'); return true;"">" & WriteMonths(ttime(1)) & "</select>"
	                        retyear="<select class=selects name=""year" & iname & """ onchange=""SetDate('" & iname & "','" & record_id & "'); return true;"">" & WriteYears(ttime(0)) & "</select>"						
						else 
	                        retday="<select class=selects name=""day" & iname & """ onchange=""javascript: SetDate" & iname & "(); return true;"">" & WriteDays(ttime(2)) & "</select>"

	                        retmonth="<select class=selectm name=""month" & iname & """ onchange=""javascript: SetDate" & iname & "(); return true;"">" & WriteMonths(ttime(1)) & "</select>"
	                        retyear="<select class=selects name=""year" & iname & """ onchange=""javascript: SetDate" & iname & "(); return true;"">" & WriteYears(ttime(0)) & "</select>"						
						end if
                        sundayfirst="false"
                        if locale_info("LOCALE_ILONGDATE")=1 then 
							ret=retday & "&nbsp;" & retmonth & "&nbsp;" & retyear
                        else 
							if locale_info("LOCALE_ILONGDATE")=0 then
									ret=retmonth & "&nbsp;" & retday & "&nbsp;" & retyear
									sundayfirst="true"
							Else
									ret=retyear & "&nbsp;" & retmonth & "&nbsp;" & retday
							end if
						end if

                        if dp<>0 then
							if inline then
                                ret=ret & "&nbsp;<a href=""#"" onclick=""javascript:var v=show_calendar('update','" & iname & "','" & record_id & "', $('input#ts" & iname & "_" & record_id & "').get(0).value,false," & sundayfirst & "); return false;"">"
                                ret=ret & "<img src=images/cal.gif width=16 height=16 border=0 alt=""" & "Click Here to Pick up the date" & """></a>"
                                ret=ret & "<input type=hidden name=""ts" & iname & """ value=""" & ttime(2) & "-" & ttime(1) & "-" & ttime(0) & """>"
							else 
								ret=ret & "&nbsp;<a href=""#"" onclick=""javascript:var v=show_calendar('update" & iname & "','','', $('input[@name=ts" & iname & "]').get(0).value,false," & sundayfirst & "); return false;"">"
                                ret=ret & "<img src=images/cal.gif width=16 height=16 border=0 alt=""" & "Click Here to Pick up the date" & """></a>"
                                ret=ret & "<input type=hidden name=""ts" & iname & """ value=""" & ttime(2) & "-" & ttime(1) & "-" & ttime(0) & """>"
							end if
                        end if
                        if ttime(0)>0 then
                                ret=ret & "<input type=hidden name=""" & iname & """ value=""" & ttime(0) & "-" & ttime(1) & "-" & ttime(2)  & """>"
                        Else
                                ret=ret & "<input type=hidden name=""" & iname & """ value="""">"
						end if
						
						if inline then
	                        ret=ret & "<script language=JavaScript>"
	                        ret=ret & "function SetDate" & iname & "(){"
	                        ret=ret & "if ( $('select#month" & iname & "_" & record_id & "').get(0).value!='' && $('select#day" & iname & "_" & record_id & "').get(0).value!='' && $('select#year" & iname & "_" & record_id & "').get(0).value!=''){"
	                        ret=ret & "$('input#" & iname & "_" & record_id & "').get(0).value= ''+$('select#year" & iname & "_" & record_id & "').get(0).value + "
	                        ret=ret & "'-' + $('select#month" & iname & "_" & record_id & "').get(0).value + '-' + $('select#day" & iname & "_" & record_id & "').get(0).value; "
	                        if dp<>0 then ret=ret & "$('input#ts" & iname & "_" & record_id & "').get(0).value='' + $('select#day" & iname & "_" & record_id & "').get(0).value+'-'+$('select#month" & iname & "_" & record_id & "').get(0).value+'-'+$('select#year" & iname & "_" & record_id & "').get(0).value; "
							ret=ret & "} else {"
							if dp<>0 then ret=ret & " $('input#ts" & iname & "_" & record_id & "').get(0).value= '" & ttime(2) & "-" & ttime(1) & "-" & ttime(0) & "'; "
	                        ret=ret & "$('input#" & iname & "_" & record_id & "').get(0).value= '';}}"
						else
	                        ret=ret & "<script language=JavaScript>"
	                        ret=ret & "function SetDate" & iname & "(){"
	                        ret=ret & "if ( $('select[@name=month" & iname & "]').get(0).value!='' && $('select[@name=day" & iname & "]').get(0).value!='' && $('select[@name=year" & iname & "]').get(0).value!=''){"
	                        ret=ret & "$('input[@name=" & iname & "]').get(0).value= ''+$('select[@name=year" & iname & "]').get(0).value + "
	                        ret=ret & "'-' + $('select[@name=month" & iname & "]').get(0).value + '-' + $('select[@name=day" & iname & "]').get(0).value; "
	                        if dp<>0 then ret=ret & "$('input[@name=ts" & iname & "]').get(0).value='' + $('select[@name=day" & iname & "]').get(0).value+'-'+$('select[@name=month" & iname & "]').get(0).value+'-'+$('select[@name=year" & iname & "]').get(0).value; "
							ret=ret & "} else {"
							if dp<>0 then ret=ret & " $('input[@name=ts" & iname & "]').get(0).value= '" & ttime(2) & "-" & ttime(1) & "-" & ttime(0) & "'; "
	                        ret=ret & "$('input[@name=" & iname & "]').get(0).value= '';}}"
	                        ret=ret & " SetDate" & iname & "(); "
						end if
						
                        if dp<>0 then
							if inline then
                                ret=ret & " function update" & iname & "_" & record_id & "(newDate){"
                                ret=ret & "var dt_datetime; "
                                ret=ret & "var curdate = new Date(); "
                                ret=ret & "dt_datetime = newDate;"
                                ret=ret & "$('input#" & iname & "_" & record_id & "').get(0).value =  dt_datetime.getFullYear() + '-' + (dt_datetime.getMonth()+1) + '-' + dt_datetime.getDate();"
                                ret=ret & "$('select#day" & iname & "_" & record_id & "').get(0).selectedIndex = dt_datetime.getDate();"
                                ret=ret & "$('select#month" & iname & "_" & record_id & "').get(0).selectedIndex = dt_datetime.getMonth()+1;"
                                ret=ret & "for(i=0; i<$('select#year" & iname & "_" & record_id & "').get(0).options.length;i++)"
                                ret=ret & "if($('select#year" & iname & "_" & record_id & "').get(0).options[i].value==dt_datetime.getFullYear())"
                                ret=ret & "{$('select#year" & iname & "_" & record_id & "').get(0).selectedIndex=i; break;}"
                                ret=ret & "$('input#ts" & iname & "_" & record_id & "').get(0).value = dt_datetime.getDate() + '-' + (dt_datetime.getMonth()+1) + '-' + dt_datetime.getFullYear();}"								
							else
                                ret=ret & " function update" & iname & "(newDate){"
                                ret=ret & "var dt_datetime; "
                                ret=ret & "var curdate = new Date(); "
                                ret=ret & "dt_datetime = newDate;"
                                ret=ret & "$('input[@name=" & iname & "]').get(0).value =  dt_datetime.getFullYear() + '-' + (dt_datetime.getMonth()+1) + '-' + dt_datetime.getDate();"
                                ret=ret & "$('select[@name=day" & iname & "]').get(0).selectedIndex = dt_datetime.getDate();"
                                ret=ret & "$('select[@name=month"& iname & "]').get(0).selectedIndex = dt_datetime.getMonth()+1;"
                                ret=ret & "for(i=0; i<$('select[@name=year" & iname & "]').get(0).options.length;i++)"
                                ret=ret & "if($('select[@name=year" & iname & "]').get(0).options[i].value==dt_datetime.getFullYear())"
                                ret=ret & "{$('select[@name=year" & iname & "]').get(0).selectedIndex=i; break;}"
                                ret=ret & "$('input[@name=ts" & iname & "]').get(0).value = dt_datetime.getDate() + '-' + (dt_datetime.getMonth()+1) + '-' + dt_datetime.getFullYear();}"							
							end if
                        end if
                        ret=ret & " </script>"
                        response.Write ret
                        exit function
                Case EDIT_DATE_SIMPLE 
						ovalue=value
                        if ttime(0)>0 then
                                if ttime(3)<>0 or ttime(4)<>0 or ttime(5)<>0 then
                                        ovalue=format_datetime(ttime)
                                Else
                                        ovalue=format_shortdate(ttime)
                                end if
                        end if
                        response.Write "<input type=text name=""" & iname & """ size = ""20"" value=""" & my_htmlspecialchars(ovalue) & """>"
				case else
                        ovalue=value
                        if ttime(0)>0 then
                                if ttime(3)<>0 or ttime(4)<>0 or ttime(5)<>0 then
                                        ovalue=format_datetime(ttime)
                                Else
                                        ovalue=format_shortdate(ttime)
                                end if
                        end if
                        response.Write "<input type=text name=""" & iname & """ size = ""20"" value=""" & my_htmlspecialchars(ovalue) & """>"
        end select
end function

'      create javascript array with values for dependent dropdowns
sub BuildSecondDropdownArray(arrName, strSQL)

        dim i
		response.Write arrName & "=new Array();" & vbcrlf
        i=0
        Set rs2 = server.CreateObject("ADODB.Recordset")
        rs2.Open strSQL,dbConnection
        while not rs2.EOF
                response.Write arrName & "[" & (i*3) & "]='" & jsreplace(dbvalue(rs2(0))) & "';" & vbcrlf
                response.Write arrName & "[" & (i*3 + 1) & "]='" & jsreplace(dbvalue(rs2(1))) &  "';" & vbcrlf
                response.Write arrName & "[" & (i*3 + 2) & "]='" & jsreplace(dbvalue(rs2(2))) & "';" & vbcrlf
                i=i+1
			rs2.movenext
        wend
        rs2.Close
end sub

'      create Lookup wizard control
function BuildSelectControl(field, value, values, secondfield, mode, id)
    dim i
	if secondfield="" then secondfield=false
    LookupSQL =""
    strSize = 1
	cfieldname=GoodFieldName(field)
	cfield="value_" & GoodFieldName(field)
	clookupfield="display_value_" & GoodFieldName(field)
	ctype="type_" & GoodFieldName(field)
	if secondfield then
		cfield="value1_" & GoodFieldName(field)
		ctype="type1_" & GoodFieldName(field)
	end if
	
	Set arr = CreateObject("Scripting.Dictionary")
	
	d=0
	if values<>"" then 
		arr.add d,values
		d=d+1
	end if
	addnewitem=false
	dim advancedadd
	advancedadd=false

	script=""
	if strTableName="evevents" and field="Category" then
	
		LinkField="Category"
        DisplayField="Category"
        LookupTable="evcategories"
        strSize=1


		LookupSQL = "select "
				LookupSQL=LookupSQL &  "`Category`"
				LookupSQL=LookupSQL & ",`Category`"
				LookupSQL=LookupSQL & " from `evcategories` "
		
				
				LookupSQL=LookupSQL & " ORDER BY `evcategories`.`Category`"
		
				
	end if
	if strTableName="evevents" and field="leads" then
	
		LinkField=""
        DisplayField=""
        LookupTable=""
        strSize=1

		arr.add d,"None"
		d=d+1
		arr.add d,"Success"
		d=d+1
		arr.add d,"Achievers"
		d=d+1
		arr.add d,"Community Partners"
		d=d+1
	end if

'      multi-select
	multiple=""
	postfix=""
	dim res
	dim avalue
	if strSize>1 then
		avalue=splitvalues(value)
		multiple=" multiple"
		postfix="[]"
	Else
		redim avalue(0)
		avalue(0)=value
	end if

	dim cfieldid
	cfieldid=cfield
	if mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD then _
		cfieldid = cfieldid & "_" & id

	if LookupSQL<>"" then
		if FastType(field,"") and useAJAX then
			if UseCategory(field,"") then
'	dependent dropdown
				clookupfieldid=clookupfield
				categoryFieldId = GoodFieldName(CategoryControl(field,""))
				if mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD then
					clookupfieldid = clookupfieldid & "_" & id
					categoryFieldId = categoryFieldId & "_" & id
				end if
				response.write "<input type=""text"" categoryId=""" & categoryFieldId & """ autocomplete=""off"" id=""" & clookupfieldid & """ name=""" & clookupfield & """ onkeydown=""return listenEvent(event,this,'lookup');"" onkeyup=""lookupSuggest('" & GetTableURL("") & "',event,this,'" & my_htmlspecialchars(jsreplace(value)) & "','" & id & "');"" onblur=""isSetFocus=false;showHideLookupError(this);"" onfocus=""isSetFocus=true;"" >"
				onchange=""
		   		if onchange<>"" then _
					onchange="onchange="""& onchange & """"
				response.write "<input type=""hidden"" id=""" & cfieldid & """ name=""" & cfield & """ " & onchange & ">"
		'	add new item
				exit function
			end if
'	get the initial value
			lookup_SQL = ""
			lookup_value = ""
			
			if strTableName="evevents" and field="Category" then 

								lookup_SQL = "SELECT "
								lookup_SQL = lookup_SQL & "`Category`"
								lookup_SQL = lookup_SQL & ",`Category`"
				lookup_SQL = lookup_SQL & " FROM `evcategories` "
								lookup_SQL = lookup_SQL & " WHERE `Category`=" & make_db_value(field,value,"","") 
									lookup_SQL = lookup_SQL & " ORDER BY `Category`"
								end if
			if strTableName="evevents" and field="leads" then 

							end if
			
			Set rs_lookup = server.CreateObject("ADODB.Recordset")
			rs_lookup.open lookup_SQL,dbConnection
			
			if not rs_lookup.EOF then
				lookup_value = rs_lookup(1)
				rs_lookup.Close
			else
				if strTableName="evevents" and field="Category" then 

										lookup_SQL = "SELECT "
										lookup_SQL = lookup_SQL & "`Category`"
										lookup_SQL = lookup_SQL & ",`Category`"
					lookup_SQL = lookup_SQL & " FROM `evcategories` "
					lookup_SQL = lookup_SQL & " WHERE `Category`=" & make_db_value(field,value,"","") & ""
											lookup_SQL = lookup_SQL & " ORDER BY `Category`"
										end if
				if strTableName="evevents" and field="leads" then 

									end if
					
				Set rs_lookup1 = server.CreateObject("ADODB.Recordset")
				rs_lookup1.open lookup_SQL,dbConnection
				
				if not rs_lookup1.EOF then lookup_value = rs_lookup1(1)
				rs_lookup.Close
			end if
			
'	build the control
			clookupfieldid=clookupfield
			if mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD then
				clookupfieldid = clookupfieldid & "_" & id
			end if
			
			response.Write "<input type=text autocomplete=""off"" id=""" & clookupfieldid & """ name=""" & clookupfield & """ value=""" & my_htmlspecialchars(lookup_value) & """ onkeydown=""return listenEvent(event,this,'lookup');"" onkeyup=""lookupSuggest('" & GetTableURL("") & "',event,this,'" & my_htmlspecialchars(jsreplace(value)) & "','"& id &"');"" onblur=""isSetFocus=false;showHideLookupError(this);"" onfocus=""isSetFocus=true;""  >"
			onchange=""
	   		if onchange<>"" then
				onchange="onchange=""" & onchange & """"
			end if
			
			response.write "<input type=""hidden"" id=""" & cfieldid & """ name=""" & cfield & """ value=""" & my_htmlspecialchars(value)& """" & onchange & ">"
			'	add new item
			if addnewitem and mode<>MODE_SEARCH then
				if not advancedadd then
					extra=""
					if mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD then
						extra = "&mode=" & mode & "&id=value_" & GoodFieldName(field) & "_" & id
					end if
					response.write "<a href=# onclick=""window.open('" & GetTableURL(strTableName) & "_addnewitem.asp?field=" & my_htmlspecialchars(jsreplace(SafeURLEncode(field))) & extra & "'," & "'AddNewItem', 'width=250,height=100,status=no,resizable=yes,top=200,left=200');"">" & "Add new" & "</a>"
				else
					if mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD then
						response.write "<a href=# onclick=""return DisplayAdd(event,'" & add_page & "','value_" & GoodFieldName(field) & "_" & id & "','" & GoodFieldName(field) & "','" & GetTableURL("") & "','');"">" & "Add new" & "</a>"
					else
						response.write "<a href=# onclick=""return DisplayAdd(event,'" & add_page & "','value_" & GoodFieldName(field) & "','" & GoodFieldName(field) & "','" & GetTableURL("") & "','');"">" & "Add new" & "</a>"
					end if
				end if
			end if
		else
			LogInfo(LookupSQL)
			Set rse = server.CreateObject("ADODB.Recordset")
			rse.open LookupSQL,dbConnection
			
			onchange=""
			if onchange<>"" then onchange="onchange=""" & onchange & """"
			if multiple<>"" then _
				response.write "<input type=hidden name=""" & ctype & """ value=""multiselect"">"
			response.Write "<select size = """ & strSize & """ id=""" & cfield & """ name=""" & cfield & postfix & """" & multiple & " " & onchange & ">"
			count = rse.recordcount
			if strSize<2 then
				response.Write "<option value="""">" & "Please select" & "</option>"
			elseif mode=MODE_SEARCH then 
				response.Write "<option value=""""> </option>"
			end if
	
			dim found
			found=false

			while not rse.eof
				res=false
				for i=0 to ubound(avalue)
					if not isnull(rse(0)) then
						if CStr(rse(0))=avalue(i) then res=true
					end if
				next                        
				if res then
					found=true
					response.Write "<option value=""" & my_htmlspecialchars(rse(0)) & """ selected>" & my_htmlspecialchars(rse(1)) & "</option>"
				Else
					response.Write "<option value=""" & my_htmlspecialchars(rse(0)) & """>" & my_htmlspecialchars(rse(1)) & "</option>"
				end if
				rse.movenext  
			wend
			rse.Close
			response.Write "</select>"
'      add new item
			if addnewitem and mode<>MODE_SEARCH and mode<>MODE_INLINE_EDIT and mode<>MODE_INLINE_ADD then
				if not advancedadd then
					response.Write "<a href=# onclick=""window.open('" & GetTableURL(strTableName)& "_addnewitem.asp?field=" & jsreplace(my_htmlspecialchars(SafeURLEncode(field))) & "','AddNewItem', 'width=250,height=100,status=no,resizable=yes,top=200,left=200');"">" & "Add new" & "</a>"
				else
					response.Write "<a href=# onclick=""return DisplayAdd(event,'" & add_page & "','value_" & GoodFieldName(field) & "','" & GoodFieldName(field) & "','" & GetTableURL("") & "','');"">" & "Add new" & "</a>"
				end if
			end if
			if addnewitem and mode<>MODE_SEARCH and (mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD) then
				if not advancedadd then
					response.Write "<a href=# onclick=""window.open('" & GetTableURL(strTableName)& "_addnewitem.asp?field=" &_
					jsreplace(my_htmlspecialchars(SafeURLEncode(field))) & "&mode=" & mode & "&id=value_" & GoodFieldName(field) & "_" &_
					id & "','AddNewItem', 'width=250,height=100,status=no,resizable=yes,top=200,left=200');"">" & "Add new" & "</a>"
				else
					response.Write "<a href=# onclick=""return DisplayAdd(event,'" & add_page & "','value_" & GoodFieldName(field) & "_" & id & "','" & GoodFieldName(field) & "','" & GetTableURL("") & "','');"">" & "Add new" & "</a>"
				end if
			end if			
		end if
	Else
		if multiple<>"" then _
			response.write "<input type=hidden name=""" & ctype & """ value=""multiselect"">"
		response.Write "<select size = """ & strSize & """ name=""" & cfield & postfix & """ " & multiple & ">"
		if strSize<2 then
			response.Write "<option value="""">" & "Please select" & "</option>"
		elseif mode=MODE_SEARCH then
			response.Write "<option value=""""> </option>"
		end if
		for opt=0 to arr.Count-1
			res=false
			for i=0 to ubound(avalue)
				if arr(opt)=avalue(i) then res=true
			next
			if res then
				response.Write "<option value=""" & my_htmlspecialchars(arr(opt)) & """ selected>" & my_htmlspecialchars(arr(opt)) & "</option>"
			Else
				response.Write "<option value=""" & my_htmlspecialchars(arr(opt)) & """>" & my_htmlspecialchars(arr(opt)) & "</option>"
			end if
		next
		response.Write "</select>"
	end if
end function

function BuildRadioControl(field, value,secondfield)
        if secondfield="" then secondfield=false
        dim cfieldname,cfield,ctype
        cfieldname=GoodFieldName(field)
        cfield="value_" & GoodFieldName(field)
        ctype="type_" & GoodFieldName(field)
        if secondfield then
                cfield="value1_" & GoodFieldName(field)
                ctype="type1_" & GoodFieldName(field)
        end if
        LookupSQL =""
        if len(LookupSQL)>1 then
				LogInfo(LookupSQL)
                Set rst = server.CreateObject("ADODB.Recordset")
                rst.open LookupSQL,dbConnection
                if rst.eof then 
                        BuildRadioControl = ""
                        exit function
                end if
                response.Write "<input type=hidden name=""" & cfield & """ value=""" & my_htmlspecialchars(value) & """>"
				while not rst.eof
                        if not isnull(rst(0)) and CStr(rst(0))=value then
                                response.Write "<input type=""Radio"" name=""radio_" & cfieldname & """ onclick=""javascript: " & cfield & ".value='" & db_addslashes(rst(0)) & "'; return true;"" checked>" & my_htmlspecialchars(rst(1)) & "<br>"
                        Else
                                response.Write "<input type=""Radio"" name=""radio_" & cfieldname & """ onclick=""javascript: " & cfield & ".value='" & db_addslashes(rst(0)) & "'; return true;"">"  & my_htmlspecialchars(rst(1)) & "<br>"
                        end if
                        rst.movenext
                wend
                rst.close
        Else
                response.Write "<input type=hidden name=""" & cfield & """ value=""" & my_htmlspecialchars(value) & """>"
                for each opt in arr
                        if arr.Item(opt)=value then
                                response.Write "<input type=""Radio"" name=""radio_" & cfieldname & """ onclick=""javascript: " & cfield & ".value='" & db_addslashes(arr.Item(opt)) & "'; return true;"" checked>" & my_htmlspecialchars(arr.Item(opt)) & "<br>"
                        Else
                                response.Write "<input type=""Radio"" name=""radio_" & cfieldname & """ onclick=""javascript: " & cfield & ".value='" & db_addslashes(arr.Item(opt)) & "'; return true;"">" & my_htmlspecialchars(arr.Item(opt)) & "<br>"
                        end if
				next
        end if
        BuildRadioControl = ""
end function

function BuildEditControl(field, value, fformat, edit, secondfield, id)
	if secondfield="" then secondfield=false
	cfieldname=GoodFieldName(field)
	cfield="value_" & GoodFieldName(field)
	ctype="type_" & GoodFieldName(field)
	if secondfield then
		cfield="value1_" & GoodFieldName(field)
		ctype="type1_" & GoodFieldName(field)
	end if
	ttype=GetFieldType(field,"")
	arr=""

	iquery="field=" & SafeURLEncode(field)
	keylink=""
if edit = MODE_EDIT or edit = MODE_INLINE_EDIT then
	if strTableName="evevents" then
		keylink=keylink & "&key1=" & SafeURLEncode(keys("EventID"))
		iquery=iquery & keylink
	end if
	if strTableName="evcategories" then
		keylink=keylink & "&key1=" & SafeURLEncode(keys("Category"))
		iquery=iquery & keylink
	end if
	if strTableName="evtellfriend" then
		iquery=iquery & keylink
	end if
end if
	
	if fformat=EDIT_FORMAT_FILE and edit=MODE_SEARCH then fformat=""
	if fformat=EDIT_FORMAT_TEXT_FIELD then
		if IsDateFieldType(ttype) then
			response.Write "<input type=""hidden"" name=""" & ctype & """ value=""date" & EDIT_DATE_SIMPLE & """>" & GetDateEdit(field,value,0,secondfield,edit,id)
		else
			if edit = MODE_SEARCH then
				response.write "<input type=""text"" autocomplete=""off"" name=""" & cfield & """ " & GetEditParams(field,"") & " value=""" & my_htmlspecialchars(value) & """>"
			else
			response.write "<input type=""text"" name=""" & cfield & """ " & GetEditParams(field,"") & " value=""" & my_htmlspecialchars(value) & """>"
			end if		
		end if
	elseif fformat=EDIT_FORMAT_TIME then 
		response.write "<input type=""hidden"" name=""" & ctype & """ value=""time"">"
		if IsDateFieldType(ttype) then
			dbtime=db2time(value)
			if ubound(dbtime)>0 then
				val=fformat_time(dbtime)
			else
				val=""
			end if
		else 
			arr=parsenumbers(value)
			if ubound(arr)>0 then
				dim dbtime(6)
				dbtime(0)=0
				dbtime(1)=0
				dbtime(2)=0
				dbtime(3)=0
				dbtime(4)=0
				dbtime(5)=0
				dim i
				for i=0 to 2
					if ubound(arr)>i then dbtime(i+3)=arr(i)
				next
				val=fformat_time(dbtime)
			else
				val=""
			end if
		end if
		response.write "<input type=""text"" name=""" & cfield & """ " & GetEditParams(field,"") & " value=""" & my_htmlspecialchars(val) & """>"
	elseif fformat=EDIT_FORMAT_TEXT_AREA then
			nWidth = GetNCols(field, strTableName)
			nHeight = GetNRows(field, strTableName)

		if UseRTE(field, strTableName) then
			value = RTESafe(value)
			
						if edit=MODE_INLINE_EDIT or edit=MODE_INLINE_ADD then
				cfield = cfield & "_" & id
				cfieldname = cfieldname & "_" & id
				browser=""
				if postvalue("browser")="ie" then browser = "&browser=ie"
				response.Write "<iframe scrolling=no name=""" & cfield & """ style='width: " & (nWidth+1) & "px;height: " & (nHeight+1) & "px;'"
				if edit=MODE_INLINE_EDIT then
					response.Write " src=""" & GetTableURL(strTableName) & "_rte.asp?mode=edit&id=" & id & "&" & iquery & browser & """>"
				else
					response.Write " src=""" & GetTableURL(strTableName) & "_rte.asp?mode=add&id=" & id & "&" & iquery & browser & """>"
				end if
				response.Write "</iframe>"
			else
				response.Write "<script language=""JavaScript"" type=""text/javascript"">"
				response.Write "writeRichText(""" & cfield & """, '" & value & "', " & nWidth & " , " & nHeight & ", true, false);"
				response.Write "</script>"				
			end if
								else
			response.Write "<textarea name=""" & cfield & """ style=""width: " & nWidth & "px;height: " & nHeight & "px;"">"  & my_htmlspecialchars(value)
			response.write "</textarea>"
		end if
	elseif fformat=EDIT_FORMAT_PASSWORD then
		response.Write "<input type=""Password"" name=""" & cfield & """ " & GetEditParams(field,"") & " value=""" & my_htmlspecialchars(value) & """>"
	elseif fformat=EDIT_FORMAT_DATE then
		response.Write "<input type=""hidden"" name=""" & ctype & """ value=""date"  & DateEditType(field,"") & """>" & GetDateEdit(field,value,DateEditType(field,""),secondfield,edit,id)
	elseif fformat=EDIT_FORMAT_RADIO then
		a=BuildRadioControl(field,value,secondfield)
	elseif fformat=EDIT_FORMAT_CHECKBOX then
		if edit=MODE_ADD or edit=MODE_INLINE_ADD or edit=MODE_EDIT or edit=MODE_INLINE_EDIT then
			ch=""
			if isNumeric(value) then
				if value<>0 then ch="checked"
			else
				if value<>"" and value<>"False" then ch="checked"
			end if
			response.Write "<input type=""hidden"" name=""" & ctype & """ value=""checkbox""><input type=""Checkbox"" name=""" & cfield & """ " & ch & ">"
		else
			response.Write "<input type=""hidden"" name=""" & ctype & """ value=""checkbox"">"
			response.Write "<select name=""" & cfield & """>"
			dim val(3)
			val(0)=none
			val(1)="on"
			val(2)="off"
			dim show(3)
			show(0)=""
			show(1)="True"
			show(2)="False"
			for i=0 to 2
				sel=""
				if cstr(value)=val(i) then sel=" selected"
				response.Write "<option value=""" & val(i) & """" & sel & ">" & show(i) & "</option>"
			next
			response.Write "</select>"
		end if
	elseif fformat=EDIT_FORMAT_DATABASE_IMAGE or fformat=EDIT_FORMAT_DATABASE_FILE then
		disp=""
		strfilename=""
		onchangefile=""
		if edit=MODE_EDIT or edit=MODE_INLINE_EDIT then
			if id<>"" then _
				ctype = ctype & "_" & id
			if lenb(rs(field))>0 then
				dim pict
				pict=rs(field).GetChunk(20000000)
				if lenb(rs(field))>100 then
					value=db_stripslashesbinary(midb(pict,1,100))
				else
					value=db_stripslashesbinary(pict)
				end if
			else
				value=""
			end if
			itype=SupposeImageType(value)
			thumbnailed=false
			thumbfield=""
			
			if itype<>"" then
				if thumbnailed then
					disp = "<a target=_blank href=""" & GetTableURL(strTableName) & "_imager.asp?" & iquery & """>"
					disp = disp & "<img border=0"
					disp = disp & " src=""" & GetTableURL(strTableName) & "_imager.asp?field="&SafeURLEncode(thumbfield)&"&alt="& SafeURLEncode(field) & keylink &""">"
					disp = disp & "</a>"
				else
					disp="<img border=0 src=""" & GetTableURL(strTableName) & "_imager.asp?" & iquery & """>"
				end if
			else
				if len(value)>0 then
					disp="<img border=0 src=""images/file.gif"">"
				Else
					disp="<img border=0 src=""images/no_image.gif"">"
				end if
			end if
'      filename
			if fformat=EDIT_FORMAT_DATABASE_FILE and itype="" and len(value)>0 then
				filename=rs(GetFilenameField(field,""))
				if filename="" then filename="file.bin"
				disp="<a href=""" & GetTableURL(strTableName) & "_getfile.asp?filename=" & my_htmlspecialchars(filename) & "&" & iquery & """>" & disp & "</a>"
			end if
'      filename edit
			if fformat=EDIT_FORMAT_DATABASE_FILE and GetFilenameField(field,"")<>"" then
				filename=rs(GetFilenameField(field,""))
				if filename="" then filename=""
				if edit=MODE_INLINE_EDIT then
					strfilename="<br>" & "Filename" & "&nbsp;&nbsp;<input id=""filename_" & cfieldname & "_" & id & """ name=""filename_" & cfieldname & """ size=""20"" maxlength=""50"" value=""" & my_htmlspecialchars(filename) & """>"
					onchangefile=onchangefile & "var path=$('#" & cfield & "_" & id & "').val(); var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos; $('#filename_" & cfieldname & "_" & id & "').val(path.substr(pos+1));"			
				else
					strfilename="<br>" & "Filename" & "&nbsp;&nbsp;<input name=""filename_" & cfieldname & """ size=""20"" maxlength=""50"" value=""" & my_htmlspecialchars(filename) & """>"
					onchangefile=onchangefile & "var path=this.form.elements['" & jsreplace(cfield) & "'].value; var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos; this.form.elements['filename_" & jsreplace(cfieldname) & "'].value=path.substr(pos+1);"			
				end if
			end if
			strtype="<br><input type=""Radio"" name=""" & ctype & """ value=""file0"" checked>" & "Keep"
			if len(value)>0 and not IsRequired(field,"") then
				strtype=strtype & "<input type=""Radio"" name=""" & ctype & """ value=""file1"">" & "Delete"
				if edit=MODE_INLINE_EDIT then
					onchangefile=onchangefile & "$('input[@type=radio][@value=file2][@name=" & ctype & "]').get(0).checked=true;"
				else
					onchangefile=onchangefile & "this.form.elements['" & jsreplace(ctype) & "'][2].checked=true;"
				end if
			else
				if edit=MODE_INLINE_EDIT then
					onchangefile=onchangefile & "$('input[@type=radio][@value=file2][@name=" & ctype & "]').get(0).checked=true;"
				else
					onchangefile=onchangefile & "this.form.elements['" & jsreplace(ctype) & "'][1].checked=true;"
				end if
			end if
			strtype=strtype & "<input type=""Radio"" name=""" & ctype & """ value=""file2"">" & "Update"
		else
			strtype="<input type=""hidden"" name=""" & ctype & """ value=""file2"">"
			if fformat=EDIT_FORMAT_DATABASE_FILE and GetFilenameField(field,"")<>"" then
				strfilename="<br>" & "Filename" & "&nbsp;&nbsp;<input name=""filename_" & cfieldname & """ size=""20"" maxlength=""50"">"
				if mode=MODE_INLINE_EDIT then
					onchangefile=onchangefile & "var path=$('#" & cfield & "_" & id & "').val(); var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos; $('#filename_" & cfieldname & "_" & id & "').val(path.substr(pos+1));"
				else
					onchangefile=onchangefile & "var path=this.form.elements['" & jsreplace(cfield) & "'].value; var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos; this.form.elements['filename_" & jsreplace(cfieldname) & "'].value=path.substr(pos+1);"
				end if
			end if
		end if
		if onchangefile<>"" then onchangefile="onChange=""" & onchangefile & """"
		if edit=MODE_INLINE_EDIT and fformat=EDIT_FORMAT_DATABASE_FILE then disp=""
		response.Write disp & strtype & "<br><input type=""File"" id=""" & cfield & "_" & id & """ name=""" & cfield & """ " & onchangefile & ">" & strfilename
	elseif fformat=EDIT_FORMAT_LOOKUP_WIZARD then
		BuildSelectControl field, value, "", secondfield, edit, id
	elseif fformat=EDIT_FORMAT_HIDDEN then
		response.Write "<input type=""Hidden"" name=""" & cfield & """ value=""" & my_htmlspecialchars(value) & """>"
	elseif fformat=EDIT_FORMAT_READONLY then
		response.Write "<input type=""Hidden"" name=""" & cfield & """ value=""" & my_htmlspecialchars(value) & """>"
	elseif fformat=EDIT_FORMAT_FILE then
		disp=""
		strfilename=""
		onchangefile=""
		ffunction=""
		if edit=MODE_EDIT or edit=MODE_INLINE_EDIT then
'      show current file
			if id<>"" then _
				ctype = ctype & "_" & id
			if Format(field,"")=FORMAT_FILE or Format(field,"")=FORMAT_FILE_IMAGE then disp=GetData(rs,field,Format(field,"")) & "<br>"
			filename=value
			if edit = MODE_INLINE_EDIT then
				ffunction=""
			else
				ffunction="<script language=""Javascript"">"
				ffunction=ffunction & "function controlfilename" & cfieldname & "(enable){" & vbcrlf
				ffunction=ffunction & "if(enable){" & vbcrlf
				ffunction=ffunction & "document.forms.editform." & cfield & ".style.backgroundColor=""white"";" & vbcrlf
				ffunction=ffunction & "document.forms.editform." & cfield & ".disabled=false;}" & vbcrlf
				ffunction=ffunction & "else{" & vbcrlf
				ffunction=ffunction & "document.forms.editform." & cfield & ".style.backgroundColor=""gainsboro"";" & vbcrlf
				ffunction=ffunction & "document.forms.editform." & cfield & ".disabled=true;}}</script>" & vbcrlf
			end if
			
'      filename edit
			filename_size=30
			if UseTimestamp(field,"") then filename_size=50
			strfilename="<input type=hidden name=""filename_" & cfieldname & """ value=""" & my_htmlspecialchars(filename) & """><br>" & "Filename" & "&nbsp;&nbsp;<input style=""background-color:gainsboro"" disabled id=""" & cfield & "_" & id & """ name=""" & cfield & """ size=""" & filename_size & """ maxlength=""100"" value=""" & my_htmlspecialchars(filename) & """>"
			if edit=MODE_INLINE_EDIT then
				onchangefile=onchangefile & "var path=$('[@id=file_" & cfieldname & "_" & id & "]').val(); var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos; $('#" & cfield & "_" & id & "').css('backgroundColor','white');$('#" & cfield & "_" & id & "')[0].disabled=false;"
				if UseTimestamp(field,"") then
					onchangefile=onchangefile & "$('[@id=" & cfield & "_" & id & "]').val(addTimestamp(path.substr(pos+1))); "
				else
					onchangefile=onchangefile & "$('[@id=" & cfield & "_" & id & "]').val(path.substr(pos+1)); "
				end if
				strtype="<br /><input type=""Radio"" name=""" & ctype & """ value=""upload0"" checked onclick=""$('[@id=" & cfield & "_" & id & "]').css('backgroundColor','gainsboro'); $('[@id=" & cfield & "_" & id & "]')[0].disabled=true;"">" & "Keep"			
			else
				onchangefile=onchangefile & "var path=this.form.file_" & cfieldname & ".value; var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos; controlfilename" & cfieldname & "(true);"
				if UseTimestamp(field,"") then
					onchangefile=onchangefile & "this.form." & cfield & ".value=addTimestamp(path.substr(pos+1)); "
				else
					onchangefile=onchangefile & "this.form." & cfield & ".value=path.substr(pos+1); "
				end if
				strtype="<br><input type=""Radio"" name=""" & ctype & """ value=""upload0"" checked onclick=""controlfilename" & cfieldname & "(false)"">" & "Keep"			
			end if
			if len(value)>0  and not IsRequired(field,"") then
				if edit=MODE_INLINE_EDIT then
					strtype=strtype & "<input type=""Radio"" name=""" & ctype & """ value=""upload1"" onclick=""$('[@id=" &cfield & "_" & id & "]').css('backgroundColor','gainsboro'); $('[@id=" & cfield & "_" & id & "]')[0].disabled=true;"">" & "Delete"
					onchangefile=onchangefile & "$('input[@type=radio][@value=upload2][@name=" & ctype &"]').get(0).checked=true;"
				else
					strtype=strtype & "<input type=""Radio"" name=""" & ctype & """ value=""upload1"" onclick=""controlfilename" & cfieldname & "(false)"">" & "Delete"
					onchangefile=onchangefile & "this.form." & ctype & "[2].checked=true;"
				end if
			else
				if edit=MODE_INLINE_EDIT then
					onchangefile=onchangefile & "$('input[@type=radio][@value=upload2][@name=" & ctype & "]').get(0).checked=true;"
				else
					onchangefile=onchangefile & "this.form." & ctype & "[1].checked=true;"
				end if
			end if
			if edit=MODE_INLINE_EDIT then
				strtype=strtype & "<input type=""Radio"" name=""" & ctype & """ value=""upload2"" onclick=""$('[@id=" & cfield& "_" & id & "]').css('backgroundColor','white'); $('[@id=" & cfield & "_" & id & "]')[0].disabled=false;"">" & "Update"
			else 
				strtype=strtype & "<input type=""Radio"" name=""" & ctype & """ value=""upload2"" onclick=""controlfilename" & cfieldname & "(true)"">" & "Update"			
			end if
		else
'	if Adding record	
			filename_size=30
			if UseTimestamp(field,"") then filename_size=50
			strtype="<input type=""hidden"" name=""" & ctype & """ value=""upload2"">"
			strfilename="<br>" & "Filename" & "&nbsp;&nbsp;<input name=""" & cfield & """ size=""" & filename_size & """ maxlength=""100"">"
			if edit=MODE_INLINE_ADD then
				onchangefile=onchangefile & "var path=$('[@id=file_" & cfieldname & "_" & id & "]').val(); var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos;"
				if UseTimestamp(field,"") then
					onchangefile=onchangefile & " $('[@id=" & cfield & "_" & id & "]').val(addTimestamp(path.substr(pos+1)));"
				else
					onchangefile=onchangefile & " $('[@id=" & cfield & "_" & id & "]').val(path.substr(pos+1));"
				end if			
			else
				onchangefile=onchangefile & "var path=this.form.file_" & cfieldname  & ".value; var wpos=path.lastIndexOf('\\'); var upos=path.lastIndexOf('/'); var pos=wpos; if(upos>wpos) pos=upos;"
				if UseTimestamp(field,"") then
					onchangefile=onchangefile & " this.form." & cfield & ".value=addTimestamp(path.substr(pos+1));"
				else
					onchangefile=onchangefile & " this.form." & cfield & ".value=path.substr(pos+1);"
				end if			
			end if
		end if
		if onchangefile<>"" then onchangefile="onChange=""" & onchangefile & """"
		response.Write ffunction & disp & strtype & maxsize & "<br><input type=""File"" name=""file_" & cfieldname & """ " & onchangefile & ">" & strfilename
	end if
end function

Function pg_escape_string(name)
        name = Replace(name, "\", "\\")
        name = Replace(name, "'", "\'")
        return name
End Function

Function my_numeric(strName)
        If IsNumeric(strName) Then
                my_numeric = strName
        Else
                my_numeric = 0
        End If
End Function
Sub DoEvent(strEvent)

On Error Resume Next
Execute strEvent

If Err.Number <> 13 Then
        strMoreInfo = "Event: " & strEvent
        ReportError
End If
On Error GoTo 0

End Sub

Function ParseMultiPartForm
	if Request.TotalBytes = 0 then
		ParseMultiPartForm = false
		Exit Function
	end if
	ParseMultiPartForm = true
	Dim postData
	postData = Request.BinaryRead(Request.TotalBytes)
	contentType = Request.ServerVariables( "HTTP_CONTENT_TYPE")
	ctArray = split( contentType, ";")
	if trim(ctArray(0)) = "multipart/form-data" then
		errMsg = ""
		' grab the form boundry...
		bArray = split( trim( ctArray(1)), "=")
		boundry = Unicode2Bytes("--" & trim( bArray(1)))
		currentPos = 1
		inStrByte = 1
		While inStrByte > 0
			inStrByte = InStrB(currentPos, postData, boundry)
			m = inStrByte - currentPos
			If m > 1 Then
    			val = MidB(postData, currentPos, m)
    			
        		infoEnd = instrB( val, chrb(13) & chrb(10) & chrb(13) & chrb(10) )
        		if infoEnd > 0 then
        			varInfo = Bytes2String(midb( val , 1, infoEnd - 1))
        			varValue = midb( val , infoEnd + 4, lenb(val) - infoEnd - 5)

					if InStr(1, varInfo, "Content-Type") < 1 then 
						varValue=Bytes2String(varValue)
					else
						if lenb(varValue) mod 2 then varValue = varValue & chrb(0)
					end if

				strField = getFieldName(varInfo)
				if myRequest.exists(strField) then
					myRequest(strField) = myRequest(strField) & "," & varValue
        			else
					myRequest.add strField, varValue
				end if
				
        		end if
			end if
			currentPos = lenb(boundry) + inStrByte
		wend
	else
		errMsg = "Wrong encoding type!"
	end if 

End Function


' This function retreives a field's name
function getFieldName( infoStr)
	sPos = inStr( infoStr, "name=")
	endPos = inStr( sPos + 6, infoStr, chr(34) & ";")
	if endPos = 0 then
		endPos = inStr( sPos + 6, infoStr, chr(34))
	end if
	getFieldName = mid( infoStr, sPos + 6, endPos - (sPos + 6))
end function

' This function retreives a file field's filename
function getFileName( infoStr)
	sPos = inStr( infoStr, "filename=")
	endPos = inStr( infoStr, chr(34) & crlf)
	getFileName = mid( infoStr, sPos + 10, endPos - (sPos + 10))
end function

' This function retreives a file field's mime type
function getFileType( infoStr)
	sPos = inStr( infoStr, "Content-Type: ")
	getFileType = mid( infoStr, sPos + 14)
end function

Function GetRequestForm(key)

if isEmpty(myRequest) then
	GetRequestForm=""
	Exit Function
end if

if myRequest.Exists(key) then
	GetRequestForm = myRequest(key)
else
	GetRequestForm = Request.QueryString(key)
end if

End Function

Function Unicode2Bytes(str)
	
For ind = 1 To len(str) 
     Unicode2Bytes = Unicode2Bytes& ChrB(Asc(Mid(str, ind, 1)))
Next 

End Function

function addslashes(str)
	str = replace(str,"'","\'")
	str = replace(str,"""","\""")
	addslashes = replace(str,"/","\/")
end function

Sub sendmail(email, subject, message)

Dim i
if email="" or isnull(email) then
	strMessage = "Email address is empty. Cannot send email."
	Exit Sub
end if

'On Error Resume Next

	Version = Request.ServerVariables("SERVER_SOFTWARE")
	If InStr(Version, "Microsoft-IIS") > 0 Then
		i = InStr(Version, "/")
		If i > 0 Then
			IISVer = Trim(Mid(Version, i+1))
		End If
	End If

	If IISVer <= "5.0" or IISVer = "7.0" Then
		' Windows NT / 2000 
		Set myMail = Server.CreateObject("CDONTS.NewMail")
		myMail.From = cfrom
		myMail.To = email

		myMail.Subject = subject 
		myMail.Body = message 
		myMail.Send
		Set myMail = Nothing
Else
		' Windows XP / 2003 
        Set myMail=CreateObject("CDO.Message")
        myMail.Subject = subject 
        myMail.From=cfrom
        myMail.To=email
        myMail.TextBody= message 
        myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
        'Name or IP of remote SMTP server
        myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")=csmtpserver
        'Server port
        myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=csmtpport 
        ' SMTP username and passwords
        myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = csmtppassword
        myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = csmtpuser
	if csmtpuser<>"" then _
		myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        myMail.Configuration.Fields.Update
        myMail.Send
        Set myMail = Nothing 
End If


	if Err.Number<>0 then
		strMessage = "Error happened sending email to " & email & "<br>" & Err.Source & "<br>" & Err.Number & "<br>" & Err.Description

		Err.Clear
	end if


End Sub

Function IsFloat(nType)

	IsFloat = false
	if nType=14 or nType=5 or nType=131 then IsFloat=true end if

End Function

Function Bytes2String(bytes)

	Dim i, byteord, nextbyteord

	For i = 1 to LenB(bytes)
		byteord = AscB(MidB(bytes, i, 1))
		If session.codepage<>65001 or byteord < &H80 Then ' Ascii
			Bytes2String= Bytes2String& Chr(byteord)
		Else ' Double-byte characters?
			if byteord >= &HC2 and byteord <= &HDF and i < LenB(bytes) then
				byteord2 = AscB(MidB(bytes, i+1, 1))
				On Error Resume Next
				charindex = (byteord-192)*64 + (byteord2-128)
				Bytes2String= Bytes2String& ChrW(charindex)
				If Err.Number <> 0 Then
					On Error GoTo 0
					Bytes2String= Bytes2String& Chr(byteord) & Chr(byteord2)
				End If
				i = i + 1
			elseif byteord >= 112 and byteord < 240 and i+1 < LenB(bytes) then
				byteord2 = AscB(MidB(bytes, i+1, 1))
				byteord3 = AscB(MidB(bytes, i+2, 1))
				On Error Resume Next
				charindex = (byteord-224)*4096 + (byteord2-128)*64 + (byteord3-128)
				Bytes2String= Bytes2String& ChrW(charindex)
				If Err.Number <> 0 Then
					On Error GoTo 0
					Bytes2String= Bytes2String& Chr(byteord) & Chr(byteord2) & Chr(byteord3)
				End If
				i = i + 2
			elseif i+2 < LenB(bytes) then
				byteord2 = AscB(MidB(bytes, i+1, 1))
				byteord3 = AscB(MidB(bytes, i+2, 1))
				byteord4 = AscB(MidB(bytes, i+3, 1))
				On Error Resume Next
				charindex = (byteord-240)*262144 + (byteord2-128)*4096 + (byteord3-128)*64 + (byteord4-128)
				Bytes2String= Bytes2String& ChrW(charindex)
				If Err.Number <> 0 Then
					On Error GoTo 0
					Bytes2String= Bytes2String& Chr(byteord) & Chr(byteord2) & Chr(byteord3) & Chr(byteord4)
				End If
				i = i + 3
			 Else 
			   Bytes2String= Bytes2String& Chr(byteord)
			 end if
		End If
	Next
End Function
Function CSmartDbl(strValue)

On Error Resume Next
CSmartDbl = CDbl(strValue)
if Err.Number<>0 then
    
	Err.Clear
	if InStr(strValue, ".")>0 then 
	   CSmartDbl = CDbl(Replace(strValue, ".", ","))
	elseif InStr(strValue, ",")>0 then 
	   CSmartDbl = CDbl(Replace(strValue, ",", "."))
	end if
	Err.Clear
end if

On Error Goto 0

End Function
sub DeleteFile(strFileName)

Set fso = CreateObject("Scripting.FileSystemObject")
if fso.FileExists(strFileName) then
	fso.DeleteFile(strFileName)
end if
set fso = Nothing

end sub

sub WriteToFile(strFileName, binData)
	Dim rsT
	Set rsT = Server.CreateObject("ADODB.Recordset")
	rsT.Fields.Append "File", 205, LenB(binData)
	rsT.Open
	rsT.AddNew
	rsT.Fields("File").AppendChunk binData
	rsT.Fields("File").AppendChunk "0"
	rsT.Update
	
	Dim stream
	Set stream = Server.CreateObject("ADODB.Stream")
	stream.Type = 1
	stream.Open
	stream.Write rsT.Fields("File").GetChunk(LenB(binData))
	stream.SaveToFile strFileName, 2

	stream.Close
	Set stream = Nothing
	rsT.Close
	Set rsT = Nothing
end sub

Function SafeURLEncode(str)

if IsNULL(str) then str = ""

SafeURLEncode = replace(server.urlencode(CStr(str)),"+","%20")

End Function

function dbvalue(value)
	if isnull(value) then
		dbvalue=""
		exit function
	end if
	if vartype(value)=7 then
		dbvalue=year(value) & "-" & month(value) & "-" & day(value) & " " & hour(value) & ":" & minute(value) & ":" & second(value)
		exit function
	end if
	dbvalue=value
	exit function
end function

Function SafeIsEmpty(str)

if IsArray(str) then
	SafeIsEmpty = false
	Exit Function
end if

SafeIsEmpty = (str="")

End Function


sub ReportError
if Err.number<>0 then
	response.flush
	Set objXML = Server.CreateObject("Microsoft.XMLDOM")
	Set objLst = Server.CreateObject("Microsoft.XMLDOM")
	Set objSlt = Server.CreateObject("Microsoft.XMLDOM")

	objXML.async = False
	objXML.Load (Server.MapPath("oldinclude/errors.xml"))
	If objXML.parseError.errorCode <> 0 Then
		Response.Write "error occurs <br>error message: " & objXML.parseError.reason & "<br> in the line " & objXML.parseError.line & "<br>line of XML that contains the error" & objXML.parseError.srcText
	End If

	Set objLst = objXML.getElementsByTagName("Keywords")
	Set objSlt = objXML.getElementsByTagName("Solution")
 	dim flag, noOfHeadlines, i, j, Description
	noOfHeadlines = objLst.length
	Dim ar 
	Dim kwords
	Description = lcase(err.Description)
	flag = 1
	i=0
	while flag and i<noOfHeadlines
		ar = objLst.item(i).text
		kwords = Split(ar, " ")
		nullfound = FALSE
		For j=0 to UBound(kwords)
			if InStr(Description, lcase(kwords(j)))=0 then
				nullfound = TRUE
				j=UBound(kwords)
			end if
		Next
		if not nullfound then
			Solution = objSlt.item(i).text
			flag = 0 
		end if	
		i = i+1
	wend
%>
</form>
<p align=center><font size=+2>ASP <%="error happened"%></font></p>
<table border="0" cellpadding="3" cellspacing="1" width="700" bgcolor="#000000" align="center">
<tr><td bgcolor="#ccccff" colspan=2 align=middle><font size=+1><b><%="Technical information" %></b></font></td></tr>
<tr bgcolor="#cccccc"><td width=130 bgcolor="#ccccff"><b>Error number</b></td><td align="left"><%=Err.Number%></td></tr>
<tr bgcolor="#cccccc"><td bgcolor="#ccccff"><b><%="Error description" %></b></td><td align="left"><font color=#cc3300><%=Err.Description%></font></td></tr>
<tr bgcolor="#cccccc"><td bgcolor="#ccccff"><b><%="URL" %></b></td><td align="left"><%=my_htmlspecialchars(Request.ServerVariables("URL"))%></td></tr>
<% if strSQL<>"" then %>
<tr bgcolor="#cccccc"><td bgcolor="#ccccff" ><b><%="SQL query" %></b></td><td align="left"><%=strSQL%></td></tr>
<% end if %>
<% if strMoreInfo<>"" then %>
<tr bgcolor="#cccccc"><td bgcolor="#ccccff" ><b>Additional info</b></td><td align="left"><%=strMoreInfo%></td></tr>
<% end if %>
<tr bgcolor="#cccccc"><td bgcolor="#ccccff"><b>Solution</b></td><td align="left"><%=Solution%></td></tr>
</table>
    <form target=_new action="http://www.xlinesoft.com/asprunner/errors/default.asp" method="post" name="frmerror">
	<input type='hidden' name='ErrorNumber' value="<%=Err.Number%>" />
	<input type='hidden' name='Description' value="<%=Err.Description%>" />
	<input type='hidden' name='SQL' value="<%=dSQL%>" />
    </form>
<p align=center>
<a href="#" onClick="document.forms.frmerror.submit();return false;"><font size=3><b>More info on this error</b></font></a>
</p>

<%
	Response.End
end if
end sub

sub AddDict(dict,key, value)
	if dict.Exists(key) then
		dict(key)=value
	else
		dict.add key,value
	end if
end sub

function jsreplace(str)
	if isnull(str) then
	  jsreplace=""
	  exit function
	end if
	jsreplace = replace(str,"\","\\")
	jsreplace = replace(jsreplace,vbcr,"\r")
	jsreplace = replace(jsreplace,vblf,"\n")
	jsreplace = replace(jsreplace,"'","\'")
end function

Sub DeleteUploadedFiles(where)
	dim i
	set rsTmp = Server.CreateObject("ADODB.Recordset")
	sql = gSQLWhereAdd(where)
	rsTmp.Open sql, dbConnection
	if rsTmp.Eof then 
		rsTmp.Close
		set rsTmp = Nothing
	  exit sub
	end if
	for i=0 to rsTmp.Fields.Count-1
		if GetEditFormat(rsTmp.Fields(i).Name, strTableName)=EDIT_FORMAT_FILE then 
			if rsTmp(i)<>"" then 
				DeleteFile Server.MapPath(GetUploadFolder(rsTmp.Fields(i).Name, strTableName) & rsTmp(rsTmp.Fields(i).Name))
				if GetCreateThumbnail(rsTmp.Fields(i).Name,"") then _
					DeleteFile Server.MapPath(GetUploadFolder(rsTmp.Fields(i).Name, strTableName) & GetThumbnailPrefix(rsTmp.Fields(i).Name, strTableName) & rsTmp(rsTmp.Fields(i).Name))
			end if
		end if
	next	
	rsTmp.Close
	set rsTmp = Nothing
End Sub

Function IsUpdatable(Field)

		if Field.Attributes and 4 or Field.Attributes and 8 then
			IsUpdatable=true
		else
			IsUpdatable=false
		end if		

End Function

Function FormExists(Name)
	for x = 1 to Request.Form.count() 
        if Request.Form.key(x) = Name then
			FormExists = True
			Exit Function
		end if
    next 

	FormExists = False
End Function	

function CreateThumbnail(value, size, ext)
	dim jpeg
	SafeCreateObject "Persits.Jpeg", jpeg
	if isnull(jpeg) then
		CreateThumbnail=value
		exit function
	end if
	on error resume next
	Jpeg.OpenBinary value
	if err.number<>0 then
		CreateThumbnail=value
		on error goto 0
		exit function
	end if
	on error goto 0
	dim sx,sy
	sx = Jpeg.OriginalWidth
	sy = Jpeg.OriginalHeight
	if sx<=size and sy<=size or sx=0 or sy=0 then
		CreateThumbnail=value
		exit function
	end if
	if sx>=sy then
		jpeg.Height=sy*size/sx
		jpeg.Width=size
	else
		jpeg.Width=sx*size/sy
		jpeg.Height=size
	end if

	dim ret
	CreateThumbnail=Jpeg.Binary
end function

sub SafeCreateObject(name,object)
	on error resume next
	set object = server.CreateObject(name)
	if err.Number<>0 then
		object=null
	end if
	on error goto 0
end sub

Function loadSelectContent(field, value,fvalue)
	dim output, objDict, numDictEl

	Lookup = ""
	output = ""
	set objDict = Server.CreateObject("Scripting.Dictionary") 
	numDictEl = 0


	Set rsa = server.CreateObject("ADODB.Recordset")
	rsa.open LookupSQL,dbConnection

	if not FastType(field,"") then
		do while not rsa.EOF
			objDict(numDictEl)= dbvalue(rsa(0))
			numDictEl = numDictEl + 1
			objDict(numDictEl)= dbvalue(rsa(1))
			numDictEl = numDictEl + 1
			rsa.MoveNext
		loop
		rsa.Close	
	else
		if not rsa.EOF then
			objDict(numDictEl)= dbvalue(rsa(0))
			numDictEl = numDictEl + 1
			objDict(numDictEl)= dbvalue(rsa(1))
			numDictEl = numDictEl + 1
			rsa.MoveNext
			if not rsa.EOF then
				objDict.RemoveAll
			end if
		end if
	end if

	loadSelectContent = objDict.Items
End Function

Function xmlencode(str)
	if IsNull(str) then 
		xmlencode = ""
		Exit Function
	end if
	str = replace(str,"&","&amp;")
	str = replace(str,"<","&lt;")
	str = replace(str,">","&gt;")

	out=""
	l=len(str)
	ind=1
	for i=1 to l
		if Asc(Mid(str,i,1))>=128 then
			out = out & "&#" & Asc(Mid(str,i,1)) & ";"
			if ind<i then out = out & Mid(str,ind,i-ind)
			ind=i+1
		end if
	next

	if ind<=l then	out = out & Mid(str,ind)
	xmlencode = Replace(out, "'","&apos;")

End Function

Function ParseParams(str)
	
	Set params = CreateObject("Scripting.Dictionary")

	ind=1
	start=1
	while ind<Len(str)
		if Mid(str,ind,1) = "=" then
			name = Trim(Mid(str, start, ind-start))
			value = ""
			t = ind+1
			q=0  ' number of quotes
			s=0  ' number of spaces
			do while t<=len(str)
				if Mid(str,t,1)= """" then q = q + 1	
	                        if Mid(str,t,1)= " " then s = s + 1	
				if q=2 or s=1 or t=len(str) then 
					value = Mid(str, ind+1, t-ind)
					if Left(value,1)= """" then value = Mid(value,2)
					if Right(value,1)= """" then value = Left(value, Len(value)-1)
					ind = t
					start = t+1
					exit do
				end if
				t = t + 1
			loop
	
			if value<>"" then
				params.add name, trim(value)
				name=""
			end if
		end if
		ind = ind + 1
	wend 
	
	
	Set ParseParams = params
End Function

Function GetChartType(shorttable)

	GetChartType = ""
End Function

sub print_inline_array(arr)
	dim tmpVal	
	for each val in arr
		tmpVal=val
		if isnull(val) then _
			tmpVal=""
		tmpVal = replace(tmpVal,"\","\\")
		tmpVal = replace(tmpVal,vbcr,"\r")
		tmpVal = replace(tmpVal,vblf,"\n")
		tmpVal = replace(tmpVal,"\","\\")
		tmpVal = replace(tmpVal,"&","&amp;")
		tmpVal = replace(tmpVal,"<","&lt;")
		response.write tmpVal
		response.write "\n"
	next
end sub

Sub GetRecord(sSQL, avalues)

dim ind
set rstmp = Server.CreateObject("ADODB.Recordset")
rstmp.Open sSQL, dbConnection
if not rstmp.eof then
	for ind=0 to rstmp.Fields.Count-1
		avalues(rstmp.Fields(ind).Name) = rstmp.Fields(ind).Value
	next
	rstmp.close
end if
set rstmp = nothing

End Sub

function iif(expr, truepart, falsepart)
iif = falsepart
If expr Then iif = truepart
end function

Function InArray(arr, str)

if IsNull(arr) or IsEmpty(arr) then
	InArray = False
	Exit Function
end if

if UBound(arr)<LBound(arr) then 
	InArray = False
	Exit Function
end if

InArray = false

For ind=LBound(arr) to UBound(arr)
	if arr(ind)=str then
		InArray = true
		Exit Function
	end if
Next 


End Function


' Functions to provide encoding/decoding of strings with Base64.
' 
' Encoding: myEncodedString = base64_encode( inputString )
' Decoding: myDecodedString = base64_decode( encodedInputString )
'
' Programmed by Markus Hartsmar for ShameDesigns in 2002. 
' Email me at: mark@shamedesigns.com
' Visit our website at: http://www.shamedesigns.com/
'

	Dim Base64Chars
	Base64Chars =	"ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
			"abcdefghijklmnopqrstuvwxyz" & _
			"0123456789" & _
			"+/"


	' Functions for encoding string to Base64
	Public Function base64_encode( byVal strIn )
		Dim c1, c2, c3, w1, w2, w3, w4, n, strOut
		For n = 1 To Len( strIn ) Step 3
			c1 = Asc( Mid( strIn, n, 1 ) )
			c2 = Asc( Mid( strIn, n + 1, 1 ) + Chr(0) )
			c3 = Asc( Mid( strIn, n + 2, 1 ) + Chr(0) )
			w1 = Int( c1 / 4 ) : w2 = ( c1 And 3 ) * 16 + Int( c2 / 16 )
			If Len( strIn ) >= n + 1 Then 
				w3 = ( c2 And 15 ) * 4 + Int( c3 / 64 ) 
			Else 
				w3 = -1
			End If
			If Len( strIn ) >= n + 2 Then 
				w4 = c3 And 63 
			Else 
				w4 = -1
			End If
			strOut = strOut + mimeencode( w1 ) + mimeencode( w2 ) + _
					  mimeencode( w3 ) + mimeencode( w4 )
		Next
		base64_encode = strOut
	End Function

	Private Function mimeencode( byVal intIn )
		If intIn >= 0 Then 
			mimeencode = Mid( Base64Chars, intIn + 1, 1 ) 
		Else 
			mimeencode = ""
		End If
	End Function	


	' Function to decode string from Base64
	Public Function base64_decode( byVal strIn )
		Dim w1, w2, w3, w4, n, strOut
		For n = 1 To Len( strIn ) Step 4
			w1 = mimedecode( Mid( strIn, n, 1 ) )
			w2 = mimedecode( Mid( strIn, n + 1, 1 ) )
			w3 = mimedecode( Mid( strIn, n + 2, 1 ) )
			w4 = mimedecode( Mid( strIn, n + 3, 1 ) )
			If w2 >= 0 Then _
				strOut = strOut + _
					Chr( ( ( w1 * 4 + Int( w2 / 16 ) ) And 255 ) )
			If w3 >= 0 Then _
				strOut = strOut + _
					Chr( ( ( w2 * 16 + Int( w3 / 4 ) ) And 255 ) )
			If w4 >= 0 Then _
				strOut = strOut + _
					Chr( ( ( w3 * 64 + w4 ) And 255 ) )
		Next
		base64_decode = strOut
	End Function

	Private Function mimedecode( byVal strIn )
		If Len( strIn ) = 0 Then 
			mimedecode = -1 : Exit Function
		Else
			mimedecode = InStr( Base64Chars, strIn ) - 1
		End If
	End Function


Function URLDecode(str) 

	response.write str & "<br>"
        str = Replace(str, "+", " ") 
        For i = 1 To Len(str) 
            sT = Mid(str, i, 1) 
            If sT = "%" Then 
                If i+2 <= Len(str) Then 
                    sR = sR & _ 
                        Chr(CLng("&H" & Mid(str, i+1, 2))) 
                    i = i+2 
                End If 
            Else 
                sR = sR & sT 
            End If 
        Next 
        URLDecode = sR 
	response.write URLDecode & "<br>"

    End Function

%>

<%
strConnection = "DATABASE=mcoc_members;DRIVER={MySQL ODBC 3.51 Driver};OPTION=3;PWD=Maitland_01;PORT=0;SERVER=97.74.31.16;UID=mcoc_members;"
%>

<%

set dal_info=server.CreateObject("Scripting.Dictionary")
set dal_varnames=server.CreateObject("Scripting.Dictionary")
set daltable_evevents = server.CreateObject("Scripting.Dictionary")
daltable_evevents.Add "EventID",server.CreateObject("Scripting.Dictionary")
daltable_evevents("EventID")("nType")=3
	daltable_evevents("EventID")("varname")="EventID"
daltable_evevents.Add "Category",server.CreateObject("Scripting.Dictionary")
daltable_evevents("Category")("nType")=200
	daltable_evevents("Category")("varname")="Category"
daltable_evevents.Add "Company",server.CreateObject("Scripting.Dictionary")
daltable_evevents("Company")("nType")=200
	daltable_evevents("Company")("varname")="Company"
daltable_evevents.Add "Description",server.CreateObject("Scripting.Dictionary")
daltable_evevents("Description")("nType")=201
	daltable_evevents("Description")("varname")="Description"
daltable_evevents.Add "street",server.CreateObject("Scripting.Dictionary")
daltable_evevents("street")("nType")=200
	daltable_evevents("street")("varname")="street"
daltable_evevents.Add "phone",server.CreateObject("Scripting.Dictionary")
daltable_evevents("phone")("nType")=200
	daltable_evevents("phone")("varname")="phone"
daltable_evevents.Add "Map",server.CreateObject("Scripting.Dictionary")
daltable_evevents("Map")("nType")=201
	daltable_evevents("Map")("varname")="Map"
daltable_evevents.Add "web",server.CreateObject("Scripting.Dictionary")
daltable_evevents("web")("nType")=201
	daltable_evevents("web")("varname")="web"
daltable_evevents.Add "Image",server.CreateObject("Scripting.Dictionary")
daltable_evevents("Image")("nType")=200
	daltable_evevents("Image")("varname")="Image"
daltable_evevents.Add "title",server.CreateObject("Scripting.Dictionary")
daltable_evevents("title")("nType")=200
	daltable_evevents("title")("varname")="title"
daltable_evevents.Add "contact_f",server.CreateObject("Scripting.Dictionary")
daltable_evevents("contact_f")("nType")=200
	daltable_evevents("contact_f")("varname")="contact_f"
daltable_evevents.Add "contact_m",server.CreateObject("Scripting.Dictionary")
daltable_evevents("contact_m")("nType")=200
	daltable_evevents("contact_m")("varname")="contact_m"
daltable_evevents.Add "contact_l",server.CreateObject("Scripting.Dictionary")
daltable_evevents("contact_l")("nType")=200
	daltable_evevents("contact_l")("varname")="contact_l"
daltable_evevents.Add "city",server.CreateObject("Scripting.Dictionary")
daltable_evevents("city")("nType")=200
	daltable_evevents("city")("varname")="city"
daltable_evevents.Add "state",server.CreateObject("Scripting.Dictionary")
daltable_evevents("state")("nType")=200
	daltable_evevents("state")("varname")="state"
daltable_evevents.Add "zip",server.CreateObject("Scripting.Dictionary")
daltable_evevents("zip")("nType")=200
	daltable_evevents("zip")("varname")="zip"
daltable_evevents.Add "email",server.CreateObject("Scripting.Dictionary")
daltable_evevents("email")("nType")=200
	daltable_evevents("email")("varname")="email"
daltable_evevents.Add "leads",server.CreateObject("Scripting.Dictionary")
daltable_evevents("leads")("nType")=200
	daltable_evevents("leads")("varname")="leads"
daltable_evevents.Add "fax",server.CreateObject("Scripting.Dictionary")
daltable_evevents("fax")("nType")=200
	daltable_evevents("fax")("varname")="fax"
dal_info.Add "evevents",daltable_evevents
dal_varnames.Add "evevents","evevents"
set daltable_evcategories = server.CreateObject("Scripting.Dictionary")
daltable_evcategories.Add "Category",server.CreateObject("Scripting.Dictionary")
daltable_evcategories("Category")("nType")=200
	daltable_evcategories("Category")("varname")="Category"
dal_info.Add "evcategories",daltable_evcategories
dal_varnames.Add "evcategories","evcategories"
set daltable_evtellfriend = server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend.Add "FromName",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("FromName")("nType")=200
	daltable_evtellfriend("FromName")("varname")="FromName"
daltable_evtellfriend.Add "EmailAddress1",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailAddress1")("nType")=200
	daltable_evtellfriend("EmailAddress1")("varname")="EmailAddress1"
daltable_evtellfriend.Add "EmailAddress2",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailAddress2")("nType")=200
	daltable_evtellfriend("EmailAddress2")("varname")="EmailAddress2"
daltable_evtellfriend.Add "EmailAddress3",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailAddress3")("nType")=200
	daltable_evtellfriend("EmailAddress3")("varname")="EmailAddress3"
daltable_evtellfriend.Add "EmailAddress4",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailAddress4")("nType")=200
	daltable_evtellfriend("EmailAddress4")("varname")="EmailAddress4"
daltable_evtellfriend.Add "EmailAddress5",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailAddress5")("nType")=200
	daltable_evtellfriend("EmailAddress5")("varname")="EmailAddress5"
daltable_evtellfriend.Add "EmailSubject",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailSubject")("nType")=200
	daltable_evtellfriend("EmailSubject")("varname")="EmailSubject"
daltable_evtellfriend.Add "EmailBody",server.CreateObject("Scripting.Dictionary")
daltable_evtellfriend("EmailBody")("nType")=201
	daltable_evtellfriend("EmailBody")("varname")="EmailBody"
dal_info.Add "evtellfriend",daltable_evtellfriend
dal_varnames.Add "evtellfriend","evtellfriend"
set daltable_evusers = server.CreateObject("Scripting.Dictionary")
daltable_evusers.Add "ID",server.CreateObject("Scripting.Dictionary")
daltable_evusers("ID")("nType")=3
	daltable_evusers("ID")("varname")="ID"
daltable_evusers.Add "Username",server.CreateObject("Scripting.Dictionary")
daltable_evusers("Username")("nType")=200
	daltable_evusers("Username")("varname")="Username"
daltable_evusers.Add "Password",server.CreateObject("Scripting.Dictionary")
daltable_evusers("Password")("nType")=200
	daltable_evusers("Password")("varname")="Password"
daltable_evusers.Add "Group",server.CreateObject("Scripting.Dictionary")
daltable_evusers("Group")("nType")=200
	daltable_evusers("Group")("varname")="Group"
daltable_evusers.Add "Email",server.CreateObject("Scripting.Dictionary")
daltable_evusers("Email")("nType")=200
	daltable_evusers("Email")("varname")="Email"
daltable_evusers.Add "active",server.CreateObject("Scripting.Dictionary")
daltable_evusers("active")("nType")=3
	daltable_evusers("active")("varname")="active"
dal_info.Add "evusers",daltable_evusers
dal_varnames.Add "evusers","evusers"


Function CustomQuery(dalSQL)
	dim dal_rs
    Set dal_rs = server.CreateObject("ADODB.Recordset")
    dal_rs.open dalSQL, dbConnection
    set CustomQuery=dal_rs
End Function

Function UsersTableName()
    UsersTableName="`evusers`"
End Function

class tDAL
	public evevents
	public evcategories
	public evtellfriend
	public evusers
	Function Table(strTable)
            if ucase(strTable)=ucase("evevents") then
                set Table=evevents
                exit function
            end if
            if ucase(strTable)=ucase("evcategories") then
                set Table=evcategories
                exit function
            end if
            if ucase(strTable)=ucase("evtellfriend") then
                set Table=evtellfriend
                exit function
            end if
            if ucase(strTable)=ucase("evusers") then
                set Table=evusers
                exit function
            end if
'	check table names without dbo. and other prefixes
            if ucase(cutprefix(strTable))=ucase(cutprefix("evevents")) then
                set Table=evevents
                exit function
            end if
            if ucase(cutprefix(strTable))=ucase(cutprefix("evcategories")) then
                set Table=evcategories
                exit function
            end if
            if ucase(cutprefix(strTable))=ucase(cutprefix("evtellfriend")) then
                set Table=evtellfriend
                exit function
            end if
            if ucase(cutprefix(strTable))=ucase(cutprefix("evusers")) then
                set Table=evusers
                exit function
            end if
	End Function
end class

dim dal
set dal = new tDAL

dal_tables = dal_info.keys()
for each table in dal_tables
	command="Class class_" & GoodFieldName(table) & vbcrlf &_
"    Public m_TableName"& vbcrlf &_
"	Public m_Param"& vbcrlf &_
"	Public m_Value"& vbcrlf &_
"	Public m_ChangedFields" & vbcrlf
	arrFields=dal_info(table).keys()
	for each field in arrFields
		command=command & " Public m_fld" & GoodFieldName(field) & vbcrlf
	next
command=command & "	Public sub class_initialize()"& vbcrlf &_
"		set m_Param=CreateObject(""Scripting.Dictionary"")"& vbcrlf &_
"		set m_Value=CreateObject(""Scripting.Dictionary"")"& vbcrlf &_
"		set m_ChangedFields=CreateObject(""Scripting.Dictionary"")"& vbcrlf &_
"		m_TableName = """&replace(table,"""","""""")&""""& vbcrlf &_
"	end sub"& vbcrlf &_
"    Public Function TableName()"& vbcrlf &_
"        TableName=AddTableWrappers(m_TableName)"& vbcrlf &_
"    End Function"& vbcrlf &_
"   "& vbcrlf &_
"    Public Sub Add()"& vbcrlf &_
"		DALAdd dal."& dal_varnames(table) & vbcrlf &_
"	end sub"& vbcrlf &_
"    Public Sub Delete()"& vbcrlf &_
"		DALDelete dal."& dal_varnames(table) & vbcrlf &_
"	end sub"& vbcrlf &_
"    Public Sub Update()"& vbcrlf &_
"		DALUpdate dal."& dal_varnames(table) & vbcrlf &_
"	end sub"& vbcrlf &_
"    Public Function QueryAll()"& vbcrlf &_
"		set QueryAll = DALQueryAll(dal."& dal_varnames(table) &")"& vbcrlf &_
"	end function"& vbcrlf &_
"    Public Function Query(sw,ob)"& vbcrlf &_
"		set Query = DALQuery(dal."& dal_varnames(table) &",sw,ob)"& vbcrlf &_
"	end function"& vbcrlf &_
"    Public Function FetchByID()"& vbcrlf &_
"		set FetchByID=DALFetchByID(dal."& dal_varnames(table) &")"& vbcrlf &_
"	end function"& vbcrlf &_
"    Public Sub Reset()"& vbcrlf &_
"		DALReset dal."& dal_varnames(table) &""& vbcrlf &_
"	end sub"& vbcrlf &_
"    Public Property Let Param(p_Fields,p_Data)"& vbcrlf &_
"		DALLetParam dal."& dal_varnames(table) &",p_Fields,p_Data"& vbcrlf &_
"	end Property"& vbcrlf &_
"    Public Property Let Value(p_Fields,p_Data)"& vbcrlf &_
"		DALLetValue dal."& dal_varnames(table) &",p_Fields,p_Data"& vbcrlf &_
"	end Property"& vbcrlf
	for each field in arrFields
		command=command & "    Public Property Let "&dal_info(table)(field)("varname")&"(p_Data)"& vbcrlf &_
"        m_fld"&GoodFieldName(field)&" = p_Data"& vbcrlf &_
"        m_ChangedFields(""" & replace(field,"""","""""") & """)=true"& vbcrlf &_
"    End Property"& vbcrlf
	next
command=command & "End Class"& vbcrlf &_
"set dal."& dal_varnames(table) &" = new class_"& GoodFieldName(table) &""
execute command
next

function cutprefix(tablename)
	dim pos
	pos=instr(tablename,".")
	if pos>0 then
		cutprefix=mid(tablename,pos+1)
	else
		cutprefix=tablename
	end if
end function

sub DALAdd(obj)
	dim rs
	Set rs = server.CreateObject("ADODB.Recordset")
	rs.CursorLocation = 3
	rs.Open "select * from " & obj.TableName() & " where 1=0", dbConnection, 1,2
	rs.Addnew
	dim tableinfo
	set tableinfo=dal_info(obj.m_TableName)
	dim arrFields
'	prepare values
	arrFields=tableinfo.keys()
	dim command
	for each fld in arrFields
		if obj.m_ChangedFields.Exists(fld) then
			command="rs(fld)=obj.m_fld" & GoodFieldName(fld)
			execute command
		elseif obj.m_Value.Exists(fld) then 
			rs(fld)=obj.m_Value(fld)
		elseif obj.m_Param.Exists(fld) then
			rs(fld)=obj.m_Param(fld)
		end if
	next
'	do add
	rs.Update
	rs.Close
	DALReset(obj)
End Sub


sub DALDelete(obj)
    dim deleteFields
	deleteFields=""
	dim tableinfo
	set tableinfo=dal_info(obj.m_TableName)
	dim arrFields
	arrFields=tableinfo.keys()
	dim value,isset
'	prepare WHERE params
	dim command
	for each fld in arrFields
		isset=true
		if obj.m_ChangedFields.Exists(fld) then
           	command="value = obj.m_fld" & GoodFieldName(fld)
			execute command
		elseif obj.m_Param.Exists(fld) then
			value=obj.m_Param(fld)
		elseif obj.m_Value.Exists(fld) then 
			value=obj.m_Value(fld)
		else
			isset=false
		end if
		if isset then
			if NeedQuotes(tableinfo(fld)("nType")) then 
            	deleteFields=deleteFields & AddFieldWrappers(fld) & "='" & db_addslashes(value) & "' and "
			else
            	deleteFields=deleteFields & AddFieldWrappers(fld) & "=" & value & " and "
			end if
		end if
	next
'	do delete
	if deleteFields<>"" then
		deleteFields=left(deleteFields,len(deleteFields)-5)
		dalSQL="delete from " & obj.TableName() & " where " & deleteFields
		dbConnection.Execute dalSQL
	end if
	DALReset(obj)
end sub

sub DALUpdate(obj)
	dim updateParam
	updateParam=""
	dim tableinfo
	set tableinfo=dal_info(obj.m_TableName)
	dim arrFields,isset,value
	arrFields=tableinfo.keys()
'	prepare WHERE params
	dim command
	for each fld in arrFields
		isset=true
		if obj.m_ChangedFields.Exists(fld) and tableinfo(fld).Exists("bKey") then
           	command="value = obj.m_fld" & GoodFieldName(fld)
			execute command
		elseif obj.m_Param.Exists(fld) then
			value=obj.m_Param(fld)
		else
			isset=false
		end if
		if isset then
			if NeedQuotes(tableinfo(fld)("nType")) then 
            	updateParam=updateParam & AddFieldWrappers(fld) & "='" & db_addslashes(value) & "' and "
			else
            	updateParam=updateParam & AddFieldWrappers(fld) & "=" & value & " and "
			end if
		end if
	next

	if updateParam="" then
		DALReset(obj)
		exit sub
	end if

'	construct SQL, do select
	dim rs
	Set rs = server.CreateObject("ADODB.Recordset")
	rs.CursorLocation = 3
	dim strSQL
	updateParam = mid(updateParam,1,len(updateParam)-5)
	strSQL = "select * from " & obj.TableName() & " where " & updateParam
	rs.Open strSQL, dbConnection, 1,2
'	prepare values
	for each fld in arrFields
		if obj.m_ChangedFields.Exists(fld) and not tableinfo(fld).Exists("bKey") then
			command="rs(fld)=obj.m_fld" & GoodFieldName(fld)
			execute command
		elseif obj.m_Value.Exists(fld) then 
			rs(fld)=obj.m_Value(fld)
		end if
	next
	rs.Update
	rs.Close
	DALReset(obj)
End Sub

Function DALQueryAll(obj)
	set DALQueryAll=DALQuery(obj,"","")
End Function

function DALQuery(obj,sw,ob)
	dim dalSQL,rs
	dalSQL = "select * from " & obj.TableName()
	if sw<>"" then _
		dalSQL = dalSQL & " where " & sw
	if ob<>"" then _
		dalSQL = dalSQL & " order by " & ob
	
	Set rs = server.CreateObject("ADODB.Recordset")
	rs.open dalSQL, dbConnection
	set DALQuery=rs
End Function

Function DALFetchByID(obj)
    dim dalWhere
	dalWhere=""
	dim tableinfo
	set tableinfo=dal_info(obj.m_TableName)
	dim arrFields
	arrFields=tableinfo.keys()
	dim value,isset
'	prepare WHERE params
	dim command
	for each fld in arrFields
		isset=true
		if obj.m_ChangedFields.Exists(fld) then
           	command="value = obj.m_fld" & GoodFieldName(fld)
			execute command
		elseif obj.m_Param.Exists(fld) then
			value=obj.m_Param(fld)
		elseif obj.m_Value.Exists(fld) then 
			value=obj.m_Value(fld)
		else
			isset=false
		end if
		if isset then
			if NeedQuotes(tableinfo(fld)("nType")) then 
            	dalWhere=dalWhere & AddFieldWrappers(fld) & "='" & db_addslashes(value) & "' and "
			else
            	dalWhere=dalWhere & AddFieldWrappers(fld) & "=" & value & " and "
			end if
		end if
	next
	DALReset(obj)
'	do fetch
	if dalWhere="" then
		exit function
	end if
	dalWhere=left(dalWhere,len(dalWhere)-5)
	dalSQL="select * from " & obj.TableName() & " where " & dalWhere
	rs.open dalSQL, dbConnection
	set DALFetchByID = rs
End Function

sub DALReset(obj)
	obj.m_ChangedFields.RemoveAll
	obj.m_Param.RemoveAll
	obj.m_Value.RemoveAll
End Sub

sub DALLetParam(obj,p_Fields,p_Data)
	dim tableinfo
	set tableinfo=dal_info(obj.m_TableName)
	dim arrFields
	arrFields=tableinfo.keys()
	dim value,isset
'	assign params
	for each fld in arrFields
		if ucase(fld)=ucase(p_Fields) then
			obj.m_Param(fld)=p_Data
			exit sub
		end if
	next
End sub

sub DALLetValue(obj,p_Fields,p_Data)
	dim tableinfo
	set tableinfo=dal_info(obj.m_TableName)
	dim arrFields
	arrFields=tableinfo.keys()
	dim value,isset
'	assign values
	for each fld in arrFields
		if ucase(fld)=ucase(p_Fields) then
			obj.m_Value(fld)=p_Data
			exit sub
		end if
	next
End sub
	
%>
<%
Const FORMAT_NONE					= ""
Const FORMAT_DATE_SHORT				= "Short Date"
Const FORMAT_DATE_LONG				= "Long Date"
Const FORMAT_DATE_TIME				= "Datetime"
Const FORMAT_TIME					= "Time"
Const FORMAT_CURRENCY				= "Currency"
Const FORMAT_PERCENT				= "Percent"
Const FORMAT_HYPERLINK				= "Hyperlink"
Const FORMAT_EMAILHYPERLINK			= "Email Hyperlink"
Const FORMAT_FILE_IMAGE				= "File-based Image"
Const FORMAT_DATABASE_IMAGE			= "Database Image"
Const FORMAT_DATABASE_FILE			= "Database File"
Const FORMAT_FILE					= "Document Download"
Const FORMAT_LOOKUP_WIZARD			= "Lookup wizard"
Const FORMAT_PHONE_NUMBER			= "Phone Number"
Const FORMAT_NUMBER					= "Number"
Const FORMAT_HTML					= "HTML"
Const FORMAT_CHECKBOX				= "Checkbox"
Const FORMAT_CUSTOM					= "Custom"

Const EDIT_FORMAT_NONE				= ""
Const EDIT_FORMAT_TEXT_FIELD		= "Text field"
Const EDIT_FORMAT_TEXT_AREA			= "Text area"
Const EDIT_FORMAT_PASSWORD			= "Password"
Const EDIT_FORMAT_DATE				= "Date"
Const EDIT_FORMAT_TIME				= "Time"
Const EDIT_FORMAT_RADIO				= "Radio button"
Const EDIT_FORMAT_CHECKBOX			= "Checkbox"
Const EDIT_FORMAT_DATABASE_IMAGE	= "Database image"
Const EDIT_FORMAT_DATABASE_FILE		= "Database file"
Const EDIT_FORMAT_FILE				= "Document upload"
Const EDIT_FORMAT_LOOKUP_WIZARD		= "Lookup wizard"
Const EDIT_FORMAT_HIDDEN			= "Hidden field"
Const EDIT_FORMAT_READONLY			= "Readonly"

Const EDIT_DATE_SIMPLE				= 0
Const EDIT_DATE_SIMPLE_DP			= 11
Const EDIT_DATE_DD					= 12
Const EDIT_DATE_DD_DP				= 13

Const MODE_ADD						= 0
Const MODE_EDIT						= 1
Const MODE_SEARCH					= 2
Const MODE_LIST						= 3
Const MODE_PRINT					= 4
Const MODE_VIEW						= 5
Const MODE_INLINE_ADD				= 6
Const MODE_INLINE_EDIT				= 7

Const LOGIN_HARDCODED				= 0
Const LOGIN_TABLE					= 1

Const ADVSECURITY_ALL				= 0
Const ADVSECURITY_VIEW_OWN			= 1
Const ADVSECURITY_EDIT_OWN			= 2
Const ADVSECURITY_NONE				= 3

Const ACCESS_LEVEL_ADMIN			= "Admin"
Const ACCESS_LEVEL_ADMINGROUP		= "AdminGroup"
Const ACCESS_LEVEL_USER				= "User"
Const ACCESS_LEVEL_GUEST			= "Guest"

Const DATABASE_MySQL				= "MYSQL"
Const DATABASE_Oracle				= "ORACLE"
Const DATABASE_MSSQLServer			= "MS SQL SERVER"
Const DATABASE_Access				= "ACCESS"

Const RTE_BASIC 				= "BASIC"
Const RTE_FCK 					= "FCK"
Const RTE_INNOVA				= "INNOVA"

Const ADD_SIMPLE  				= 0
Const ADD_INLINE 				= 1
Const ADD_ONTHEFLY 				= 2


strLeftWrapper="`"
strRightWrapper="`"

cLoginTable				= "evusers"
cUserNameField			= "Username"
cPasswordField			= "Password"
cUserGroupField			= "Username"
cEmailField				= "Email"

cFrom 					= "info@maitlandchamber.com"
cSmtpServer 			= "mail.maitlandchamber.com"
cSmtpPort 				= "25"
cSMTPUser				= "info"
cSMTPPassword			= "Pass4321"



function db_connect()
	set dbConnection = server.CreateObject("ADODB.Connection")
   	dbConnection.ConnectionString = strConnection
   	dbConnection.Open
end function
function AddTableWrappers(strName)
	if mid(strName,1,1)=strLeftWrapper then
		AddTableWrappers = strName
		exit function
	end if
	dim arr
	arr=split(strName,".")
	ret=strLeftWrapper & arr(0) & strRightWrapper
	if ubound(arr)>0 then ret=ret & "." & strLeftWrapper & arr(1) & strRightWrapper
	AddTableWrappers = ret
end function

function db_upper(dbval)
	db_upper = "upper(" & dbval & ")"
end function

function AddFieldWrappers(strName)
	if mid(strName,1,1)=strLeftWrapper then
		AddFieldWrappers = strName
	else
		AddFieldWrappers = strLeftWrapper & strName & strRightWrapper
	end if
end function
function FieldNeedQuotes(rs,field)
	ttype=db_fieldtype(rs,field)
	if ttype=20 or ttype=128 or ttype=11 or ttype=6 or ttype=14 or ttype=5 or ttype=3 or ttype=131 _
	or ttype=4	or ttype=2	or ttype=16 or ttype=21 or ttype=19 or ttype=18 or ttype=17 or ttype=139 then
		FieldNeedQuotes = false
	else
		FieldNeedQuotes = true
	end if
end function
function db_addslashes(str)
	db_addslashes = replace(str,"'","''")
end function
function db_datequotes(val)
	db_datequotes = "'" & val & "'"
end function
function db_stripslashesbinary(str)
	db_stripslashesbinary=str
end function

function db_fieldtype(lhandle,fname)
	Dim i
	for i=0 to db_numfields(lhandle)-1
		if db_fieldname(lhandle,i)=fname then
			ttype=db_fieldtypen(lhandle,i)
			db_fieldtype = ttype
			exit function
		end if
	next
	db_fieldtype = ""
end function
function db_numfields(lhandle)
	db_numfields = lhandle.Fields.Count
end function

function db_fieldname(lhandle,fnumber)
	db_fieldname = lhandle.Fields(fnumber).Name
end function

function db_fieldtypen(lhandle,fnumber)
	db_fieldtypen = lhandle.Fields(fnumber).Type
end function

function date2str(val)
	if isnull(val) then
		date2str=""
		exit function
	end if
	if isdate(val) then
		date2str = CStr(year(val)) & "-" & CStr(month(val)) & "-" & CStr(day(val)) & _
				" " & CStr(hour(val)) & ":" & CStr(minute(val)) & ":" & CStr(second(val))
		exit function
	end if
	date2str=""
end function

Function CalcSearchParameters

	dim ret
	ret=""
	if SESSION(strTableName & "_search")=2 then
	'	 advanced search
		
		set strTableName_asearchfortype = SESSION(strTableName & "_asearchfortype")
		set strTableName_asearchnot = SESSION(strTableName & "_asearchnot")
		set strTableName_asearchopt = SESSION(strTableName & "_asearchopt")
		set strTableName_asearchfor = SESSION(strTableName & "_asearchfor")
		set strTableName_asearchfor2 = SESSION(strTableName & "_asearchfor2")

		sWhere=""
		for each f in strTableName_asearchfor
			strSearchFor=trim(strTableName_asearchfor.item(f))
			strSearchFor2=""
			ttype=strTableName_asearchfortype.item(f)
			
			for each i in strTableName_asearchfor2
				if f=i then strSearchFor2=trim(strTableName_asearchfor2.item(i))
			next
		
			if strSearchFor<>"" or true then
				if sWhere="" then
					if session(strTableName & "_asearchtype")="and" then
						sWhere="1=1"
					else
						sWhere="1=0"
					end if
				end if
				snot=strTableName_asearchnot.item(f)
				strSearchOption=trim(strTableName_asearchopt.Item(f))
				where=""
				where=StrWhereAdv(f, strSearchFor, strSearchOption, strSearchFor2,ttype)
				if where<>"" then
					if snot<>"" then where="not (" & where & ")"
					if SESSION(strTableName & "_asearchtype")="and" then
	   					sWhere=sWhere &  " and " & where
					else
	   					sWhere=sWhere &  " or " & where
	   				end if
				end if
			end if
		next
		ret=whereAdd(ret,sWhere)
	end if
	CalcSearchParameters = ret
End Function

%>

<%if request.form("a")="logout" or request.querystring("a")="logout" then
	session.Abandon()
	Response.Cookies("username")=""
	Response.Cookies("password")=""
	Response.Redirect "login.asp"
	response.end
end if%>
<%
smarty_debug=false
set foreachstack = CreateObject("Scripting.Dictionary")
set foreachvars = CreateObject("Scripting.Dictionary")
set foreachnames = CreateObject("Scripting.Dictionary")
set foreachcounts = CreateObject("Scripting.Dictionary")

function process_tag(str)
Dim i,regEx, Match,Matches,Ors,Expr
' remove {}
    str=mid(str,2,len(str)-2)
	str=trim(str)
	process_tag=""
	fore=""
	if len(str)=0 then exit function
	if mid(str,1,1)="$" then
		process_tag="response.write (" & smarty_subst_expr(str) &")"
	elseif mid(str,1,2)="if" or mid(str,1,6)="elseif" then
		dim fullexpr
		dim elsif
		elsif=true
		if mid(str,1,2)="if" then elsif=false
		if not elsif then
			fullexpr=trim(mid(str,3))
		else
			fullexpr=trim(mid(str,7))
		end if
		dim out
		out=""
		
		out = smarty_subst_expr(fullexpr)
		
		if not elsif then
			process_tag=" if " & out & " then "
		else
			process_tag=" elseif " & out & " then "
		end if
	elseif mid(str,1,4)="else" then
		process_tag="else"
	elseif mid(str,1,3)="/if" then
		process_tag="end if"
	elseif mid(str,1,7)="foreach" or mid(str,1,7)="section" then
		dim section,forcount
		section=false
		if mid(str,1,7)="section" then _
			section=true
	'split by param=value pairs
		Set regEx = New RegExp 
		regEx.Pattern = "(\S+)=(\S+)"
		regEx.IgnoreCase = True   
		regEx.Global = True   
		Set Matches = regEx.Execute(mid(str,7)) 
		forvar=""
		foritem=""
		forname=""
		forstart=""
		forloop=""
		For Each Match in Matches 
			p1=instr(Match.Value,"=")
			if ucase(mid(Match.Value,1,p1-1))="ITEM" then
				foritem=mid(Match.Value,p1+1)
			elseif ucase(mid(Match.Value,1,p1-1))="FROM" then
				forvar=mid(Match.Value,p1+2)
			elseif ucase(mid(Match.Value,1,p1-1))="NAME" then
				forname=mid(Match.Value,p1+1)
			elseif ucase(mid(Match.Value,1,p1-1))="START" then
				forstart=mid(Match.Value,p1+1)
			elseif ucase(mid(Match.Value,1,p1-1))="LOOP" then
				forloop=mid(Match.Value,p1+1)
			end if
		Next
		if mid(forstart,1,1)="$" then _
			forstart=smarty_subst(forstart)
		if mid(forloop,1,1)="$" then _
			forloop=smarty_subst(forloop)

		item=forvar
		p3=instr(1,forvar,".")
		if p3>0 then
			item=mid(forvar,p3+1)
			forvar=left(forvar,p3-1)
			forexpr=""
			for each tt in foreachvars
				if foreachvars(tt)=forvar then
					forexpr=foreachstack(tt)
					exit for
				end if
			next
		else
			forexpr="smarty"
		end if
		if section then
			forcount=forloop
		else
			forcount=forexpr & "(""" & item & """).Count"
		end if
		foreachvars.Add foreachvars.Count, foritem
		foreachstack.Add foreachstack.Count, forexpr & "(""" & item & """)(dd"& CStr(foreachstack.Count) & ")"
		foreachnames.Add foreachnames.Count, forname
		foreachcounts.Add foreachcounts.Count, forcount
		
		if not section then
			process_tag="for each dd"& CStr(foreachvars.Count-1)&" in " & forexpr & "(""" & item & """)"
		else
			process_tag="for dd"& CStr(foreachvars.Count-1)&" = " & forstart & " to " & forloop
		end if
	elseif mid(str,1,8)="/foreach" or mid(str,1,8)="/section" then
		dd=0
		process_tag="next"
		foreachstack.Remove foreachstack.Count-1
		foreachvars.Remove foreachvars.Count-1
		foreachnames.Remove foreachnames.Count-1
		foreachcounts.Remove foreachcounts.Count-1
	elseif mid(str,1,17)="include_if_exists" then		
	p=instr(1,str,"file=")
	if p>0 then
		process_tag= "set fs=Server.CreateObject(""Scripting.FileSystemObject"") : if fs.FileExists(Server.Mappath(""" & mid(str,p+6,len(str)-p-6) & """))=true then Server.Execute(""" & mid(str,p+6,len(str)-p-6) & """)" 
	end if	
	elseif mid(str,1,7)="include" then
		p=instr(1,str,"file=")
		if p>0 then
			process_tag="smart_smarty_display(""" & smarty(mid(str,p+7,len(str)-p-7)) & """)"
		end if
		
	elseif mid(str,1,18)="build_edit_control" then
		str2=mid(str,20)
		str2=replace(str2,"field=",vbcrlf & "bec_field=")
		str2=replace(str2,"mode=",vbcrlf & "bec_mode=")
		str2=replace(str2,"second=",vbcrlf & "bec_second=")
		str2=replace(str2,"value=",vbcrlf & "bec_value=")
		str2=replace(str2,"id=",vbcrlf & "bec_id=")
		str2 = "bec_second=false" & vbcrlf & str2 & vbcrlf
		p1=1
		dim inquot
		inquot=false
		do while p1<=len(str2)
		  if mid(str2,p1,1)="""" then 
		  	inquot=not inquot
		  elseif not inquot and mid(str2,p1,1)="$" then
			dim oldlen
			oldlen=len(str2)
			p2=instr(p1,str2,vbcrlf)
			str2 = left(str2,p1-1) & "smarty.item(""" & trim(mid(str2,p1+1,p2-p1-1)) & """)" & mid(str2,p2)
			p1=len(str2)-(oldlen-p2)
		  end if
		  p1=p1+1
		loop

'		p1=instr(1,str2,"$")
'		do while p1>0
'			p2=instr(p1,str2,vbcrlf)
'			str2 = left(str2,p1-1) & "smarty.item(""" & trim(mid(str2,p1+1,p2-p1-1)) & """)" & mid(str2,p2)
'			p1=instr(1,str2,"$")
'		loop
		process_tag = "bec_id="""""& vbcrlf & str2 & "smarty_function_build_edit_control()"
	elseif mid(str,1,13)="mlang_message" then
		p=instr(1,str,"tag=")
		if p>0 then
			process_tag="smarty_function_mlang_message(" & mid(str,p+4) & ")"
		end if
	elseif mid(str,1,10)="show_chart" then
		process_tag="smarty_function_show_chart(""" & Replace(mid(str,11),"""", """""") & """)"
	elseif mid(str,1,7)="doevent" then
		p=instr(1,str,"name=")
		if p>0 then
			process_tag="DoEvent ""Call " & mid(str,p+6) & ""
		end if
	end if
end function


' creates temporary file, returns filename
function process_file(filename)
	Dim Filepath
	Filepath = Server.MapPath("templates\" & Filename)	
	dim stream

	set stream=Server.CreateObject("ADODB.Stream")
	stream.CharSet=cCharset
	stream.type=2
	stream.Open
	stream.LoadFromFile Filepath

	dim text
	text = stream.ReadText
	stream.Close
	set stream=nothing
	dim linestart
	dim lineend
	dim breaklen
	linestart=1
	' create output string
	Dim res

	dim literal
	literal=false
	res=""
	' Read the file line by line
	Do While linestart>0
		breaklen=2
		lineend=instr(linestart,text,vbcrlf)
		lineend1=instr(linestart,text,vblf)
		lineend2=instr(linestart,text,vbcr)
		if lineend=0 then lineend=len(text)
		if lineend1=0 then lineend1=len(text)
		if lineend2=0 then lineend2=len(text)
		if lineend1<lineend then 
			lineend=lineend1
			breaklen=1
		end if
		if lineend2<lineend then 
			lineend=lineend2
			breaklen=1
		end if
		Dim Line
		if lineend<len(text) then
			Line = mid(text,linestart,lineend-linestart)
			linestart=lineend+breaklen
		else
			Line = mid(text,linestart)
			linestart=0
		end if
		' Process SMARTY tags
		dim pos,opos
		pos=1
		opos=1
		do 
			if literal then
				pos=InStr(opos,Line,"{/literal}")
				if pos>0 then
					addstring2res res,Mid(Line,opos,pos-opos),false
					opos=pos+len("{/literal}")
					literal=false
				else
					addstring2res res,Mid(Line,opos),true
					exit do
				end if
			end if
			pos=InStr(opos,Line,"{")
			if pos>0 then
				if pos>opos then _
					addstring2res res,Mid(Line,opos,pos-opos),false
				opos=pos
				pos=InStr(opos,Line,"}")
				if pos=0 then
					addstring2res res,Mid(Line,opos),true
					exit do
				end if
				if Mid(Line,opos,pos-opos+1)="{literal}" then
					literal=true
				else
					res=res & process_tag(Mid(Line,opos,pos-opos+1)) & vbcrlf
				end if
				opos=pos+1
			else
				addstring2res res,Mid(Line,opos),true
				exit do
			end if
		loop
	
	Loop
	process_file=res
end function

function smarty_function_build_edit_control()
	dim mode
	dim fformat
	
	if bec_mode="edit" then
		mode=MODE_EDIT
	elseif bec_mode="add" then
		mode=MODE_ADD
	elseif bec_mode="inline_edit" then
		mode=MODE_INLINE_EDIT
	elseif bec_mode="inline_add" then
		mode=MODE_INLINE_ADD
	else
		mode=MODE_SEARCH
	end if
	
	if mode=MODE_ADD and postvalue("editType")="onthefly" then
		mode=MODE_INLINE_ADD
		bec_id=postvalue("id")
	end if	
	
	fformat=GetEditFormat(bec_field,"")
	if (mode=MODE_EDIT or mode=MODE_ADD or mode=MODE_INLINE_EDIT or mode=MODE_INLINE_ADD) and fformat=EDIT_FORMAT_READONLY then
		response.Write readonlyfields(bec_field)
	end if
	if mode=MODE_SEARCH then
		fformat=editformats(bec_field)
	end if
	BuildEditControl bec_field,CStr(dbvalue(bec_value)),fformat,mode,bec_second,bec_id
end function

function smarty_function_mlang_message(tag)
	response.Write " " & mlang_message(tag)
	smarty_function_mlang_message = my_htmlspecialchars(mlang_message(tag))
end function

sub smarty_display(filename)
	smart_smarty_display(filename)
	set smarty=nothing
end sub

sub smart_smarty_display(filename)
	dim res
	res = process_file(filename)
	if smarty_debug then
		response.write res
	else
		execute res
	end if
end sub

function smarty_function_show_chart(str)

set params = ParseParams(str)

%>
<object 
classid="clsid:d27cdb6e-ae6d-11cf-96b8-444553540000" 
codebase="http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,0,0" 
width="<%=params("width")%>" 
height="<%=params("height")%>" 
align="middle">
<param name="allowScriptAccess" value="sameDomain" />
<param name="movie" value="oldlibs/swf/<%=GetChartType(params("name"))%>.swf?XMLFile=<%=params("name")%>_chartdata.asp%3Fwidth%3D<%=params("width")%>%26height%3D<%=params("height")%>" />
<param name="quality" value="high" />
<param name="bgcolor" value="#ffffff" /> 
<embed src="oldlibs/swf/<%=GetChartType(params("name"))%>.swf?XMLFile=<%=params("name")%>_chartdata.asp%3Fwidth%3D<%=params("width")%>%26height%3D<%=params("height")%>" quality="high" bgcolor="#ffffff" 
width="<%=params("width")%>" height="<%=params("height")%>" name="RELEASE" align="middle" allowScriptAccess="sameDomain" 
type="application/x-shockwave-flash" pluginspage="http://www.macromedia.com/go/getflashplayer" />
</object>

<%

end function

function smarty_subst(str)
	dim item,p,forvar,forname,forexpr,tt
	if instr(1,str,".")=0 then
		smarty_subst = "smarty(""" & mid(str,2) & """)"
	else
		item=""
		p=instr(1,str,".")
		item=mid(str,p+1)
		forvar=mid(str,2,p-2)
		if forvar="smarty" then
			p=instr(1,item,".")
			if p<1 then _
				exit function
			if ucase(mid(item,1,p-1))<>"FOREACH" and ucase(mid(item,1,p-1))<>"SECTION" then _
				exit function
			item=mid(item,p+1)
			p=instr(1,item,".")
			if p<1 then _
				exit function
			forname=mid(item,1,p-1)
			item=mid(item,p+1)
			forexpr=""
			if ucase(item)="FIRST" then
				for each tt in foreachnames
					if foreachnames(tt)=forname then
						smarty_subst = "dd" & tt & "=0"
						exit function
					end if
				next
			end if
			if ucase(item)="LAST" then
				for each tt in foreachnames
					if foreachnames(tt)=forname then
						smarty_subst = "dd" & tt & "="& foreachcounts(tt) & "-1"
						exit function
					end if
				next
			end if
			if ucase(item)="ITERATION" or ucase(item)="INDEX" then
				for each tt in foreachnames
					if foreachnames(tt)=forname then
						if ucase(item)="ITERATION" then
							smarty_subst = "(dd" & tt & "+1)"
						else
							smarty_subst = "dd" & tt 
						end if
						exit function
					end if
				next
			end if
		else
			
			forexpr=""
			for each tt in foreachvars
				if foreachvars(tt)=forvar then
					forexpr=foreachstack(tt)
					exit for
				end if
			next
			smarty_subst =  forexpr & "(""" & item & """)"
		end if
	end if
end function

function smarty_subst_expr(fullexpr)
	dim regEx,Matches,strNot,var,oper,tt, out,previdx
	Set regEx = New RegExp 
	regEx.Pattern = "(\!?\$?[\w\.]+)|(\""[^\""]*\"")"
	regEx.IgnoreCase = True   
	regEx.Global = True   
	Set Matches = regEx.Execute(fullexpr)
	strNot=""
	var=""
	oper=""
	out=""
	previdx=1
	for tt=0 to matches.count-1
		var=Matches(tt).Value
		if left(var,1)="!" then
			strNot="not "
			var=mid(var,2)
		end if
		if left(var,1)="$" then
			var=smarty_subst(var)
		end if
		oper=""
		if tt<matches.count-1 then 
			oper=mid(fullexpr,Matches(tt).FirstIndex+len(Matches(tt).Value)+1,Matches(tt+1).FirstIndex-(Matches(tt).FirstIndex+len(Matches(tt).Value)))
			oper=replace(oper,"!=","<>")
			oper=replace(oper,"==","=")
			oper=replace(oper,"&&"," and ")
			oper=replace(oper,"||"," or ")
		end if
		out= out & strNot & var & oper
		previdx=Matches(tt).FirstIndex + len(Matches(tt).value)
	next
	out = out & mid(fullexpr,previdx+1)
	out=replace(out,"]",")")
	out=replace(out,"[","(")
	smarty_subst_expr=out
end function

sub addstring2res(res,str,addcrlf)
	if addcrlf then
		res=res & "response.write """ & replace(replace(str,"""",""""""),"%" & ">","%"" & "">") & """ & vbcrlf" & vbcrlf
	else
		res=res & "response.write """ & replace(replace(str,"""",""""""),"%" & ">","%"" & "">") & """" & vbcrlf
	end if
end sub


Set smarty = CreateObject("Scripting.Dictionary")

dd=0
Session("fore")="rowinfo"
%>

<%

dbConnection = ""
db_connect()
DoEvent "BeforeProcessLogin dbConnection"

myurl=SESSION("MyURL")
SESSION("MyURL")=""

defaulturl=""
			defaulturl="evevents_list.asp"





strMessage=""

pUsername=postvalue("username")
pPassword=postvalue("password")

if request.form("btnSubmit") <> "Login" then
	if request.Cookies("username")<>"" or request.Cookies("password")<>"" then smarty.Add "checked"," checked"
end if

if request.form("btnSubmit") = "Login" then
	if request.form("remember_password") = 1 then
		Response.Cookies("username") = pUsername
		Response.Cookies("username").Expires = DateAdd("yyyy", 1, Now())
		Response.Cookies("password") = pPassword
		Response.Cookies("password").Expires = DateAdd("yyyy", 1, Now())
		smarty.Add "checked"," checked"
	else
		Response.Cookies("username") = ""
		Response.Cookies("password") = ""
		smarty.Add "checked",""
	end if
'   	 username and password are stored in the database
   	Set rs = server.CreateObject("ADODB.Recordset")

	rs.CursorLocation = 3
	
	strUsername = pUsername
	strPassword = pPassword
		
	Set rsTemp = server.CreateObject("ADODB.Recordset")
	rsTemp.Open "select * from `evusers` where 1=0",dbConnection,1,2

	if FieldNeedQuotes(rsTemp,cUserNameField) then 
		strUsername="'" & db_addslashes(strUsername) & "'"
	else
		strUsername=my_numeric(strUsername)
	end if
	if FieldNeedQuotes(rsTemp,cPasswordField) then 
		strPassword="'" & db_addslashes(strPassword) & "'"
	else
		strPassword=my_numeric(strPassword)
	end if
	rsTemp.close
		
	strSQL = "select * from `evusers` where " & AddFieldWrappers(cUserNameField) & _
		"=" & strUsername & " and " & AddFieldWrappers(cPasswordField) & 	"=" & strPassword
	RetVal = True
	DoEvent "RetVal = BeforeLogin(pUsername, pPassword)"
	if RetVal = False then strSQL="select * from `evusers` where 1<0"

	rs.Open strSQL,dbConnection, 1, 2
	'Call ReportError
 	if not rs.EOF then
		strPassword = pPassword
		   		if CStr(rs(cUserNameField))=pUsername and CStr(rs(cPasswordField))=strPassword then
			SESSION("UserID") = pUsername
   			SESSION("AccessLevel") = ACCESS_LEVEL_USER

				SESSION("GroupID") = dbvalue(rs("Username"))

		
							SESSION("OwnerID") = dbvalue(rs("Username"))
			SESSION("_evevents_OwnerID") = dbvalue(rs("Username"))

	
			DoEvent "AfterSuccessfulLogin pUsername,pPassword"
			if myurl<>"" then
				response.Redirect myurl
			else
				response.Redirect defaulturl
			end if
			response.End
		else
			DoEvent "AfterUnsuccessfulLogin pUsername,pPassword"
			strMessage = "Invalid Login"
		end if
		rs.MoveNext
	else
		DoEvent "AfterUnsuccessfulLogin pUsername,pPassword"
		strMessage = "Invalid Login"
	end if
	rs.close
end if

SESSION("MyURL")=myurl
if myurl<>"" then
	smarty.Add "url",myurl
else
	smarty.Add "url",defaulturl
end if
if request.form("username")<>"" or request.querystring("username")<>"" then
	smarty.Add "value_username","value=""" & my_htmlspecialchars(pUsername) & """"
else
	smarty.Add "value_username","value=""" & my_htmlspecialchars(request.Cookies("username")) & """"
end if


if request.form("password")<>"" then
	smarty.Add "value_password","value=""" & my_htmlspecialchars(pPassword) & """"
else
	smarty.Add "value_password","value=""" & my_htmlspecialchars(request.Cookies("password")) & """"
end if

if request.querystring("message")="expired" then strMessage = "Your session has expired. Please login again."


smarty.Add "message",strMessage

templatefile = "login.htm"
DoEvent "BeforeShowLogin smarty,templatefile"
smarty_display(templatefile)

%>