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 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
  55 End Sub\r
  56 \r
  57 \r
  58 Protected Overrides Sub Render(writer as HTMLTextWriter)\r
  59   Me.RunQuery(writer)\r
  60 End Sub\r
  61 \r
  62 \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
  67 \r
  68   if not RenderFlag then exit sub\r
  69   Response.clear\r
  70   if fmt<>"xl" then\r
  71     Response.CacheControl = "no-cache"\r
  72     Response.AddHeader("Pragma", "no-cache")\r
  73     Response.Expires = -1\r
  74   end if\r
  75   select case fmt\r
  76     case "html":\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
  82       gettotal=false\r
  83       sendDebugMsgs=false\r
  84       SendHdg=true\r
  85     case "xl":\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
  91       gettotal=false\r
  92       sendDebugMsgs=false\r
  93       SendHdg=true\r
  94     case "json":\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
  98       RowsEnd=vbLf & "]"\r
  99       closetags="}"\r
 100     case else:\r
 101       ' default to xml\r
 102       fmt="xml"\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
 109   end select\r
 110 \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
 115   end if\r
 116 \r
 117   if not IsNothing(ErrorMsg) then\r
 118     ErrorResponse(writer, ErrorMsg)\r
 119   else\r
 120 \r
 121     writer.WriteLine(RowsStart)\r
 122     try\r
 123       writer.WriteLine(join(HeaderRows.ToArray(),vbLf))\r
 124       if not IsNothing(dbConnection) then\r
 125         SqlRows=RenderQueryRows(writer)\r
 126       end if\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
 131       end if\r
 132       if sendDebugMsgs then\r
 133         AppendArrayResponse(writer, "debug", DebugMsgs.ToArray())\r
 134       end if\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
 140     end try\r
 141   end if\r
 142   writer.WriteLine(closetags)\r
 143 End Sub\r
 144 \r
 145 \r
 146 Public Sub ErrorResponse(writer as HTMLTextWriter, msg as string)\r
 147   AppendResponse(writer,"error",msg)\r
 148 end sub\r
 149 \r
 150 \r
 151 Public Sub AppendResponse(writer as HTMLTextWriter, tag as string, content as string)\r
 152   select case fmt\r
 153     case "html", "xl":\r
 154       writer.write(vbLf & "<p>" & tag & "<br>" & server.htmlencode(content) & "</p>")\r
 155     case "json":\r
 156       writer.write("," & vbLf & """" & tag & """:""" & escapeJSON(content) & """")\r
 157     case "xml":\r
 158       writer.write(vbLf & "<" & tag & ">" & server.htmlencode(content) & "</" & tag & ">")\r
 159   end select\r
 160 end sub\r
 161 \r
 162 \r
 163 Public Sub AppendArrayResponse(writer as HTMLTextWriter, tag as string, arContent as object())\r
 164   dim item as string, i as integer\r
 165   select case fmt\r
 166     case "html", "xl":\r
 167       writer.write(vbLf & "<p>" & tag)\r
 168       for each item in arContent\r
 169         writer.write("<br>" & server.htmlencode(item))\r
 170       next\r
 171       writer.write("</p>")\r
 172     case "json":\r
 173       writer.write("," & vbLf & """" & tag & """:[")\r
 174       for i=0 to arContent.Length-1\r
 175         arContent(i)="""" & escapeJSON(arContent(i)) & """"\r
 176       next\r
 177       writer.write(join(arContent,",") & "]")\r
 178     case "xml":\r
 179       for each item in arContent\r
 180         writer.write(vbLf & "<" & tag & ">" & server.htmlencode(item) & "</" & tag & ">")\r
 181       next\r
 182   end select\r
 183 end sub\r
 184 \r
 185 \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
 190   dim rdr as object\r
 191   dim totcnt as Integer=0\r
 192 \r
 193   RenderQueryRows=-1\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
 210     else\r
 211       ApplyQStringParms()\r
 212       select case dbDialect\r
 213         case "TSQL":\r
 214           if left(dbVersion,2) >= "09" then\r
 215             sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,true,HiddenCols)\r
 216             firstCol=1\r
 217             limitQuery=true\r
 218           else\r
 219             sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
 220           end if\r
 221         case "Oracle": \r
 222           sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,false,HiddenCols)\r
 223           firstCol=1\r
 224           limitQuery=true\r
 225         case "MySQL":\r
 226           sqlText=oParse.UnparseSelectSkip(HiddenCols) & " LIMIT " & offset & "," & CStr(numrows+1)\r
 227           limitQuery=true\r
 228         case else:\r
 229           sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
 230       end select  \r
 231     end if\r
 232   end if\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
 239 \r
 240   if limitQuery then\r
 241     totcnt=offset\r
 242   else\r
 243     while (totcnt < offset) and (not eof)\r
 244       if rdr.Read() then\r
 245         totcnt += 1\r
 246       else\r
 247         eof=true\r
 248       end if\r
 249     end while\r
 250   end if\r
 251 \r
 252   rowcnt=0\r
 253   if numrows < 0 then numrows=AllRowsMax\r
 254   if fmt="json" then\r
 255     if SendHdg then\r
 256       writer.Write(vbLf & "[")\r
 257       for fldNum=firstCol to rdr.FieldCount -1\r
 258         if IsNothing(oParse) then\r
 259           n=Nothing\r
 260         else\r
 261           n=oParse.Headings(fldNum-firstCol)\r
 262         end if\r
 263         if IsNothing(n) then n=rdr.GetName(fldNum)\r
 264         writer.Write("""" & escapeJSON(n) & """")\r
 265       next\r
 266       writer.Write("]")\r
 267     end if\r
 268     while (rowcnt < numrows) and (not eof)\r
 269       if rdr.Read() then\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
 273           strFieldItem = ""\r
 274           if not rdr.IsDBNull(fldNum) then\r
 275             select case rdr.GetFieldType(fldNum).Name\r
 276               case "DateTime":\r
 277                 dbDate=rdr.GetDateTime(fldNum)\r
 278                 strFieldItem = replace(dbDate.ToString("s"),"T"," ")  ' convert to ISO-8601 format\r
 279               case else:\r
 280                 strFieldItem = escapeJSON(rdr.GetValue(fldNum))\r
 281             end select\r
 282           end if\r
 283           if fldNum > firstCol then writer.Write(",")\r
 284           writer.Write("""" & strFieldItem & """")\r
 285         next\r
 286         writer.Write("]")\r
 287         rowcnt += 1\r
 288       else\r
 289         eof=true\r
 290       end if\r
 291     end while\r
 292   else\r
 293     if SendHdg then\r
 294       writer.Write(vbLf & "<tr>")\r
 295       for fldNum=firstCol to rdr.FieldCount -1\r
 296         if IsNothing(oParse) then\r
 297           n=Nothing\r
 298         else\r
 299           n=oParse.Headings(fldNum-firstCol)\r
 300         end if\r
 301         if IsNothing(n) then n=rdr.GetName(fldNum)\r
 302         writer.Write("<td>" & server.HTMLEncode(n) & "</td>")\r
 303       next\r
 304       writer.Write("</tr>")\r
 305     end if\r
 306     while (rowcnt < numrows) and (not eof)\r
 307       if rdr.Read() then\r
 308         rowcnt += 1\r
 309         writer.Write("<tr>")\r
 310         for fldNum = firstCol to rdr.FieldCount -1\r
 311           strFieldItem = ""\r
 312           if not rdr.IsDBNull(fldNum) then\r
 313             select case rdr.GetFieldType(fldNum).Name\r
 314               case "DateTime":\r
 315                 dbDate=rdr.GetDateTime(fldNum)\r
 316                 strFieldItem = replace(dbDate.ToString("s"),"T"," ")  ' convert to ISO-8601 format\r
 317               case else:\r
 318                 strFieldItem = server.HTMLEncode(rdr.GetValue(fldNum))\r
 319             end select\r
 320           end if\r
 321           writer.Write("<td>" & strFieldItem & "</td>")\r
 322         next\r
 323         writer.Write("</tr>")\r
 324       else\r
 325         eof=true\r
 326       end if\r
 327     end while\r
 328   end if\r
 329   totcnt += rowcnt\r
 330 \r
 331   if not eof and gettotal then\r
 332     if limitQuery then\r
 333       rdr.Close()\r
 334       dim countSql,cnt\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
 344       eof=true\r
 345     else\r
 346       while rdr.Read()\r
 347         totcnt += 1\r
 348       end while\r
 349       eof=true\r
 350     end if\r
 351   end if\r
 352   if eof then RenderQueryRows=totcnt\r
 353   rdr.Close()\r
 354 End Function\r
 355 \r
 356 \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
 366     case else:\r
 367       ParamName=""\r
 368       PushParam="?"\r
 369   end select\r
 370   command.parameters.add(ParamName,newvalue)\r
 371   DebugMsgs.add("Param " & ParamName & " value=" & newvalue)\r
 372 End Function\r
 373 \r
 374 \r
 375 ' assumes oParse is already initialized\r
 376 Private sub ApplyQStringParms()\r
 377   dim i, a, flen\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
 380 \r
 381   for each qs in Request.QueryString\r
 382     select case left(qs,1)\r
 383       \r
 384       ' user-invoked condition\r
 385       case "w","h":\r
 386         i=mid(qs,2)\r
 387         if IsNumeric(i) then\r
 388           i=CInt(i)\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
 393           if j>0 then\r
 394             a=split(value,",")\r
 395             for i=0 to ubound(a)\r
 396               ParamSymbol=PushParam(a(i))\r
 397               a(i)=ParamSymbol\r
 398             next\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
 403           end if\r
 404           if left(qs,1)="h" then\r
 405             oParse.AddHavingCondition(newfilter)\r
 406           else\r
 407             oParse.AddWhereCondition(newfilter)\r
 408           end if\r
 409         end if\r
 410       \r
 411       ' sort\r
 412       case "s":\r
 413         i=mid(qs,2)\r
 414         if not IsNumeric(i) then exit for\r
 415         i=CInt(i)\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
 419         if orderByRef then\r
 420           oParse.AddSort(CStr(i+1) & " " & value)\r
 421         else\r
 422           oParse.AddSort(oParse.SelectList(i).sql & " " & value)\r
 423         end if\r
 424       \r
 425       ' user-supplied filter\r
 426       case "f":\r
 427         a=split(qs,"[")\r
 428         if ubound(a)=2 then\r
 429           if a(2)="op]" 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
 433             i=CInt(i)\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
 437             select case fop\r
 438               case "EQ":\r
 439                 newfilter = "(" & AddCoalesce(newfilter) & " IN " & GetMultiParmFilter(qs) & ")"\r
 440               case "LE":\r
 441                 newfilter &= "<=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))\r
 442               case "GE":\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
 446               case "LIKE":\r
 447                 newfilter &= " LIKE " & PushParam(replace(Request.QueryString(replace(qs,"[op]","[0]")),"*",Wildcard))\r
 448               case "NE"\r
 449                 newfilter = "(" & AddCoalesce(newfilter) & " NOT IN " & GetMultiParmFilter(qs) & ")"\r
 450             end select\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
 458             else\r
 459               oParse.AddWhereCondition(newfilter)\r
 460             end if\r
 461           end if\r
 462         end if\r
 463     end select\r
 464   next\r
 465 end sub\r
 466 \r
 467 \r
 468 Private function AddCoalesce(newfilter as String) as String\r
 469   if dbDialect="Access" then\r
 470     newfilter="iif(IsNull(" & newfilter & "),''," & newfilter & ")"\r
 471   else\r
 472     newfilter="coalesce(" & newfilter & ",'')"\r
 473   end if\r
 474   AddCoalesce=newfilter\r
 475 end function\r
 476 \r
 477 \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
 483   for j=0 to flen-1\r
 484     if j>0 then filter &= ","\r
 485     param=Request.QueryString(replace(qs,"[op]","[" & j & "]"))\r
 486     filter &= PushParam(param)\r
 487   next\r
 488   GetMultiParmFilter = "(" & filter & ")"\r
 489 end function\r
 490 \r
 491 \r
 492 Public function XmlStringCell(value as object) as String\r
 493   dim result\r
 494   if IsDBNull(value) then result="" else result=server.HTMLEncode(value)\r
 495   XmlStringCell="<td>" & result & "</td>"\r
 496 end function\r
 497 \r
 498 \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
 504 end function\r
 505 \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
 508 end function\r
 509 \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
 524 \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
 533         else\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
 538             end select\r
 539         end if\r
 540         escapeJSON = escapeJSON & currentDigit\r
 541     next\r
 542 end function\r
 543  \r
 544 function escapeJSONSquence(digit)\r
 545     escapeJSONSquence = "\u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)\r
 546 end function \r
 547  \r
 548 function padLeft(value, totalLength, paddingChar)\r
 549     padLeft = right(clone(paddingChar, totalLength) & value, totalLength)\r
 550 end function\r
 551  \r
 552 public function clone(byVal str, n)\r
 553     dim i as integer\r
 554     for i = 1 to n : clone = clone & str : next\r
 555 end function\r
 556 \r
 557 </script>\r