1 <%@ Control Language="vb" debug="true" ClassName="ricoResponse" %>
\r
2 <%@ Register TagPrefix="Rico" TagName="sqlParse" Src="sqlParse.ascx" %>
\r
3 <%@ Import Namespace="System.Data" %>
\r
4 <script runat="server">
\r
6 Public dbConnection as object
\r
7 Public dbDialect as String
\r
8 Protected dbVersion as String
\r
9 Protected dbClassName as String
\r
10 Public RequestId as string
\r
11 Public offset as integer = 0
\r
12 Public numrows as integer = 1999
\r
13 Public AllRowsMax as integer = 1999 ' max # of rows to send if numrows=-1
\r
14 Public gettotal as Boolean = true
\r
15 Public distinctCol as integer = -1
\r
16 Public editCol as integer = -1
\r
17 Public Headings(-1) as string
\r
18 Public HiddenCols(-1) as string
\r
19 Public filters as ArrayList
\r
20 Public orderByRef = false ' use column numbers in order by clause? (true/false)
\r
21 Public Wildcard as String="%"
\r
22 Public oParse as object ' parsed sql select statement to execute
\r
23 Public sqlText as String ' sql query to execute (either oParse or sqlText must be set prior to rendering)
\r
24 Public ErrorMsg as String ' may contain the text of an error message that occurred outside this control prior to rendering
\r
25 Public HeaderRows as new ArrayList() ' data that will be inserted before the query results
\r
26 Public FooterRows as new ArrayList() ' data that will be appended after the query results
\r
27 Public fmt as string
\r
28 Public SendHdg as Boolean = false
\r
29 Public RenderFlag as Boolean = true
\r
30 Protected command as object
\r
33 Public sendDebugMsgs as Boolean = false ' send details of sql parsing/execution in ajax response? (true/false)
\r
34 Public LogSqlOnError as Boolean = false ' include sql statement in results if an error occurs (true/false)
\r
35 Protected DebugMsgs as new ArrayList()
\r
38 Protected Sub Page_Init(Sender As object, e As EventArgs)
\r
39 RequestId = trim(Request.QueryString("id"))
\r
40 fmt = trim(Request.QueryString("_fmt"))
\r
41 dim sRequestOffset as string = trim(Request.QueryString("offset"))
\r
42 dim sRequestSize as string = trim(Request.QueryString("page_size"))
\r
43 dim sRequestTotal as string = lcase(Request.QueryString("get_total"))
\r
44 dim sDistinct as string = trim(Request.QueryString("distinct"))
\r
45 dim sEdit as string = trim(Request.QueryString("edit"))
\r
46 dim sHidden as string = trim(Request.QueryString("hidden"))
\r
47 if not IsNumeric(sRequestOffset) then sRequestOffset="0"
\r
49 if sRequestOffset<>"" then offset=CLng(sRequestOffset)
\r
50 if sRequestSize<>"" then numrows=CLng(sRequestSize)
\r
51 if sDistinct<>"" then distinctCol=CLng(sDistinct)
\r
52 if sEdit<>"" then editCol=CLng(sEdit)
\r
53 if sHidden<>"" then HiddenCols=split(sHidden,",")
\r
54 gettotal=(sRequestTotal="true")
\r
58 Protected Overrides Sub Render(writer as HTMLTextWriter)
\r
63 'Protected Overrides Sub Render(writer as HTMLTextWriter)
\r
64 Public Sub RunQuery(writer as HTMLTextWriter)
\r
65 Dim SqlRows as integer=0
\r
66 dim closetags as string, RowsStart as string, RowsEnd as string
\r
68 if not RenderFlag then exit sub
\r
71 Response.CacheControl = "no-cache"
\r
72 Response.AddHeader("Pragma", "no-cache")
\r
73 Response.Expires = -1
\r
77 Response.ContentType="text/html"
\r
78 writer.WriteLine("<html><head></head><body>")
\r
79 closetags="</body></html>"
\r
80 RowsStart=vbLf & "<table border='1'>"
\r
81 RowsEnd=vbLf & "</table>"
\r
86 Response.ContentType="application/vnd.ms-excel"
\r
87 writer.WriteLine("<html><head></head><body>")
\r
88 closetags="</body></html>"
\r
89 RowsStart=vbLf & "<table>"
\r
90 RowsEnd=vbLf & "</table>"
\r
95 Response.ContentType="application/json"
\r
96 writer.Write("{" & vbLf & """id"":""" & RequestId & """")
\r
97 RowsStart="," & vbLf & """update_ui"":true," & vbLf & """offset"":" & offset & "," & vbLf & """rows"":["
\r
103 Response.ContentType="text/xml"
\r
104 writer.WriteLine("<?xml version='1.0' encoding='iso-8859-1'?>")
\r
105 writer.WriteLine("<ajax-response><response type='object' id='" & RequestId & "'>")
\r
106 closetags="</response></ajax-response>"
\r
107 RowsStart=vbLf & "<rows update_ui='true' offset='" & offset & "'>"
\r
108 RowsEnd=vbLf & "</rows>"
\r
111 if RequestId="" then
\r
112 ErrorMsg="No ID provided!"
\r
113 elseif IsNothing(dbConnection) and (not IsNothing(oParse) or not IsNothing(sqlText)) then
\r
114 ErrorMsg="No database connection"
\r
117 if not IsNothing(ErrorMsg) then
\r
118 ErrorResponse(writer, ErrorMsg)
\r
121 writer.WriteLine(RowsStart)
\r
123 writer.WriteLine(join(HeaderRows.ToArray(),vbLf))
\r
124 if not IsNothing(dbConnection) then
\r
125 SqlRows=RenderQueryRows(writer)
\r
127 writer.WriteLine(join(FooterRows.ToArray(),vbLf))
\r
128 writer.WriteLine(RowsEnd)
\r
129 if SqlRows >= 0 and (fmt="xml" or fmt="json") then
\r
130 AppendResponse(writer, "rowcount", CStr(SqlRows+HeaderRows.count+FooterRows.count))
\r
132 if sendDebugMsgs then
\r
133 AppendArrayResponse(writer, "debug", DebugMsgs.ToArray())
\r
135 Catch ex As Exception
\r
136 writer.WriteLine(RowsEnd)
\r
137 dim msg as string = ex.Message
\r
138 if LogSqlOnError AndAlso not IsNothing(sqlText) then msg &= " - " & sqlText
\r
139 ErrorResponse(writer, msg)
\r
142 writer.WriteLine(closetags)
\r
146 Public Sub ErrorResponse(writer as HTMLTextWriter, msg as string)
\r
147 AppendResponse(writer,"error",msg)
\r
151 Public Sub AppendResponse(writer as HTMLTextWriter, tag as string, content as string)
\r
154 writer.write(vbLf & "<p>" & tag & "<br>" & server.htmlencode(content) & "</p>")
\r
156 writer.write("," & vbLf & """" & tag & """:""" & escapeJSON(content) & """")
\r
158 writer.write(vbLf & "<" & tag & ">" & server.htmlencode(content) & "</" & tag & ">")
\r
163 Public Sub AppendArrayResponse(writer as HTMLTextWriter, tag as string, arContent as object())
\r
164 dim item as string, i as integer
\r
167 writer.write(vbLf & "<p>" & tag)
\r
168 for each item in arContent
\r
169 writer.write("<br>" & server.htmlencode(item))
\r
171 writer.write("</p>")
\r
173 writer.write("," & vbLf & """" & tag & """:[")
\r
174 for i=0 to arContent.Length-1
\r
175 arContent(i)="""" & escapeJSON(arContent(i)) & """"
\r
177 writer.write(join(arContent,",") & "]")
\r
179 for each item in arContent
\r
180 writer.write(vbLf & "<" & tag & ">" & server.htmlencode(item) & "</" & tag & ">")
\r
186 ' returns the total number of rows produced by the query (or -1 if unknown)
\r
187 Protected Function RenderQueryRows(writer as HTMLTextWriter) As Integer
\r
188 dim rowcnt as integer, fldNum as integer, dbDate as DateTime, strFieldItem as String
\r
189 dim firstCol as Integer=0, limitQuery as Boolean=false, eof as Boolean=false, n as String
\r
191 dim totcnt as Integer=0
\r
194 dbVersion=dbConnection.ServerVersion
\r
195 dbClassName=TypeName(dbConnection)
\r
196 command = dbConnection.CreateCommand()
\r
197 if not IsNothing(oParse) then
\r
198 if distinctCol >= 0 then
\r
199 ApplyQStringParms()
\r
200 sqlText=oParse.UnparseDistinctColumn(distinctCol)
\r
201 elseif editCol >= 0 then
\r
202 sqlText=oParse.SelectList(editCol).LookupQuery
\r
203 oParse=new sqlParse()
\r
204 oParse.ParseSelect(sqlText)
\r
205 ApplyQStringParms()
\r
206 sqlText=oParse.UnparseSelect()
\r
207 elseif numrows < 0 then
\r
208 ApplyQStringParms()
\r
209 sqlText=oParse.UnparseSelectSkip(HiddenCols)
\r
211 ApplyQStringParms()
\r
212 select case dbDialect
\r
214 if left(dbVersion,2) >= "09" then
\r
215 sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,true,HiddenCols)
\r
219 sqlText=oParse.UnparseSelectSkip(HiddenCols)
\r
222 sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,false,HiddenCols)
\r
226 sqlText=oParse.UnparseSelectSkip(HiddenCols) & " LIMIT " & offset & "," & CStr(numrows+1)
\r
229 sqlText=oParse.UnparseSelectSkip(HiddenCols)
\r
233 if IsNothing(sqlText) then Exit Function
\r
234 DebugMsgs.add(sqlText)
\r
235 DebugMsgs.add(dbClassName)
\r
236 DebugMsgs.add("DB version=" & dbVersion)
\r
237 command.CommandText = sqlText
\r
238 rdr = command.ExecuteReader()
\r
243 while (totcnt < offset) and (not eof)
\r
253 if numrows < 0 then numrows=AllRowsMax
\r
256 writer.Write(vbLf & "[")
\r
257 for fldNum=firstCol to rdr.FieldCount -1
\r
258 if IsNothing(oParse) then
\r
261 n=oParse.Headings(fldNum-firstCol)
\r
263 if IsNothing(n) then n=rdr.GetName(fldNum)
\r
264 writer.Write("""" & escapeJSON(n) & """")
\r
268 while (rowcnt < numrows) and (not eof)
\r
270 if rowcnt > 0 or SendHdg then writer.Write(",")
\r
271 writer.Write(vbLf & "[")
\r
272 for fldNum = firstCol to rdr.FieldCount -1
\r
274 if not rdr.IsDBNull(fldNum) then
\r
275 select case rdr.GetFieldType(fldNum).Name
\r
277 dbDate=rdr.GetDateTime(fldNum)
\r
278 strFieldItem = replace(dbDate.ToString("s"),"T"," ") ' convert to ISO-8601 format
\r
280 strFieldItem = escapeJSON(rdr.GetValue(fldNum))
\r
283 if fldNum > firstCol then writer.Write(",")
\r
284 writer.Write("""" & strFieldItem & """")
\r
294 writer.Write(vbLf & "<tr>")
\r
295 for fldNum=firstCol to rdr.FieldCount -1
\r
296 if IsNothing(oParse) then
\r
299 n=oParse.Headings(fldNum-firstCol)
\r
301 if IsNothing(n) then n=rdr.GetName(fldNum)
\r
302 writer.Write("<td>" & server.HTMLEncode(n) & "</td>")
\r
304 writer.Write("</tr>")
\r
306 while (rowcnt < numrows) and (not eof)
\r
309 writer.Write("<tr>")
\r
310 for fldNum = firstCol to rdr.FieldCount -1
\r
312 if not rdr.IsDBNull(fldNum) then
\r
313 select case rdr.GetFieldType(fldNum).Name
\r
315 dbDate=rdr.GetDateTime(fldNum)
\r
316 strFieldItem = replace(dbDate.ToString("s"),"T"," ") ' convert to ISO-8601 format
\r
318 strFieldItem = server.HTMLEncode(rdr.GetValue(fldNum))
\r
321 writer.Write("<td>" & strFieldItem & "</td>")
\r
323 writer.Write("</tr>")
\r
331 if not eof and gettotal then
\r
335 countSql="SELECT " & oParse.UnparseColumnList() & " FROM " & oParse.FromClause
\r
336 if not IsNothing(oParse.WhereClause) then countSql &= " WHERE " & oParse.WhereClause
\r
337 if oParse.GroupBy.count > 0 then countSql &= " GROUP BY " & join(oParse.GroupBy.ToArray(),",")
\r
338 if not IsNothing(oParse.HavingClause) then countSql &= " HAVING " & oParse.HavingClause
\r
339 countSql="SELECT COUNT(*) FROM (" & countSql & ")"
\r
340 if dbDialect<>"Oracle" then countSql &= " AS rico_Main"
\r
341 DebugMsgs.add(countSql)
\r
342 command.CommandText = countSql
\r
343 totcnt = command.ExecuteScalar()
\r
352 if eof then RenderQueryRows=totcnt
\r
357 ' returns the parameter symbol to insert into the sql string
\r
358 Private Function PushParam(ByVal newvalue) as String
\r
359 dim ParamName as String
\r
360 newvalue=cstr(newvalue)
\r
361 if newvalue="" then newvalue=" " ' empty string gets converted to TEXT data type instead of VARCHAR
\r
362 select case dbClassName
\r
363 case "SqlConnection":
\r
364 ParamName="@P" & CStr(command.parameters.count)
\r
365 PushParam=ParamName
\r
370 command.parameters.add(ParamName,newvalue)
\r
371 DebugMsgs.add("Param " & ParamName & " value=" & newvalue)
\r
375 ' assumes oParse is already initialized
\r
376 Private sub ApplyQStringParms()
\r
378 dim j as Integer, fop as String, ParamSymbol as String
\r
379 dim newfilter as string, qs as string, value as string
\r
381 for each qs in Request.QueryString
\r
382 select case left(qs,1)
\r
384 ' user-invoked condition
\r
387 if IsNumeric(i) then
\r
389 if i<0 or i>=filters.Count then exit for
\r
390 value=Request.QueryString(qs)
\r
391 newfilter=filters(i)
\r
392 j=InStr(1,newfilter," in (?)",1)
\r
395 for i=0 to ubound(a)
\r
396 ParamSymbol=PushParam(a(i))
\r
399 newfilter=left(newfilter,j+4) & join(a,",") & mid(newfilter,j+6)
\r
400 elseif InStr(newfilter,"?")>0 then
\r
401 ParamSymbol=PushParam(value)
\r
402 if ParamSymbol<>"?" then newfilter=replace(newfilter,"?",ParamSymbol)
\r
404 if left(qs,1)="h" then
\r
405 oParse.AddHavingCondition(newfilter)
\r
407 oParse.AddWhereCondition(newfilter)
\r
414 if not IsNumeric(i) then exit for
\r
416 if i<0 or i>=oParse.SelectList.count then exit for
\r
417 value=ucase(left(Request.QueryString(qs),4))
\r
418 if value<>"ASC" and value<>"DESC" then value="ASC"
\r
420 oParse.AddSort(CStr(i+1) & " " & value)
\r
422 oParse.AddSort(oParse.SelectList(i).sql & " " & value)
\r
425 ' user-supplied filter
\r
428 if ubound(a)=2 then
\r
430 i=left(a(1),len(a(1))-1)
\r
431 if not IsNumeric(i) then exit for
\r
432 if len(i)>3 then exit for
\r
434 if i<0 or i>oParse.SelectList.count then exit for
\r
435 fop=Request.QueryString(qs)
\r
436 newfilter=oParse.SelectList(i).sql
\r
439 newfilter = "(" & AddCoalesce(newfilter) & " IN " & GetMultiParmFilter(qs) & ")"
\r
441 newfilter &= "<=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))
\r
443 newfilter &= ">=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))
\r
444 case "NULL": newfilter &= " is null"
\r
445 case "NOTNULL": newfilter &= " is not null"
\r
447 newfilter &= " LIKE " & PushParam(replace(Request.QueryString(replace(qs,"[op]","[0]")),"*",Wildcard))
\r
449 newfilter = "(" & AddCoalesce(newfilter) & " NOT IN " & GetMultiParmFilter(qs) & ")"
\r
451 dim sql=oParse.SelectList(i).sql
\r
452 if (InStr(sql,"min(")>0 or _
\r
453 InStr(sql,"max(")>0 or _
\r
454 InStr(sql,"sum(")>0 or _
\r
455 InStr(sql,"count(")>0) and _
\r
456 InStr(sql,"(select ")<1 then
\r
457 oParse.AddHavingCondition(newfilter)
\r
459 oParse.AddWhereCondition(newfilter)
\r
468 Private function AddCoalesce(newfilter as String) as String
\r
469 if dbDialect="Access" then
\r
470 newfilter="iif(IsNull(" & newfilter & "),''," & newfilter & ")"
\r
472 newfilter="coalesce(" & newfilter & ",'')"
\r
474 AddCoalesce=newfilter
\r
478 Private function GetMultiParmFilter(qs as String) as String
\r
479 dim flenStr as String = Request.QueryString(replace(qs,"[op]","[len]"))
\r
480 if not IsNumeric(flenStr) then exit function
\r
481 dim flen as Integer = CInt(flenStr)
\r
482 dim j as Integer, param as String, filter as String = ""
\r
484 if j>0 then filter &= ","
\r
485 param=Request.QueryString(replace(qs,"[op]","[" & j & "]"))
\r
486 filter &= PushParam(param)
\r
488 GetMultiParmFilter = "(" & filter & ")"
\r
492 Public function XmlStringCell(value as object) as String
\r
494 if IsDBNull(value) then result="" else result=server.HTMLEncode(value)
\r
495 XmlStringCell="<td>" & result & "</td>"
\r
499 ' for the root node, parentID should "" (empty string)
\r
500 ' containerORleaf: L/zero (leaf), C/non-zero (container)
\r
501 ' selectable: 0->not selectable, 1->selectable
\r
502 Public function WriteTreeRow(parentID,ID,description,containerORleaf,selectable)
\r
503 HeaderRows.Add(TreeRow(parentID,ID,description,containerORleaf,selectable))
\r
506 Public function TreeRow(parentID,ID,description,containerORleaf,selectable)
\r
507 TreeRow="<tr>" & XmlStringCell(parentID) & XmlStringCell(ID) & XmlStringCell(description) & XmlStringCell(containerORleaf) & XmlStringCell(selectable) & "</tr>"
\r
510 '******************************************************************************************
\r
511 '' @SDESCRIPTION: takes a given string and makes it JSON valid (http://json.org/)
\r
512 '' @AUTHOR: Michael Rebec
\r
513 '' @DESCRIPTION: all characters which needs to be escaped are beeing replaced by their
\r
514 '' unicode representation according to the
\r
515 '' RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627
\r
516 '' @PARAM: val [string]: value which should be escaped
\r
517 '' @RETURN: [string] JSON valid string
\r
518 '******************************************************************************************
\r
519 public function escapeJSON(val)
\r
520 const cDoubleQuote = &h22
\r
521 const cRevSolidus = &h5C
\r
522 const cSolidus = &h2F
\r
523 dim i as integer, currentDigit as string
\r
525 for i = 1 to (len(val))
\r
526 currentDigit = mid(val, i, 1)
\r
527 if asc(currentDigit)> &h00 and asc(currentDigit) <&h1F then
\r
528 currentDigit = escapeJSONSquence(currentDigit)
\r
529 elseif asc(currentDigit)>= &hC280 and asc(currentDigit) <= &hC2BF then
\r
530 currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC200), 2, 0), 2)
\r
531 elseif asc(currentDigit)>= &hC380 and asc(currentDigit) <= &hC3BF then
\r
532 currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC2C0), 2, 0), 2)
\r
534 select case asc(currentDigit)
\r
535 case cDoubleQuote: currentDigit = escapeJSONSquence(currentDigit)
\r
536 case cRevSolidus: currentDigit = escapeJSONSquence(currentDigit)
\r
537 case cSolidus: currentDigit = escapeJSONSquence(currentDigit)
\r
540 escapeJSON = escapeJSON & currentDigit
\r
544 function escapeJSONSquence(digit)
\r
545 escapeJSONSquence = "\u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)
\r
548 function padLeft(value, totalLength, paddingChar)
\r
549 padLeft = right(clone(paddingChar, totalLength) & value, totalLength)
\r
552 public function clone(byVal str, n)
\r
554 for i = 1 to n : clone = clone & str : next
\r