customizingprocess.asp

implementation of survey

<%
	dim sql, querySuccess, surveyNum, tempXML, totalRepliedTimes
	set xmlDoc = server.CreateObject("Microsoft.xmlDom")
	xmlDoc.load Request

	sql = xmlDoc.getElementsByTagName("sqlText").item(0).text
	sql=trim(sql)
	if LCase(right(sql, 3))="and" then
		sql=left(sql, len(sql)-3)
	end if 
	querySuccess = getWholeInnerJoinQuery(sql)

	set tempXML =nothing
	if querySuccess then
		if analyze() then  
				response.Write(tempXML.xml)
		else 
				response.Write("err.number: " & err.number)
		end if
	else
		response.Write("err.number: " & err.number)
	end if
	
	
	function afterWhere(condition)
		dim tableNameSet, str
		str = condition
		tableNameSet = getTblNameList(getColumnNamesArray(str))
		for i = 0 to 19 step 1
			if inStr(tableNameSet(i), "section") <> 0  then
				temp = tableNameSet(i) & "." & tableNameSet(i)
				str =Replace(str,  tableNameSet(i), temp)
			end if
		next
		afterWhere = str
	end function
	
	function getWholeInnerJoinQuery(externalSQL)
		On Error resume next
		dim databasePath, accessDB, con, rcs,  answersSet, postSql, execution, ifView, tableNameList, wholeSQL

		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		set rcs = server.createObject("ADODB.Recordset")
		if isViewExist("searchingQuery") then	
				rcs.open "DROP VIEW [searchingQuery]" ,con
		end if
		if isViewExist("tempView") then	
				rcs.open "DROP VIEW [tempView]", con
		end if		
		
		tableNameList = getTblNameList(getColumnNamesArray(externalSQL))
		postSql = generateSQL(tableNameList, 20)

		if not postSql = false then
				wholeSQL = trim(postSql)
				wholeSQL = left(wholeSQL, len(wholeSQL)-1)
				wholeSQL = right(wholeSQL, len(wholeSQL)-1)
				wholeSQL = "CREATE VIEW [searchingQuery] AS SELECT " & tableNameList(0) & ".IP, " & tableNameList(0) & ".surveyTime FROM " & wholeSQL & " WHERE " & afterWhere(externalSQL)
				rcs.open wholeSQL, con, 1, 1
				rcs.open "select * from searchingQuery"	
				totalRepliedTimes = rcs.recordCount
		else
				getWholeInnerJoinQuery = false
		end if	

		set rcs = nothing
		con.close
		set con = nothing		
		if err.number<>0  then
		    getWholeInnerJoinQuery = false
		else 
			getWholeInnerJoinQuery = true
		end if
	end function

	
	function generateSQL(tblsArray, m)
			on error resume next
			dim num, i, temp,tableA, tableB, finalSQL			
			if m = 1 then
					tableA = tblsArray(1)
					tableB = tblsArray(0)
					if inStr(tableA, "section") = 0 then
								if inStr(tableB, "section") = 0 or inStr(tableB, "section") = null then
										generateSQL = false
								else
										generateSQL = "(" & tableB & ")"
								end if	
					else				
								generateSQL =  "(" & tableA & " inner join " & tableB & " ON " & tableA & ".IP = " & tableB & ".IP "                                                            & " AND " & tableA & ".surveyTime = " & tableB & ".surveyTime) "
					end if				
			else
					if inStr(tblsArray(m), "section") = 0 then
								generateSQL = generateSQL(tblsArray, m-1)	
					else
								tableA = tblsArray(m)
								tableB = tblsArray(m-1)
								sqlPartA ="(" & tableA & " inner join "
								sqlPartB = " ON " & tableA & ".IP = " & tableB & ".IP "& " AND " & tableA & ".surveyTime = "                                                              & tableB & ".surveyTime) "
								middlePart = generateSQL(tblsArray, m-1)
								if middlePart = false then
									generateSQL = false
								else
									generateSQL = sqlPartA & middlePart & sqlPartB
								end if
					end if
			end if
			if err.number<>0 then
				generateSQL = false
			end if
	end function
	
	
	function getTblNameList(columnsArray)
				   dim tblNamesBox(20) 
				   sn = 0
				   for i = 0 to 19 step 1
						temp = columnsArray(i)
						if inStr(temp,"section") <> 0  then
								tblName = getTableName(temp)
								flag = true
								for y=0 to sn step 1
										if inStr(tblNamesBox(y),tblName) <> 0 then
											flag=false
										end if
								next
								if flag = true then
										tblNamesBox(sn) = tblName
										sn = sn + 1
								end if					
						end if
					next
					getTblNameList = tblNamesBox		
	end function
	
	
	
	function getColumnNamesArray(thisSQL)
		dim str, posStart, posEnd, posIs, posLike, temp, flag, k, colsNamesArray(20)
		str=thisSQL
		k = 0
		posStart = inStr(str, "section")
		do while  not ( posStart = 0 and  posStart = null) 		
				posIs = inStr(str, "=")
				posLike = inStr(LCase(str), "like")
				posBig = inStr(str, ">")
				posSmall = inStr(str, "<")
				posNot = inStr(str, "!")
				posIn = inStr(str, "in")
				posBetween = inStr(LCase(str), "between")
				
				posEnd = posIs
				
				if posEnd = 0 or posEnd = null then
					posEnd = posLike
				else
					if not (posLike = 0  and posLike = null) then
							if posEnd > posLike then
								posEnd = posLike
							end if
					end if
				end if	
				
				if posEnd = 0 or posEnd = null then
					posEnd = posBig
				else
					if not (posBig = 0  and posBig = null) then
							if posEnd > posBig then
								posEnd = posBig
							end if
					end if
				end if	
				
				if posEnd = 0 or posEnd = null then
					posEnd = posSmall
				else
					if not (posSmall = 0  and posSmall = null) then
							if posEnd > posSmall then
								posEnd = posSmall
							end if
					end if
				end if		
				
				if posEnd = 0 or posEnd = null then
					posEnd = posNot
				else
					if not (posNot = 0  and posNot = null) then
							if posEnd > posNot then
								posEnd = posNot
							end if
					end if
				end if		
				
				if posEnd = 0 or posEnd = null then
					posEnd = posIn
				else
					if not (posIn = 0  and posIn = null) then
							if posEnd > posIn then
								posEnd = posIn
							end if
					end if
				end if		
				
				if posEnd = 0 or posEnd = null then
					posEnd = posBetween
				else
					if not (posBetween = 0  and posBetween = null) then
							if posEnd > posBetween then
								posEnd = posBetween
							end if
					end if
				end if					
				
				temp = left(str, posEnd-1)
				temp = right( temp, len(temp)- posStart+1 )

				colsNamesArray(k) = trim(temp)
				str = Right( str, len(str) - posEnd )
				posStart = inStr(str, "section")
				k = k + 1
		loop				
		getColumnNamesArray = colsNamesArray	
	end function
	
	
	function getTableName(columnName)
		if inStr(columnName,"answer") = 0 then
			getTableName = trim(columnName)
		else
			getTableName = trim(left(columnName, instr(columnName, "answer")-1))
		end if
	end function
	
