git.infodrom.org Git - infodrom/rico3/blob - plugins/dotnet/ricoResponse.ascx

   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
   5 \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
  31 \r
  32 ' DEBUGGING CONTROL\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
  36 \r
  37 \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
  48 \r
  49   if sRequestOffset<>"" then sRequestOffset=Regex.Replace( sRequestOffset, "[^0-9-]", "" )\r
  50   if sRequestOffset<>"" then offset=CLng(sRequestOffset)\r
  51   if sRequestSize<>"" then sRequestSize=Regex.Replace( sRequestSize, "[^0-9-]", "" )\r
  52   if sRequestSize<>"" then numrows=CLng(sRequestSize)\r
  53   if sDistinct<>"" then distinctCol=CLng(sDistinct)\r
  54   if sEdit<>"" then editCol=CLng(sEdit)\r
  55   if sHidden<>"" then HiddenCols=split(sHidden,",")\r
  56   gettotal=(sRequestTotal="true")\r
  57 End Sub\r
  58 \r
  59 \r
  60 Protected Overrides Sub Render(writer as HTMLTextWriter)\r
  61   Me.RunQuery(writer)\r
  62 End Sub\r
  63 \r
  64 \r
  65 'Protected Overrides Sub Render(writer as HTMLTextWriter)\r
  66 Public Sub RunQuery(writer as HTMLTextWriter)\r
  67   Dim SqlRows as integer=0\r
  68   dim closetags as string, RowsStart as string, RowsEnd as string\r
  69 \r
  70   if not RenderFlag then exit sub\r
  71   Response.clear\r
  72   if fmt<>"xl" then\r
  73     Response.CacheControl = "no-cache"\r
  74     Response.AddHeader("Pragma", "no-cache")\r
  75     Response.Expires = -1\r
  76   end if\r
  77   select case fmt\r
  78     case "html":\r
  79       Response.ContentType="text/html"\r
  80       writer.WriteLine("<html><head></head><body>")\r
  81       closetags="</body></html>"\r
  82       RowsStart=vbLf & "<table border='1'>"\r
  83       RowsEnd=vbLf & "</table>"\r
  84       gettotal=false\r
  85       sendDebugMsgs=false\r
  86       SendHdg=true\r
  87     case "xl":\r
  88       Response.ContentType="application/vnd.ms-excel"\r
  89       Response.AddHeader("Content-Disposition", "attachment; filename=" & RequestId & ".xml")\r
  90       writer.WriteLine("<?xml version='1.0' encoding='iso-8859-1'?>")\r
  91       writer.WriteLine("<?mso-application progid='Excel.Sheet'?>")\r
  92       writer.WriteLine("<s:Workbook xmlns:x='urn:schemas-microsoft-com:office:excel' xmlns:o='urn:schemas-microsoft-com:office:office' xmlns:s='urn:schemas-microsoft-com:office:spreadsheet'>")\r
  93       writer.WriteLine("  <s:Styles>")\r
  94       writer.WriteLine("    <s:Style s:ID='sDate'><s:NumberFormat s:Format='Short Date' /></s:Style>")\r
  95       writer.WriteLine("  </s:Styles>")\r
  96       writer.WriteLine("  <s:Worksheet s:Name='" & RequestId & "'>")\r
  97       closetags="</s:Worksheet></s:Workbook>"\r
  98       RowsStart=vbLf & "<s:Table>"\r
  99       RowsEnd=vbLf & "</s:Table>"\r
 100 \r
 101       gettotal=false\r
 102       sendDebugMsgs=false\r
 103       AllRowsMax=65534  ' allow 1 row for heading\r
 104     case "json":\r
 105       Response.ContentType="application/json"\r
 106       writer.Write("{" & vbLf & """id"":""" & RequestId & """")\r
 107       RowsStart="," & vbLf & """update_ui"":true," & vbLf & """offset"":" & offset & "," & vbLf & """rows"":["\r
 108       RowsEnd=vbLf & "]"\r
 109       closetags="}"\r
 110     case else:\r
 111       ' default to xml\r
 112       fmt="xml"\r
 113       Response.ContentType="text/xml"\r
 114       writer.WriteLine("<?xml version='1.0' encoding='iso-8859-1'?>")\r
 115       writer.WriteLine("<ajax-response><response type='object' id='" & RequestId & "'>")\r
 116       closetags="</response></ajax-response>"\r
 117       RowsStart=vbLf & "<rows update_ui='true' offset='" & offset & "'>"\r
 118       RowsEnd=vbLf & "</rows>"\r
 119   end select\r
 120 \r
 121   if RequestId="" then\r
 122     ErrorMsg="No ID provided!"\r
 123   elseif IsNothing(dbConnection) and (not IsNothing(oParse) or not IsNothing(sqlText)) then\r
 124     ErrorMsg="No database connection"\r
 125   end if\r
 126 \r
 127   if not IsNothing(ErrorMsg) then\r
 128     ErrorResponse(writer, ErrorMsg)\r
 129   else\r
 130 \r
 131     writer.WriteLine(RowsStart)\r
 132     try\r
 133       writer.WriteLine(join(HeaderRows.ToArray(),vbLf))\r
 134       if not IsNothing(dbConnection) then\r
 135         SqlRows=RenderQueryRows(writer)\r
 136       end if\r
 137       writer.WriteLine(join(FooterRows.ToArray(),vbLf))\r
 138       writer.WriteLine(RowsEnd)\r
 139       if SqlRows >= 0 and (fmt="xml" or fmt="json") then\r
 140         AppendResponse(writer, "rowcount", CStr(SqlRows+HeaderRows.count+FooterRows.count))\r
 141       end if\r
 142       if sendDebugMsgs then\r
 143         AppendArrayResponse(writer, "debug", DebugMsgs.ToArray())\r
 144       end if\r
 145     Catch ex As Exception\r
 146       writer.WriteLine(RowsEnd)\r
 147       dim msg as string = ex.Message\r
 148       if LogSqlOnError AndAlso not IsNothing(sqlText) then msg &= " - " & sqlText\r
 149       ErrorResponse(writer, msg)\r
 150     end try\r
 151   end if\r
 152   writer.WriteLine(closetags)\r
 153 End Sub\r
 154 \r
 155 \r
 156 Public Sub ErrorResponse(writer as HTMLTextWriter, msg as string)\r
 157   AppendResponse(writer,"error",msg)\r
 158 end sub\r
 159 \r
 160 \r
 161 Public Sub AppendResponse(writer as HTMLTextWriter, tag as string, content as string)\r
 162   select case fmt\r
 163     case "html", "xl":\r
 164       writer.write(vbLf & "<p>" & tag & "<br>" & server.htmlencode(content) & "</p>")\r
 165     case "json":\r
 166       writer.write("," & vbLf & """" & tag & """:""" & escapeJSON(content) & """")\r
 167     case "xml":\r
 168       writer.write(vbLf & "<" & tag & ">" & server.htmlencode(content) & "</" & tag & ">")\r
 169   end select\r
 170 end sub\r
 171 \r
 172 \r
 173 Public Sub AppendArrayResponse(writer as HTMLTextWriter, tag as string, arContent as object())\r
 174   dim item as string, i as integer\r
 175   select case fmt\r
 176     case "html", "xl":\r
 177       writer.write(vbLf & "<p>" & tag)\r
 178       for each item in arContent\r
 179         writer.write("<br>" & server.htmlencode(item))\r
 180       next\r
 181       writer.write("</p>")\r
 182     case "json":\r
 183       writer.write("," & vbLf & """" & tag & """:[")\r
 184       for i=0 to arContent.Length-1\r
 185         arContent(i)="""" & escapeJSON(arContent(i)) & """"\r
 186       next\r
 187       writer.write(join(arContent,",") & "]")\r
 188     case "xml":\r
 189       for each item in arContent\r
 190         writer.write(vbLf & "<" & tag & ">" & server.htmlencode(item) & "</" & tag & ">")\r
 191       next\r
 192   end select\r
 193 end sub\r
 194 \r
 195 \r
 196 ' returns the total number of rows produced by the query (or -1 if unknown)\r
 197 Protected Function RenderQueryRows(writer as HTMLTextWriter) As Integer\r
 198   dim rowcnt as integer, fldNum as integer, dbDate as DateTime, strFieldItem as String, fldType as String, fldAttr as String\r
 199   dim firstCol as Integer=0, limitQuery as Boolean=false, eof as Boolean=false, n as String\r
 200   dim rdr as object\r
 201   dim totcnt as Integer=0\r
 202 \r
 203   RenderQueryRows=-1\r
 204   dbVersion=dbConnection.ServerVersion\r
 205   dbClassName=TypeName(dbConnection)\r
 206   command = dbConnection.CreateCommand()\r
 207   if not IsNothing(oParse) then\r
 208     if distinctCol >= 0 then\r
 209       ApplyQStringParms()\r
 210       sqlText=oParse.UnparseDistinctColumn(distinctCol)\r
 211     elseif editCol >= 0 then\r
 212       sqlText=oParse.SelectList(editCol).LookupQuery\r
 213       oParse=new sqlParse()\r
 214       oParse.ParseSelect(sqlText)\r
 215       ApplyQStringParms()\r
 216       sqlText=oParse.UnparseSelect()\r
 217     elseif numrows < 0 or offset=0 then\r
 218       ApplyQStringParms()\r
 219       sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
 220     else\r
 221       ApplyQStringParms()\r
 222       select case dbDialect\r
 223         case "TSQL":\r
 224           if left(dbVersion,2) >= "09" then\r
 225             sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,true,HiddenCols)\r
 226             firstCol=1\r
 227             limitQuery=true\r
 228           else\r
 229             sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
 230           end if\r
 231         case "Oracle": \r
 232           sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,false,HiddenCols)\r
 233           firstCol=1\r
 234           limitQuery=true\r
 235         case "MySQL":\r
 236           sqlText=oParse.UnparseSelectSkip(HiddenCols) & " LIMIT " & offset & "," & CStr(numrows+1)\r
 237           limitQuery=true\r
 238         case else:\r
 239           sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
 240       end select  \r
 241     end if\r
 242   end if\r
 243   if IsNothing(sqlText) then Exit Function\r
 244   DebugMsgs.add(sqlText)\r
 245   DebugMsgs.add(dbClassName)\r
 246   DebugMsgs.add("DB version=" & dbVersion)\r
 247   command.CommandText = sqlText\r
 248   rdr = command.ExecuteReader()\r
 249 \r
 250   if limitQuery then\r
 251     totcnt=offset\r
 252   else\r
 253     while (totcnt < offset) and (not eof)\r
 254       if rdr.Read() then\r
 255         totcnt += 1\r
 256       else\r
 257         eof=true\r
 258       end if\r
 259     end while\r
 260   end if\r
 261 \r
 262   rowcnt=0\r
 263   if numrows < 0 then numrows=AllRowsMax\r
 264   select case fmt\r
 265 \r
 266     case "json":\r
 267       if SendHdg then\r
 268         writer.Write(vbLf & "[")\r
 269         for fldNum=firstCol to rdr.FieldCount -1\r
 270           if IsNothing(oParse) then\r
 271             n=Nothing\r
 272           else\r
 273             n=oParse.Headings(fldNum-firstCol)\r
 274           end if\r
 275           if IsNothing(n) then n=rdr.GetName(fldNum)\r
 276           writer.Write("""" & escapeJSON(n) & """")\r
 277         next\r
 278         writer.Write("]")\r
 279       end if\r
 280       while (rowcnt < numrows) and (not eof)\r
 281         if rdr.Read() then\r
 282           if rowcnt > 0 or SendHdg then writer.Write(",")\r
 283           writer.Write(vbLf & "[")\r
 284           for fldNum = firstCol to rdr.FieldCount -1\r
 285             strFieldItem = ""\r
 286             if not rdr.IsDBNull(fldNum) then\r
 287               select case rdr.GetFieldType(fldNum).Name\r
 288                 case "DateTime":\r
 289                   dbDate=rdr.GetDateTime(fldNum)\r
 290                   strFieldItem = replace(dbDate.ToString("s"),"T"," ")  ' convert to ISO-8601 format\r
 291                 case else:\r
 292                   strFieldItem = escapeJSON(rdr.GetValue(fldNum))\r
 293               end select\r
 294             end if\r
 295             if fldNum > firstCol then writer.Write(",")\r
 296             writer.Write("""" & strFieldItem & """")\r
 297           next\r
 298           writer.Write("]")\r
 299           rowcnt += 1\r
 300         else\r
 301           eof=true\r
 302         end if\r
 303       end while\r
 304 \r
 305     case "xl":\r
 306       writer.Write(vbLf & "<s:Row>")\r
 307       for fldNum=firstCol to rdr.FieldCount-1\r
 308         if IsNothing(oParse) then\r
 309           n=Nothing\r
 310         else\r
 311           n=oParse.Headings(fldNum-firstCol)\r
 312         end if\r
 313         if IsNothing(n) then n=rdr.GetName(fldNum)\r
 314         writer.Write("<s:Cell><s:Data s:Type='String'>" & server.HTMLEncode(n) & "</s:Data></s:Cell>")\r
 315       next\r
 316       writer.Write("</s:Row>")\r
 317       while (rowcnt < numrows) and (not eof)\r
 318         if rdr.Read() then\r
 319           rowcnt += 1\r
 320           writer.Write("<s:Row>")\r
 321           for fldNum = firstCol to rdr.FieldCount -1\r
 322             strFieldItem = ""\r
 323             fldAttr = ""\r
 324             fldType = "String"\r
 325             if not rdr.IsDBNull(fldNum) then\r
 326               select case UCase(Left(rdr.GetFieldType(fldNum).Name, 3))\r
 327                 case "DAT":\r
 328                   dbDate=rdr.GetDateTime(fldNum)\r
 329                   strFieldItem = dbDate.ToString("s")  ' convert to ISO-8601 format\r
 330                   fldType = "DateTime"\r
 331                   fldAttr = " s:StyleID='sDate'"\r
 332                 case "INT", "DOU", "DEC":\r
 333                   strFieldItem = CStr(rdr.GetValue(fldNum))\r
 334                   fldType = "Number"\r
 335                 case else:\r
 336                   strFieldItem = server.HTMLEncode(rdr.GetValue(fldNum))\r
 337               end select\r
 338             end if\r
 339             writer.Write("<s:Cell" & fldAttr & "><s:Data s:Type='" & fldType & "'>" & strFieldItem & "</s:Data></s:Cell>")\r
 340           next\r
 341           writer.Write("</s:Row>")\r
 342         else\r
 343           eof=true\r
 344         end if\r
 345       end while\r
 346 \r
 347     case else:\r
 348       if SendHdg then\r
 349         writer.Write(vbLf & "<tr>")\r
 350         for fldNum=firstCol to rdr.FieldCount -1\r
 351           if IsNothing(oParse) then\r
 352             n=Nothing\r
 353           else\r
 354             n=oParse.Headings(fldNum-firstCol)\r
 355           end if\r
 356           if IsNothing(n) then n=rdr.GetName(fldNum)\r
 357           writer.Write("<td>" & server.HTMLEncode(n) & "</td>")\r
 358         next\r
 359         writer.Write("</tr>")\r
 360       end if\r
 361       while (rowcnt < numrows) and (not eof)\r
 362         if rdr.Read() then\r
 363           rowcnt += 1\r
 364           writer.Write("<tr>")\r
 365           for fldNum = firstCol to rdr.FieldCount -1\r
 366             strFieldItem = ""\r
 367             if not rdr.IsDBNull(fldNum) then\r
 368               select case rdr.GetFieldType(fldNum).Name\r
 369                 case "DateTime":\r
 370                   dbDate=rdr.GetDateTime(fldNum)\r
 371                   strFieldItem = replace(dbDate.ToString("s"),"T"," ")  ' convert to ISO-8601 format\r
 372                 case else:\r
 373                   strFieldItem = server.HTMLEncode(rdr.GetValue(fldNum))\r
 374               end select\r
 375             end if\r
 376             writer.Write("<td>" & strFieldItem & "</td>")\r
 377           next\r
 378           writer.Write("</tr>")\r
 379         else\r
 380           eof=true\r
 381         end if\r
 382       end while\r
 383   end select\r
 384   totcnt += rowcnt\r
 385 \r
 386   if not eof and gettotal then\r
 387     if limitQuery then\r
 388       rdr.Close()\r
 389       dim countSql,cnt\r
 390       countSql="SELECT " & oParse.UnparseColumnList() & " FROM " & oParse.FromClause\r
 391       if not IsNothing(oParse.WhereClause) then countSql &= " WHERE " & oParse.WhereClause\r
 392       if oParse.GroupBy.count > 0 then countSql &= " GROUP BY " & join(oParse.GroupBy.ToArray(),",")\r
 393       if not IsNothing(oParse.HavingClause) then countSql &= " HAVING " & oParse.HavingClause\r
 394       countSql="SELECT COUNT(*) FROM (" & countSql & ")"\r
 395       if dbDialect<>"Oracle" then countSql &= " AS rico_Main"\r
 396       DebugMsgs.add(countSql)\r
 397       command.CommandText = countSql\r
 398       totcnt = command.ExecuteScalar()\r
 399       eof=true\r
 400     else\r
 401       while rdr.Read()\r
 402         totcnt += 1\r
 403       end while\r
 404       eof=true\r
 405     end if\r
 406   end if\r
 407   if eof then RenderQueryRows=totcnt\r
 408   rdr.Close()\r
 409 End Function\r
 410 \r
 411 \r
 412 ' returns the parameter symbol to insert into the sql string\r
 413 Private Function PushParam(ByVal newvalue) as String\r
 414   dim ParamName as String\r
 415   newvalue=cstr(newvalue)\r
 416   if newvalue="" then newvalue=" "  ' empty string gets converted to TEXT data type instead of VARCHAR\r
 417   select case dbClassName\r
 418     case "SqlConnection":\r
 419       ParamName="@P" & CStr(command.parameters.count)\r
 420       PushParam=ParamName\r
 421     case else:\r
 422       ParamName=""\r
 423       PushParam="?"\r
 424   end select\r
 425   command.parameters.add(ParamName,newvalue)\r
 426   DebugMsgs.add("Param " & ParamName & " value=" & newvalue)\r
 427 End Function\r
 428 \r
 429 \r
 430 ' assumes oParse is already initialized\r
 431 Private sub ApplyQStringParms()\r
 432   dim i, a, flen\r
 433   dim j as Integer, fop as String, ParamSymbol as String\r
 434   dim newfilter as string, qs as string, value as string\r
 435 \r
 436   for each qs in Request.QueryString\r
 437     select case left(qs,1)\r
 438       \r
 439       ' user-invoked condition\r
 440       case "w","h":\r
 441         i=mid(qs,2)\r
 442         if IsNumeric(i) then\r
 443           i=CInt(i)\r
 444           if i<0 or i>=filters.Count then exit for\r
 445           value=Request.QueryString(qs)\r
 446           newfilter=filters(i)\r
 447           j=InStr(1,newfilter," in (?)",1)\r
 448           if j>0 then\r
 449             a=split(value,",")\r
 450             for i=0 to ubound(a)\r
 451               ParamSymbol=PushParam(a(i))\r
 452               a(i)=ParamSymbol\r
 453             next\r
 454             newfilter=left(newfilter,j+4) & join(a,",") & mid(newfilter,j+6)\r
 455           elseif InStr(newfilter,"?")>0 then\r
 456             ParamSymbol=PushParam(value)\r
 457             if ParamSymbol<>"?" then newfilter=replace(newfilter,"?",ParamSymbol)\r
 458           end if\r
 459           if left(qs,1)="h" then\r
 460             oParse.AddHavingCondition(newfilter)\r
 461           else\r
 462             oParse.AddWhereCondition(newfilter)\r
 463           end if\r
 464         end if\r
 465       \r
 466       ' sort\r
 467       case "s":\r
 468         i=mid(qs,2)\r
 469         if not IsNumeric(i) then exit for\r
 470         i=CInt(i)\r
 471         if i<0 or i>=oParse.SelectList.count then exit for\r
 472         value=ucase(left(Request.QueryString(qs),4))\r
 473         if value<>"ASC" and value<>"DESC" then value="ASC"\r
 474         if orderByRef then\r
 475           oParse.AddSort(CStr(i+1) & " " & value)\r
 476         else\r
 477           oParse.AddSort(oParse.SelectList(i).sql & " " & value)\r
 478         end if\r
 479       \r
 480       ' user-supplied filter\r
 481       case "f":\r
 482         a=split(qs,"[")\r
 483         if ubound(a)=2 then\r
 484           if a(2)="op]" then\r
 485             i=left(a(1),len(a(1))-1)\r
 486             if not IsNumeric(i) then exit for\r
 487             if len(i)>3 then exit for\r
 488             i=CInt(i)\r
 489             if i<0 or i>oParse.SelectList.count then exit for\r
 490             fop=Request.QueryString(qs)\r
 491             newfilter=oParse.SelectList(i).sql\r
 492             select case fop\r
 493               case "EQ":\r
 494                 newfilter = "(" & AddCoalesce(newfilter) & " IN " & GetMultiParmFilter(qs) & ")"\r
 495               case "LE":\r
 496                 newfilter &= "<=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))\r
 497               case "GE":\r
 498                 newfilter &= ">=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))\r
 499               case "NULL": newfilter &= " is null"\r
 500               case "NOTNULL": newfilter &= " is not null"\r
 501               case "LIKE":\r
 502                 newfilter &= " LIKE " & PushParam(replace(Request.QueryString(replace(qs,"[op]","[0]")),"*",Wildcard))\r
 503               case "NE"\r
 504                 newfilter = "(" & AddCoalesce(newfilter) & " NOT IN " & GetMultiParmFilter(qs) & ")"\r
 505             end select\r
 506             dim sql=oParse.SelectList(i).sql\r
 507             if (InStr(sql,"min(")>0 or _\r
 508                InStr(sql,"max(")>0 or _\r
 509                InStr(sql,"sum(")>0 or _\r
 510                InStr(sql,"count(")>0) and _\r
 511                InStr(sql,"(select ")<1 then\r
 512               oParse.AddHavingCondition(newfilter)\r
 513             else\r
 514               oParse.AddWhereCondition(newfilter)\r
 515             end if\r
 516           end if\r
 517         end if\r
 518     end select\r
 519   next\r
 520 end sub\r
 521 \r
 522 \r
 523 Private function AddCoalesce(newfilter as String) as String\r
 524   if dbDialect="Access" then\r
 525     newfilter="iif(IsNull(" & newfilter & "),''," & newfilter & ")"\r
 526   else\r
 527     newfilter="coalesce(" & newfilter & ",'')"\r
 528   end if\r
 529   AddCoalesce=newfilter\r
 530 end function\r
 531 \r
 532 \r
 533 Private function GetMultiParmFilter(qs as String) as String\r
 534   dim flenStr as String = Request.QueryString(replace(qs,"[op]","[len]"))\r
 535   if not IsNumeric(flenStr) then exit function\r
 536   dim flen as Integer = CInt(flenStr)\r
 537   dim j as Integer, param as String, filter as String = ""\r
 538   for j=0 to flen-1\r
 539     if j>0 then filter &= ","\r
 540     param=Request.QueryString(replace(qs,"[op]","[" & j & "]"))\r
 541     filter &= PushParam(param)\r
 542   next\r
 543   GetMultiParmFilter = "(" & filter & ")"\r
 544 end function\r
 545 \r
 546 \r
 547 Public function XmlStringCell(value as object) as String\r
 548   dim result\r
 549   if IsDBNull(value) then result="" else result=server.HTMLEncode(value)\r
 550   XmlStringCell="<td>" & result & "</td>"\r
 551 end function\r
 552 \r
 553 \r
 554 ' for the root node, parentID should "" (empty string)\r
 555 ' containerORleaf: L/zero (leaf), C/non-zero (container)\r
 556 ' selectable:      0->not selectable, 1->selectable\r
 557 Public function WriteTreeRow(parentID,ID,description,containerORleaf,selectable)\r
 558   HeaderRows.Add(TreeRow(parentID,ID,description,containerORleaf,selectable))\r
 559 end function\r
 560 \r
 561 Public function TreeRow(parentID,ID,description,containerORleaf,selectable)\r
 562   TreeRow="<tr>" & XmlStringCell(parentID) & XmlStringCell(ID) & XmlStringCell(description) & XmlStringCell(containerORleaf) & XmlStringCell(selectable) & "</tr>"\r
 563 end function\r
 564 \r
 565 '******************************************************************************************\r
 566 '' @SDESCRIPTION:   takes a given string and makes it JSON valid (http://json.org/)\r
 567 '' @AUTHOR: Michael Rebec\r
 568 '' @DESCRIPTION:    all characters which needs to be escaped are beeing replaced by their\r
 569 ''          unicode representation according to the\r
 570 ''          RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627\r
 571 '' @PARAM:      val [string]: value which should be escaped\r
 572 '' @RETURN:   [string] JSON valid string\r
 573 '******************************************************************************************\r
 574 public function escapeJSON(val)\r
 575     const cDoubleQuote = &h22\r
 576     const cRevSolidus = &h5C\r
 577     const cSolidus = &h2F\r
 578     dim i as integer, currentDigit as string\r
 579 \r
 580     for i = 1 to (len(val))\r
 581         currentDigit = mid(val, i, 1)\r
 582         if asc(currentDigit)> &h00 and asc(currentDigit) <&h1F then\r
 583             currentDigit = escapeJSONSquence(currentDigit)\r
 584         elseif asc(currentDigit)>= &hC280 and asc(currentDigit) <= &hC2BF then\r
 585             currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC200), 2, 0), 2)\r
 586         elseif asc(currentDigit)>= &hC380 and asc(currentDigit) <= &hC3BF then\r
 587             currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC2C0), 2, 0), 2)\r
 588         else\r
 589             select case asc(currentDigit)\r
 590                 case cDoubleQuote: currentDigit = escapeJSONSquence(currentDigit)\r
 591                 case cRevSolidus: currentDigit = escapeJSONSquence(currentDigit)\r
 592                 case cSolidus: currentDigit = escapeJSONSquence(currentDigit)\r
 593             end select\r
 594         end if\r
 595         escapeJSON = escapeJSON & currentDigit\r
 596     next\r
 597 end function\r
 598  \r
 599 function escapeJSONSquence(digit)\r
 600     escapeJSONSquence = "\u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)\r
 601 end function \r
 602  \r
 603 function padLeft(value, totalLength, paddingChar)\r
 604     padLeft = right(clone(paddingChar, totalLength) & value, totalLength)\r
 605 end function\r
 606  \r
 607 public function clone(byVal str, n)\r
 608     dim i as integer\r
 609     for i = 1 to n : clone = clone & str : next\r
 610 end function\r
 611 \r
 612 </script>\r