git.infodrom.org Git - infodrom/rico3/blob - plugins/asp/ricoResponse.vbs

   1 <%\r
   2 \r
   3 class ricoXmlResponse\r
   4 \r
   5 Public orderByRef      ' use column numbers in order by clause? (true/false)\r
   6 Public sendDebugMsgs   ' send details of sql parsing/execution in ajax response? (true/false)\r
   7 Public AllRowsMax      ' max # of rows to send if numrows=-1\r
   8 Public fmt             ' xml, json, html, xl\r
   9 Private objDB,eof,oParse,sqltext,arParams,RowsStart,RowsEnd,SendHdg,Headings,HiddenCols,arDebugMsgs\r
  10 \r
  11 \r
  12 Private Sub Class_Initialize\r
  13   orderByRef=false\r
  14   if IsObject(oDB) then\r
  15     set objDB=oDB  ' use oDB global as database connection, if it exists\r
  16     if objDB.Dialect="Access" or objDB.Dialect="MySQL" then orderByRef=true\r
  17   end if\r
  18   sendDebugMsgs=false\r
  19   SendHdg=false\r
  20   AllRowsMax=1999\r
  21   HiddenCols=Array()\r
  22   redim arParams(-1)\r
  23   redim arDebugMsgs(-1)\r
  24 end sub\r
  25 \r
  26 \r
  27 Public Sub ProcessQuery(id,sqlselect,filters)\r
  28   dim offset,size,total,distinctCol,editCol,closetags,hidden,i,j,u,skip,SkipIdx\r
  29 \r
  30   fmt=trim(Request.QueryString("_fmt"))\r
  31   offset=trim(Request.QueryString("offset"))\r
  32   size=trim(Request.QueryString("page_size"))\r
  33   total=lcase(Request.QueryString("get_total"))\r
  34   distinctCol=trim(Request.QueryString("distinct"))\r
  35   hidden=trim(Request.QueryString("hidden"))\r
  36   editCol=trim(Request.QueryString("edit"))\r
  37   if offset="" then offset="0"\r
  38   if total="" then total="false"\r
  39   if hidden<>"" then HiddenCols=split(hidden,",")\r
  40 \r
  41   Response.clear\r
  42   if fmt<>"xl" then\r
  43     Response.CacheControl = "no-cache"\r
  44     Response.AddHeader "Pragma", "no-cache"\r
  45     Response.Expires = -1\r
  46   end if\r
  47   select case fmt\r
  48     case "html":\r
  49       Response.ContentType="text/html"\r
  50       Response.write "<html><head></head><body>" & vbLf\r
  51       closetags="</body></html>"\r
  52       RowsStart=vbLf & "<table border='1'>"\r
  53       RowsEnd=vbLf & "</table>"\r
  54       total="false"\r
  55       sendDebugMsgs=false\r
  56       SendHdg=true\r
  57     case "xl":\r
  58       Response.ContentType="application/vnd.ms-excel"\r
  59       Response.write "<html><head></head><body>" & vbLf\r
  60       closetags="</body></html>"\r
  61       RowsStart=vbLf & "<table>"\r
  62       RowsEnd=vbLf & "</table>"\r
  63       total="false"\r
  64       sendDebugMsgs=false\r
  65       SendHdg=true\r
  66     case "json":\r
  67       Response.ContentType="application/json"\r
  68       Response.write "{" & vbLf & """id"":""" & id & """"\r
  69       RowsStart="," & vbLf & """update_ui"":true," & vbLf & """offset"":" & offset & "," & vbLf & """rows"":["\r
  70       RowsEnd=vbLf & "]"\r
  71       closetags="}"\r
  72     case else:\r
  73       ' default to xml\r
  74       fmt="xml"\r
  75       Response.ContentType="text/xml"\r
  76       Response.write "<?xml version='1.0' encoding='iso-8859-1'?>"\r
  77       response.write vbLf & "<ajax-response><response type='object' id='" & id & "'>"\r
  78       closetags="</response></ajax-response>"\r
  79       RowsStart=vbLf & "<rows update_ui='true' offset='" & offset & "'>"\r
  80       RowsEnd=vbLf & "</rows>"\r
  81   end select\r
  82 \r
  83   if id="" then\r
  84     ErrorResponse "No ID provided!"\r
  85   elseif distinctCol="" and not IsNumeric(offset) then\r
  86     ErrorResponse "Invalid offset!"\r
  87   elseif distinctCol="" and not IsNumeric(size) then\r
  88     ErrorResponse "Invalid size!"\r
  89   elseif distinctCol<>"" and not IsNumeric(distinctCol) then\r
  90     ErrorResponse "Invalid distinct parameter!"\r
  91   else\r
  92     if SendHdg and isArray(sqlselect) then\r
  93       ' populate Headings from sqlselect(9) taking into account hidden columns\r
  94       u=ubound(sqlselect(9))\r
  95       redim Headings(u)\r
  96       SkipIdx=0\r
  97       j=0\r
  98       for i=0 to u\r
  99         skip=false\r
 100         if SkipIdx <= ubound(HiddenCols) then\r
 101           skip=CBool(HiddenCols(SkipIdx)=CStr(i))\r
 102           if skip then SkipIdx=SkipIdx+1\r
 103         end if\r
 104         if not skip then\r
 105           Headings(j)=sqlselect(9)(i)\r
 106           j=j+1\r
 107         end if\r
 108       next\r
 109     end if\r
 110     objDB.DisplayErrors=false\r
 111     objDB.ErrMsgFmt="MULTILINE"\r
 112     if distinctCol<>"" and isNumeric(distinctCol) then\r
 113       Query2xmlDistinct sqlselect, CLng(distinctCol), 999, filters\r
 114     elseif editCol<>"" and isNumeric(editCol) and isArray(sqlselect) then\r
 115       Query2xml sqlselect(8)(CLng(editCol)),CLng(offset),CLng(size),(total<>"false"),filters\r
 116     else\r
 117       Query2xml sqlselect,CLng(offset),CLng(size),(total<>"false"),filters\r
 118     end if\r
 119     if not IsEmpty(objDB.LastErrorMsg) then\r
 120       ErrorResponse objDB.LastErrorMsg\r
 121     end if\r
 122   end if\r
 123   if sendDebugMsgs then AppendArrayResponse "debug", arDebugMsgs\r
 124   response.write vbLf & closetags\r
 125 end sub\r
 126 \r
 127 \r
 128 Private sub AddDebugMsg(ByVal msg)\r
 129   ReDim Preserve arDebugMsgs(ubound(arDebugMsgs)+1)\r
 130   arDebugMsgs(ubound(arDebugMsgs))=msg\r
 131 end sub\r
 132 \r
 133 \r
 134 Public Sub ErrorResponse(msg)\r
 135   AppendResponse "error",msg\r
 136 end sub\r
 137 \r
 138 \r
 139 Public Sub AppendResponse(tag,content)\r
 140   select case fmt\r
 141     case "html", "xl":\r
 142       response.write vbLf & "<p>" & tag & "<br>" & server.htmlencode(content) & "</p>"\r
 143     case "json":\r
 144       response.write "," & vbLf & """" & tag & """:""" & escapeJSON(content) & """"\r
 145     case "xml":\r
 146       'response.write vbLf & "<" & tag & ">" & content & "</" & tag & ">"\r
 147       response.write vbLf & "<" & tag & ">" & server.htmlencode(content) & "</" & tag & ">"\r
 148   end select\r
 149 end sub\r
 150 \r
 151 \r
 152 Public Sub AppendArrayResponse(tag, arContent)\r
 153   dim item,i\r
 154   select case fmt\r
 155     case "html", "xl":\r
 156       response.write vbLf & "<p>" & tag\r
 157       for each item in arContent\r
 158         response.write "<br>" & server.htmlencode(item)\r
 159       next\r
 160       response.write "</p>"\r
 161     case "json":\r
 162       response.write "," & vbLf & """" & tag & """:["\r
 163       for i=0 to ubound(arContent)\r
 164         if i > 0 then response.write ","\r
 165         response.write vbLf & """" & escapeJSON(arContent(i)) & """"\r
 166       next\r
 167       response.write "]"\r
 168     case "xml":\r
 169       for each item in arContent\r
 170         response.write vbLf & "<" & tag & ">" & server.htmlencode(item) & "</" & tag & ">"\r
 171       next\r
 172   end select\r
 173 end sub\r
 174 \r
 175 \r
 176 ' All Oracle and SQL Server 2005 queries *must* have an ORDER BY clause\r
 177 ' "as" clauses are now ok\r
 178 ' If numrows < 0, then retrieve all rows\r
 179 Public function Query2xml(sqlselect,offset,numrows,gettotal,filters)\r
 180   dim totcnt,version,Dialect\r
 181   set oParse=new sqlParse\r
 182   if IsArray(sqlselect) then\r
 183     oParse.LoadArray(sqlselect)\r
 184   else\r
 185     oParse.ParseSelect sqlselect\r
 186   end if\r
 187   ApplyQStringParms filters\r
 188   response.write RowsStart\r
 189   if numrows >= 0 then Dialect=objDB.Dialect else numrows=AllRowsMax\r
 190   select case Dialect\r
 191     case "TSQL":\r
 192       objDB.SingleRecordQuery "select @@VERSION",version\r
 193       if InStr(version,"SQL Server 2005") > 0 or InStr(version,"SQL Server 2008") > 0 then\r
 194         sqltext=UnparseWithRowNumber(offset,numrows+1,true)\r
 195         totcnt=Query2xmlRaw_Limit(sqltext,offset,numrows,1)\r
 196       else\r
 197         sqltext=oParse.UnparseSelectSkip(HiddenCols)\r
 198         totcnt=Query2xmlRaw_NoLimit(sqltext,offset,numrows,gettotal)\r
 199       end if\r
 200     case "Oracle": \r
 201       sqltext=UnparseWithRowNumber(offset,numrows+1,false)\r
 202       totcnt=Query2xmlRaw_Limit(sqltext,offset,numrows,1)\r
 203     case "MySQL":\r
 204       sqltext=oParse.UnparseSelectSkip(HiddenCols) & " LIMIT " & offset & "," & CStr(numrows+1)\r
 205       totcnt=Query2xmlRaw_Limit(sqltext,offset,numrows,0)\r
 206     case else:\r
 207       sqltext=oParse.UnparseSelectSkip(HiddenCols)\r
 208       totcnt=Query2xmlRaw_NoLimit(sqltext,offset,numrows,gettotal)\r
 209   end select  \r
 210   response.write RowsEnd\r
 211   if not eof and gettotal then totcnt=getTotalRowCount\r
 212   if fmt="xml" or fmt="json" then\r
 213     if eof then AppendResponse "rowcount",totcnt\r
 214   end if\r
 215   if sendDebugMsgs then AddDebugMsg sqltext\r
 216   Query2xml=totcnt\r
 217   set oParse=Nothing\r
 218 end function\r
 219 \r
 220 \r
 221 Public sub Query2xmlDistinct(ByVal sqlselect,colnum,maxrows,filters)\r
 222   set oParse=new sqlParse\r
 223   if IsArray(sqlselect) then\r
 224     oParse.LoadArray(sqlselect)\r
 225   else\r
 226     oParse.ParseSelect sqlselect\r
 227   end if\r
 228   if colnum<0 or colnum>ubound(oParse.arSelList) then\r
 229     objDB.LastErrorMsg="Invalid column number for distinct query"\r
 230     exit sub\r
 231   end if\r
 232   ApplyQStringParms filters\r
 233   sqltext=oParse.UnparseDistinctColumn(colnum)\r
 234   response.write RowsStart\r
 235   totcnt=Query2xmlRaw_NoLimit(sqltext,0,maxrows,false)\r
 236   response.write RowsEnd\r
 237   if sendDebugMsgs then AddDebugMsg sqltext\r
 238   set oParse=Nothing\r
 239 end sub\r
 240 \r
 241 \r
 242 ' Tested ok with SQL Server 2005, MySQL, and Oracle\r
 243 Private function getTotalRowCount()\r
 244   dim countSql,cnt\r
 245   countSql="SELECT " & oParse.UnparseColumnList & " FROM " & oParse.FromClause\r
 246   if not IsEmpty(oParse.WhereClause) then countSql=countSql & " WHERE " & oParse.WhereClause\r
 247   if IsArray(oParse.arGroupBy) then\r
 248     if UBound(oParse.arGroupBy)>=0 then countSql=countSql & " GROUP BY " & join(oParse.arGroupBy,",")\r
 249   end if\r
 250   if not IsEmpty(oParse.HavingClause) then countSql=countSql & " HAVING " & oParse.HavingClause\r
 251   countSql="SELECT COUNT(*) FROM (" & countSql & ")"\r
 252   if objDB.Dialect<>"Oracle" then countSql=countSql & " AS rico_Main"\r
 253   if sendDebugMsgs then AddDebugMsg countSql\r
 254   if ubound(arParams) >= 0 then\r
 255     set rsMain = objDB.RunParamQuery(countSql,arParams)\r
 256   else\r
 257     set rsMain = objDB.RunQuery(countSql)\r
 258   end if\r
 259   getTotalRowCount=rsMain.Fields(0).Value\r
 260   objDB.rsClose rsMain\r
 261   eof=true\r
 262 end Function\r
 263 \r
 264 \r
 265 Private function UnparseWithRowNumber(offset,numrows,includeAS)\r
 266   dim unparseText,strOrderBy\r
 267   if IsArray(oParse.arOrderBy) then\r
 268     if UBound(oParse.arOrderBy)>=0 then strOrderBy=join(oParse.arOrderBy,",")\r
 269   end If\r
 270   if IsEmpty(strOrderBy) then\r
 271     ' order by clause should be included in main sql select statement\r
 272     ' However, if it isn't, then use primary key as sort - assuming FromClause is a simple table name\r
 273     strOrderBy=objDB.PrimaryKey(oParse.FromClause)\r
 274   end if\r
 275   unparseText="SELECT ROW_NUMBER() OVER (ORDER BY " & strOrderBy & ") AS rico_rownum,"\r
 276   unparseText=unparseText & oParse.UnparseColumnListSkip(HiddenCols) & " FROM " & oParse.FromClause\r
 277   if not IsEmpty(oParse.WhereClause) then unparseText=unparseText & " WHERE " & oParse.WhereClause\r
 278   if IsArray(oParse.arGroupBy) then\r
 279     if UBound(oParse.arGroupBy)>=0 then unparseText=unparseText & " GROUP BY " & join(oParse.arGroupBy,",")\r
 280   end if\r
 281   if not IsEmpty(oParse.HavingClause) then unparseText=unparseText & " HAVING " & oParse.HavingClause\r
 282   unparseText="SELECT * FROM (" & unparseText & ")"\r
 283   if includeAS then unparseText=unparseText & " AS rico_Main"\r
 284   unparseText=unparseText & " WHERE rico_rownum > " & offset & " AND rico_rownum <= " & CStr(offset+numrows)\r
 285   UnparseWithRowNumber=unparseText\r
 286 end Function\r
 287 \r
 288 \r
 289 Public function Query2xmlRaw(ByVal rawsqltext, ByVal offset, ByVal numrows)\r
 290   Query2xmlRaw=Query2xmlRaw_NoLimit(rawsqltext,offset,numrows,true)\r
 291 end Function\r
 292 \r
 293 \r
 294 Public function Query2xmlRaw_NoLimit(ByVal rawsqltext, ByVal offset, ByVal numrows, ByVal gettotal)\r
 295   dim rsMain,totcnt\r
 296 \r
 297   if ubound(arParams) >= 0 then\r
 298     set rsMain = objDB.RunParamQuery(rawsqltext,arParams)\r
 299   else\r
 300     set rsMain = objDB.RunQuery(rawsqltext)\r
 301   end if\r
 302   totcnt=0\r
 303   eof=true\r
 304   if rsMain is Nothing then exit function\r
 305 \r
 306   while not rsMain.eof and totcnt<offset\r
 307     totcnt=totcnt+1\r
 308     rsMain.movenext\r
 309   wend\r
 310   select case fmt\r
 311     case "json":\r
 312       totcnt = totcnt + WriteRowsJSON(rsMain, numrows, 0)\r
 313     case else:\r
 314       totcnt = totcnt + WriteRowsXHTML(rsMain, numrows, 0)\r
 315   end select\r
 316   if gettotal then\r
 317     while not rsMain.eof\r
 318       totcnt=totcnt+1\r
 319       rsMain.movenext\r
 320     wend\r
 321   end if\r
 322   eof=rsMain.eof\r
 323 \r
 324   objDB.rsClose rsMain\r
 325   Query2xmlRaw_NoLimit=totcnt\r
 326 end function\r
 327 \r
 328 \r
 329 Public function Query2xmlRaw_Limit(ByVal rawsqltext,offset,numrows,firstcol)\r
 330   dim rsMain,totcnt\r
 331 \r
 332   if ubound(arParams) >= 0 then\r
 333     set rsMain = objDB.RunParamQuery(rawsqltext,arParams)\r
 334   else\r
 335     set rsMain = objDB.RunQuery(rawsqltext)\r
 336   end if\r
 337   totcnt=offset\r
 338   eof=true\r
 339   if rsMain is Nothing then exit function\r
 340   select case fmt\r
 341     case "json":\r
 342       totcnt = totcnt + WriteRowsJSON(rsMain, numrows, firstcol)\r
 343     case else:\r
 344       totcnt = totcnt + WriteRowsXHTML(rsMain, numrows, firstcol)\r
 345   end select\r
 346   eof=rsMain.eof\r
 347   objDB.rsClose rsMain\r
 348   Query2xmlRaw_Limit=totcnt\r
 349 end function\r
 350 \r
 351 \r
 352 Private Function WriteRowsXHTML(rsMain, ByVal numrows, ByVal firstcol)\r
 353   dim colcnt,rowcnt,i,n\r
 354   rowcnt=0\r
 355   colcnt=rsMain.fields.count\r
 356   on error resume next\r
 357   if SendHdg then\r
 358     response.write vbLf & "<tr>"\r
 359     for i=firstcol to colcnt-1\r
 360       n=rsMain.fields(i).name\r
 361       if isArray(Headings) then\r
 362         if not IsEmpty(Headings(i-firstcol)) then n=Headings(i-firstcol)\r
 363       end if \r
 364       response.write XmlStringCell(n)\r
 365     next\r
 366     response.write "</tr>"\r
 367   end if\r
 368   while not rsMain.eof and rowcnt<numrows\r
 369     rowcnt=rowcnt+1\r
 370     response.write vbLf & "<tr>"\r
 371     for i=firstcol to colcnt-1\r
 372       response.write XmlStringCell(FormatValue(rsMain.fields(i).value))\r
 373     next\r
 374     response.write "</tr>"\r
 375     rsMain.movenext\r
 376   wend\r
 377   WriteRowsXHTML=rowcnt\r
 378 end function\r
 379 \r
 380 \r
 381 Private Function WriteRowsJSON(rsMain, ByVal numrows, ByVal firstcol)\r
 382   dim colcnt,rowcnt,i\r
 383   rowcnt=0\r
 384   colcnt=rsMain.fields.count\r
 385   on error resume next\r
 386   if SendHdg=true then\r
 387     response.write vbLf & "["\r
 388     for i=firstcol to colcnt-1\r
 389       n=rsMain.fields(i).name\r
 390       if isArray(Headings) then\r
 391         if not IsEmpty(Headings(i-firstcol)) then n=Headings(i-firstcol)\r
 392       end if \r
 393       response.write """" & escapeJSON(n) & """"\r
 394     next\r
 395     response.write "]"\r
 396   end if\r
 397   while not rsMain.eof and rowcnt<numrows\r
 398     if rowcnt>0 or SendHdg then response.write ","\r
 399     rowcnt=rowcnt+1\r
 400     response.write vbLf & "["\r
 401     for i=firstcol to colcnt-1\r
 402       if i>firstcol then response.write ","\r
 403       response.write """" & escapeJSON(FormatValue(rsMain.fields(i).value)) & """"\r
 404     next\r
 405     response.write "]"\r
 406     rsMain.movenext\r
 407   wend\r
 408   WriteRowsJSON=rowcnt\r
 409 end function\r
 410 \r
 411 \r
 412 Private Function PadNumber(number, length)\r
 413         dim strNumber\r
 414         \r
 415         if IsNull(number) or IsEmpty(number) then strNumber=String(length,"-") else strNumber = Cstr(number)\r
 416         do while len(strNumber) < length\r
 417                 strNumber = "0" & strNumber\r
 418         loop\r
 419 \r
 420         PadNumber=strNumber\r
 421 End Function\r
 422 \r
 423 \r
 424 Private Function FormatValue(s)\r
 425   select case vartype(s)\r
 426     case 11\r
 427       FormatValue=lcase(s)      ' boolean\r
 428     case 7,133,134,135:\r
 429       FormatValue=year(s) & "-" & PadNumber(month(s),2) & "-" & PadNumber(day(s),2) & " " & PadNumber(hour(s),2) & ":" & PadNumber(minute(s),2) & ":" & PadNumber(second(s),2) ' date/time\r
 430     case else\r
 431       FormatValue=s\r
 432   end select\r
 433 End Function\r
 434 \r
 435 \r
 436 Public Sub SetDbConn(dbcls)\r
 437   set objDB=dbcls\r
 438 end Sub\r
 439 \r
 440 \r
 441 Private sub PushParam(ByVal newvalue)\r
 442   ReDim Preserve arParams(ubound(arParams)+1)\r
 443   newvalue=cstr(newvalue)\r
 444   if newvalue="" then newvalue=" "  ' empty string gets converted to TEXT data type instead of VARCHAR\r
 445   arParams(ubound(arParams))=newvalue\r
 446   if sendDebugMsgs then AddDebugMsg "Param " & ubound(arParams) & " type=" & typename(newvalue) & " value=" & newvalue\r
 447 end sub\r
 448 \r
 449 \r
 450 ' assumes oParse is already initialized\r
 451 Private sub ApplyQStringParms(filters)\r
 452   dim i,j,newfilter,qs,a,flen,fop,value,blank,param\r
 453 \r
 454   for each qs in Request.QueryString\r
 455     select case left(qs,1)\r
 456       \r
 457       ' user-invoked condition\r
 458       case "w","h":\r
 459         i=mid(qs,2)\r
 460         if IsNumeric(i) and isArray(filters) then\r
 461           i=CInt(i)\r
 462           if i<0 or i>ubound(filters) then exit for\r
 463           value=Request.QueryString(qs)\r
 464           newfilter=filters(i)\r
 465           j=InStr(1,newfilter," in (?)",1)\r
 466           if j>0 then\r
 467             a=split(value,",")\r
 468             for i=0 to ubound(a)\r
 469               PushParam a(i)\r
 470               a(i)="?"\r
 471             next\r
 472             newfilter=left(newfilter,j+4) & join(a,",") & mid(newfilter,j+6)\r
 473           elseif InStr(newfilter,"?")>0 then\r
 474             PushParam value\r
 475           end if\r
 476           if left(qs,1)="h" then\r
 477             oParse.AddHavingCondition newfilter\r
 478           else\r
 479             oParse.AddWhereCondition newfilter\r
 480           end if\r
 481         end if\r
 482       \r
 483       ' sort\r
 484       case "s":\r
 485         i=mid(qs,2)\r
 486         if not IsNumeric(i) then exit for\r
 487         i=CInt(i)\r
 488         if i<0 or i>ubound(oParse.arSelList) then exit for\r
 489         value=ucase(left(Request.QueryString(qs),4))\r
 490         if value<>"ASC" and value<>"DESC" then value="ASC"\r
 491         if orderByRef then\r
 492           oParse.AddSort CStr(i+1) & " " & value\r
 493         else\r
 494           oParse.AddSort oParse.arSelList(i) & " " & value\r
 495         end if\r
 496       \r
 497       ' user-supplied filter\r
 498       case "f":\r
 499         a=split(qs,"[")\r
 500         if ubound(a)=2 then\r
 501           if a(2)="op]" then\r
 502             i=left(a(1),len(a(1))-1)\r
 503             if not IsNumeric(i) then exit for\r
 504             if len(i)>3 then exit for\r
 505             i=CInt(i)\r
 506             if i<0 or i>ubound(oParse.arSelList) then exit for\r
 507             fop=Request.QueryString(qs)\r
 508             newfilter=oParse.arSelList(i)\r
 509             select case fop\r
 510               case "EQ":\r
 511                 newfilter = "(" & AddCoalesce(newfilter) & " IN " & GetMultiParmFilter(qs) & ")"\r
 512               case "LE":\r
 513                 newfilter=newfilter & "<=?"\r
 514                 PushParam Request.QueryString(replace(qs,"[op]","[0]"))\r
 515               case "GE":\r
 516                 newfilter=newfilter & ">=?"\r
 517                 PushParam Request.QueryString(replace(qs,"[op]","[0]"))\r
 518               case "NULL": newfilter=newfilter & " is null"\r
 519               case "NOTNULL": newfilter=newfilter & " is not null"\r
 520               case "LIKE":\r
 521                 newfilter=newfilter & " LIKE ?"\r
 522                 PushParam replace(Request.QueryString(replace(qs,"[op]","[0]")),"*",objDB.Wildcard)\r
 523               case "NE"\r
 524                 newfilter = "(" & AddCoalesce(newfilter) & " NOT IN " & GetMultiParmFilter(qs) & ")"\r
 525             end select\r
 526             if (InStr(oParse.arSelList(i),"min(")>0 or _\r
 527                InStr(oParse.arSelList(i),"max(")>0 or _\r
 528                InStr(oParse.arSelList(i),"sum(")>0 or _\r
 529                InStr(oParse.arSelList(i),"count(")>0) and _\r
 530                InStr(oParse.arSelList(i),"(select ")<1 then\r
 531               oParse.AddHavingCondition newfilter\r
 532             else\r
 533               oParse.AddWhereCondition newfilter\r
 534             end if\r
 535           end if\r
 536         end if\r
 537     end select\r
 538   next\r
 539 end sub\r
 540 \r
 541 \r
 542 Private function AddCoalesce(ByVal newfilter)\r
 543   if objDB.Dialect="Access" then\r
 544     newfilter="iif(IsNull(" & newfilter & "),''," & newfilter & ")"\r
 545   else\r
 546     newfilter="coalesce(" & newfilter & ",'')"\r
 547   end if\r
 548   AddCoalesce=newfilter\r
 549 end function\r
 550 \r
 551 \r
 552 Private function GetMultiParmFilter(ByVal qs)\r
 553   dim flen,j,param,filter\r
 554   flen = Request.QueryString(replace(qs,"[op]","[len]"))\r
 555   if not IsNumeric(flen) then exit function\r
 556   flen = CInt(flen)\r
 557   for j=0 to flen-1\r
 558     if j>0 then filter=filter & ","\r
 559     filter=filter & "?"\r
 560     param=Request.QueryString(replace(qs,"[op]","[" & j & "]"))\r
 561     PushParam param\r
 562   next\r
 563   GetMultiParmFilter = "(" & filter & ")"\r
 564 end function\r
 565 \r
 566 \r
 567 Public function XmlStringCell(value)\r
 568   dim result\r
 569   if IsNull(value) then result="" else result=server.HTMLEncode(value)\r
 570   if fmt="html" and result="" then result="&nbsp;"\r
 571   XmlStringCell="<td>" & result & "</td>"\r
 572 end function\r
 573 \r
 574 \r
 575 ' for the root node, parentID should "" (empty string)\r
 576 ' containerORleaf: L/zero (leaf), C/non-zero (container)\r
 577 ' selectable:      0->not selectable, 1->selectable\r
 578 Public sub WriteTreeRow(parentID,ID,description,containerORleaf,selectable)\r
 579   response.write vbLf & "<tr>"\r
 580   response.write XmlStringCell(parentID)\r
 581   response.write XmlStringCell(ID)\r
 582   response.write XmlStringCell(description)\r
 583   response.write XmlStringCell(containerORleaf)\r
 584   response.write XmlStringCell(selectable)\r
 585   response.write "</tr>"\r
 586 end sub\r
 587 \r
 588 \r
 589 '******************************************************************************************\r
 590 '' @SDESCRIPTION:   takes a given string and makes it JSON valid (http://json.org/)\r
 591 '' @AUTHOR: Michael Rebec\r
 592 '' @DESCRIPTION:    all characters which needs to be escaped are beeing replaced by their\r
 593 ''          unicode representation according to the\r
 594 ''          RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627\r
 595 '' @PARAM:      val [string]: value which should be escaped\r
 596 '' @RETURN:   [string] JSON valid string\r
 597 '******************************************************************************************\r
 598 public function escapeJSON(val)\r
 599     const cDoubleQuote = &h22\r
 600     const cRevSolidus = &h5C\r
 601     const cSolidus = &h2F\r
 602     dim i,currentDigit\r
 603 \r
 604     for i = 1 to (len(val))\r
 605         currentDigit = mid(val, i, 1)\r
 606         if asc(currentDigit)> &h00 and asc(currentDigit) <&h1F then\r
 607             currentDigit = escapeJSONSquence(currentDigit)\r
 608         elseif asc(currentDigit)>= &hC280 and asc(currentDigit) <= &hC2BF then\r
 609             currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC200), 2, 0), 2)\r
 610         elseif asc(currentDigit)>= &hC380 and asc(currentDigit) <= &hC3BF then\r
 611             currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC2C0), 2, 0), 2)\r
 612         else\r
 613             select case asc(currentDigit)\r
 614                 case cDoubleQuote: currentDigit = escapeJSONSquence(currentDigit)\r
 615                 case cRevSolidus: currentDigit = escapeJSONSquence(currentDigit)\r
 616                 case cSolidus: currentDigit = escapeJSONSquence(currentDigit)\r
 617             end select\r
 618         end if\r
 619         escapeJSON = escapeJSON & currentDigit\r
 620     next\r
 621 end function\r
 622  \r
 623 function escapeJSONSquence(digit)\r
 624     escapeJSONSquence = "\u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)\r
 625 end function \r
 626  \r
 627 function padLeft(value, totalLength, paddingChar)\r
 628     padLeft = right(clone(paddingChar, totalLength) & value, totalLength)\r
 629 end function\r
 630  \r
 631 public function clone(byVal str, n)\r
 632     dim i\r
 633     for i = 1 to n : clone = clone & str : next\r
 634 end function\r
 635 \r
 636 end class\r
 637 \r
 638 %>\r