'	function dispArray(myArray)
'		dim temp, i
'		for i=0 to 20 step 1
'			if not inStr(myArray(i),"section")=0 then
'					temp =temp & "+" & myArray(i)
'			end if
'		next
'		dispArray = temp
'	end function
	
    function isViewExist(viewName)
		on error resume next
		dim databasePath2, accessDB2, con2, rcs2,  sql2, num2
		
		databasePath2 = Server.MapPath("../database")
		accessDB2 = databasePath2 & "\surveyData.mdb"
		set con2 = server.createObject("ADODB.Connection")
		set rcs2 = server.createObject("ADODB.Recordset")
		con2.provider = "Microsoft.Jet.OLEDB.4.0"
		con2.Open(accessDB2)
		sql2 = "SELECT * FROM MSysObjects where Name = ""searchingQuery"" and Type = 3"

		rcs2.open sql2, con2,1,1
		num2 = rcs2.recordcount
		set rcs2 = nothing
		con2.close
		set con2 = nothing
	    if num2 < 0 then
			isViewExist =false
		else
			isViewExist = true
		end if
		if err.number <> 0 then
			 response.Write("Database System table MSysObjects is locked, Adjust the Access Security Configuration")
		end if
   end function
	

	
	
	
  function analyze()
  		on error resume next
		dim   xmlsPath, questionsNode, tablesNum
		dim con, rcs,  i, colsSN,  questionDom, questionId
		dim databasePath,  accessDB
		
'		databasePath = Server.MapPath("../database")
'		accessDB = databasePath & "/surveyData.mdb"
'		set con = server.createObject("ADODB.Connection")
'		set rcs = server.createObject("ADODB.Recordset")
'		set answersSet = server.createObject("ADODB.Recordset")
'		con.provider = "Microsoft.Jet.OLEDB.4.0"
'		con.Open(accessDB)
		
		xmlsPath = Server.MapPath("../xmls")
		
		set questionDom = Server.CreateObject("Microsoft.XMLDOM")
		questionDom.async = false
		questionDom.load(xmlsPath & "/surveyInfo.xml")
		set questionsNode = questionDom.getElementsByTagName("question")
		tablesNum = questionsNode.length
		
		set tempXML = server.CreateObject("Microsoft.XMLDOM")
		tempXML.async = false
		tempXML.loadXML("<?xml version='1.0' encoding='iso-8859-1'?><customizedData/>")
		for i = 0 to tablesNum-1 step 1
				questionId = questionsNode.item(i).getAttribute("id")
				xmlString = combineView(tempXML, questionDom, i)
		next

'		set questionDom = nothing
'		set rcs = nothing
'		con.close
'		set con = nothing
		analyze = true
		if err.number<>0 then
				analyze =false
		end if
	end function
	
	function sqlTail(tableName, typeString)
		dim num, mn, tail
		on error resume next
		databasePath = Server.MapPath("../database")
		accessDB = databasePath & "/surveyData.mdb"
		set con = server.createObject("ADODB.Connection")
		set rcs = server.createObject("ADODB.Recordset")
		con.provider = "Microsoft.Jet.OLEDB.4.0"
		con.Open(accessDB)
		
		rcs.open "select * from " & tableName, con, 1, 1
		tail = " WHERE "
		num = rcs.fields.count
		for mn = 3 to num-1 step 1 
			if inStr(LCase(typeString), "text") <> 0 then
				tail = tail & rcs.fields.item(mn).name & " <> '' OR "
			else
				tail = tail & rcs.fields.item(mn).name & " <> 0 OR "
			end if
		next
		tail =left(tail, len(tail)-3)
		set questionsNode = nothing
		rcs.close
 		set rcs = nothing
		con.close
		set con = nothing		

		if err.number<> 0  then
			sqlTail = false
		else
			sqlTail = tail
		end if	
	end function
	
	function combineView(tempXML, questionXML, positionNum)
		on error resume next
		dim databasePath, accessDB, con, rcs,  sql, num, i, temp, questionsNode, tableName, fieldsNum