+++ /dev/null
-<%@ Control Language="vb" debug="true" ClassName="ricoResponse" %>\r
-<%@ Register TagPrefix="Rico" TagName="sqlParse" Src="sqlParse.ascx" %>\r
-<%@ Import Namespace="System.Data" %>\r
-<script runat="server">\r
-\r
-Public dbConnection as object\r
-Public dbDialect as String\r
-Protected dbVersion as String\r
-Protected dbClassName as String\r
-Public RequestId as string \r
-Public offset as integer = 0\r
-Public numrows as integer = 1999\r
-Public AllRowsMax as integer = 1999 ' max # of rows to send if numrows=-1\r
-Public gettotal as Boolean = true\r
-Public distinctCol as integer = -1\r
-Public editCol as integer = -1\r
-Public Headings(-1) as string\r
-Public HiddenCols(-1) as string\r
-Public filters as ArrayList\r
-Public orderByRef = false ' use column numbers in order by clause? (true/false)\r
-Public Wildcard as String="%"\r
-Public oParse as object ' parsed sql select statement to execute\r
-Public sqlText as String ' sql query to execute (either oParse or sqlText must be set prior to rendering)\r
-Public ErrorMsg as String ' may contain the text of an error message that occurred outside this control prior to rendering\r
-Public HeaderRows as new ArrayList() ' data that will be inserted before the query results\r
-Public FooterRows as new ArrayList() ' data that will be appended after the query results\r
-Public fmt as string\r
-Public SendHdg as Boolean = false\r
-Public RenderFlag as Boolean = true\r
-Protected command as object\r
-\r
-' DEBUGGING CONTROL\r
-Public sendDebugMsgs as Boolean = false ' send details of sql parsing/execution in ajax response? (true/false)\r
-Public LogSqlOnError as Boolean = false ' include sql statement in results if an error occurs (true/false)\r
-Protected DebugMsgs as new ArrayList()\r
-\r
-\r
-Protected Sub Page_Init(Sender As object, e As EventArgs)\r
- RequestId = trim(Request.QueryString("id"))\r
- fmt = trim(Request.QueryString("_fmt"))\r
- dim sRequestOffset as string = trim(Request.QueryString("offset"))\r
- dim sRequestSize as string = trim(Request.QueryString("page_size"))\r
- dim sRequestTotal as string = lcase(Request.QueryString("get_total"))\r
- dim sDistinct as string = trim(Request.QueryString("distinct"))\r
- dim sEdit as string = trim(Request.QueryString("edit"))\r
- dim sHidden as string = trim(Request.QueryString("hidden"))\r
- if not IsNumeric(sRequestOffset) then sRequestOffset="0"\r
-\r
- if sRequestOffset<>"" then sRequestOffset=Regex.Replace( sRequestOffset, "[^0-9-]", "" )\r
- if sRequestOffset<>"" then offset=CLng(sRequestOffset)\r
- if sRequestSize<>"" then sRequestSize=Regex.Replace( sRequestSize, "[^0-9-]", "" )\r
- if sRequestSize<>"" then numrows=CLng(sRequestSize)\r
- if sDistinct<>"" then distinctCol=CLng(sDistinct)\r
- if sEdit<>"" then editCol=CLng(sEdit)\r
- if sHidden<>"" then HiddenCols=split(sHidden,",")\r
- gettotal=(sRequestTotal="true")\r
-End Sub\r
-\r
-\r
-Protected Overrides Sub Render(writer as HTMLTextWriter)\r
- Me.RunQuery(writer)\r
-End Sub\r
-\r
-\r
-'Protected Overrides Sub Render(writer as HTMLTextWriter)\r
-Public Sub RunQuery(writer as HTMLTextWriter)\r
- Dim SqlRows as integer=0\r
- dim closetags as string, RowsStart as string, RowsEnd as string\r
-\r
- if not RenderFlag then exit sub\r
- Response.clear\r
- if fmt<>"xl" then\r
- Response.CacheControl = "no-cache"\r
- Response.AddHeader("Pragma", "no-cache")\r
- Response.Expires = -1\r
- end if\r
- select case fmt\r
- case "html":\r
- Response.ContentType="text/html"\r
- writer.WriteLine("<html><head></head><body>")\r
- closetags="</body></html>"\r
- RowsStart=vbLf & "<table border='1'>"\r
- RowsEnd=vbLf & "</table>"\r
- gettotal=false\r
- sendDebugMsgs=false\r
- SendHdg=true\r
- case "xl":\r
- Response.ContentType="application/vnd.ms-excel"\r
- Response.AddHeader("Content-Disposition", "attachment; filename=" & RequestId & ".xml")\r
- writer.WriteLine("<?xml version='1.0' encoding='iso-8859-1'?>")\r
- writer.WriteLine("<?mso-application progid='Excel.Sheet'?>")\r
- 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
- writer.WriteLine(" <s:Styles>")\r
- writer.WriteLine(" <s:Style s:ID='sDate'><s:NumberFormat s:Format='Short Date' /></s:Style>")\r
- writer.WriteLine(" </s:Styles>")\r
- writer.WriteLine(" <s:Worksheet s:Name='" & RequestId & "'>")\r
- closetags="</s:Worksheet></s:Workbook>"\r
- RowsStart=vbLf & "<s:Table>"\r
- RowsEnd=vbLf & "</s:Table>"\r
-\r
- gettotal=false\r
- sendDebugMsgs=false\r
- AllRowsMax=65534 ' allow 1 row for heading\r
- case "json":\r
- Response.ContentType="application/json"\r
- writer.Write("{" & vbLf & """id"":""" & RequestId & """")\r
- RowsStart="," & vbLf & """update_ui"":true," & vbLf & """offset"":" & offset & "," & vbLf & """rows"":["\r
- RowsEnd=vbLf & "]"\r
- closetags="}"\r
- case else:\r
- ' default to xml\r
- fmt="xml"\r
- Response.ContentType="text/xml"\r
- writer.WriteLine("<?xml version='1.0' encoding='iso-8859-1'?>")\r
- writer.WriteLine("<ajax-response><response type='object' id='" & RequestId & "'>")\r
- closetags="</response></ajax-response>"\r
- RowsStart=vbLf & "<rows update_ui='true' offset='" & offset & "'>"\r
- RowsEnd=vbLf & "</rows>"\r
- end select\r
-\r
- if RequestId="" then\r
- ErrorMsg="No ID provided!"\r
- elseif IsNothing(dbConnection) and (not IsNothing(oParse) or not IsNothing(sqlText)) then\r
- ErrorMsg="No database connection"\r
- end if\r
-\r
- if not IsNothing(ErrorMsg) then\r
- ErrorResponse(writer, ErrorMsg)\r
- else\r
-\r
- writer.WriteLine(RowsStart)\r
- try\r
- writer.WriteLine(join(HeaderRows.ToArray(),vbLf))\r
- if not IsNothing(dbConnection) then\r
- SqlRows=RenderQueryRows(writer)\r
- end if\r
- writer.WriteLine(join(FooterRows.ToArray(),vbLf))\r
- writer.WriteLine(RowsEnd)\r
- if SqlRows >= 0 and (fmt="xml" or fmt="json") then\r
- AppendResponse(writer, "rowcount", CStr(SqlRows+HeaderRows.count+FooterRows.count))\r
- end if\r
- if sendDebugMsgs then\r
- AppendArrayResponse(writer, "debug", DebugMsgs.ToArray())\r
- end if\r
- Catch ex As Exception\r
- writer.WriteLine(RowsEnd)\r
- dim msg as string = ex.Message\r
- if LogSqlOnError AndAlso not IsNothing(sqlText) then msg &= " - " & sqlText\r
- ErrorResponse(writer, msg)\r
- end try\r
- end if\r
- writer.WriteLine(closetags)\r
-End Sub\r
-\r
-\r
-Public Sub ErrorResponse(writer as HTMLTextWriter, msg as string)\r
- AppendResponse(writer,"error",msg)\r
-end sub\r
-\r
-\r
-Public Sub AppendResponse(writer as HTMLTextWriter, tag as string, content as string)\r
- select case fmt\r
- case "html", "xl":\r
- writer.write(vbLf & "<p>" & tag & "<br>" & server.htmlencode(content) & "</p>")\r
- case "json":\r
- writer.write("," & vbLf & """" & tag & """:""" & escapeJSON(content) & """")\r
- case "xml":\r
- writer.write(vbLf & "<" & tag & ">" & server.htmlencode(content) & "</" & tag & ">")\r
- end select\r
-end sub\r
-\r
-\r
-Public Sub AppendArrayResponse(writer as HTMLTextWriter, tag as string, arContent as object())\r
- dim item as string, i as integer\r
- select case fmt\r
- case "html", "xl":\r
- writer.write(vbLf & "<p>" & tag)\r
- for each item in arContent\r
- writer.write("<br>" & server.htmlencode(item))\r
- next\r
- writer.write("</p>")\r
- case "json":\r
- writer.write("," & vbLf & """" & tag & """:[")\r
- for i=0 to arContent.Length-1\r
- arContent(i)="""" & escapeJSON(arContent(i)) & """"\r
- next\r
- writer.write(join(arContent,",") & "]")\r
- case "xml":\r
- for each item in arContent\r
- writer.write(vbLf & "<" & tag & ">" & server.htmlencode(item) & "</" & tag & ">")\r
- next\r
- end select\r
-end sub\r
-\r
-\r
-' returns the total number of rows produced by the query (or -1 if unknown)\r
-Protected Function RenderQueryRows(writer as HTMLTextWriter) As Integer\r
- dim rowcnt as integer, fldNum as integer, dbDate as DateTime, strFieldItem as String, fldType as String, fldAttr as String\r
- dim firstCol as Integer=0, limitQuery as Boolean=false, eof as Boolean=false, n as String\r
- dim rdr as object\r
- dim totcnt as Integer=0\r
-\r
- RenderQueryRows=-1\r
- dbVersion=dbConnection.ServerVersion\r
- dbClassName=TypeName(dbConnection)\r
- command = dbConnection.CreateCommand()\r
- if not IsNothing(oParse) then\r
- if distinctCol >= 0 then\r
- ApplyQStringParms()\r
- sqlText=oParse.UnparseDistinctColumn(distinctCol)\r
- elseif editCol >= 0 then\r
- sqlText=oParse.SelectList(editCol).LookupQuery\r
- oParse=new sqlParse()\r
- oParse.ParseSelect(sqlText)\r
- ApplyQStringParms()\r
- sqlText=oParse.UnparseSelect()\r
- elseif numrows < 0 or offset=0 then\r
- ApplyQStringParms()\r
- sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
- else\r
- ApplyQStringParms()\r
- select case dbDialect\r
- case "TSQL":\r
- if left(dbVersion,2) >= "09" then\r
- sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,true,HiddenCols)\r
- firstCol=1\r
- limitQuery=true\r
- else\r
- sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
- end if\r
- case "Oracle": \r
- sqlText=oParse.UnparseWithRowNumber(offset,numrows+1,false,HiddenCols)\r
- firstCol=1\r
- limitQuery=true\r
- case "MySQL":\r
- sqlText=oParse.UnparseSelectSkip(HiddenCols) & " LIMIT " & offset & "," & CStr(numrows+1)\r
- limitQuery=true\r
- case else:\r
- sqlText=oParse.UnparseSelectSkip(HiddenCols)\r
- end select \r
- end if\r
- end if\r
- if IsNothing(sqlText) then Exit Function\r
- DebugMsgs.add(sqlText)\r
- DebugMsgs.add(dbClassName)\r
- DebugMsgs.add("DB version=" & dbVersion)\r
- command.CommandText = sqlText\r
- rdr = command.ExecuteReader()\r
-\r
- if limitQuery then\r
- totcnt=offset\r
- else\r
- while (totcnt < offset) and (not eof)\r
- if rdr.Read() then\r
- totcnt += 1\r
- else\r
- eof=true\r
- end if\r
- end while\r
- end if\r
-\r
- rowcnt=0\r
- if numrows < 0 then numrows=AllRowsMax\r
- select case fmt\r
-\r
- case "json":\r
- if SendHdg then\r
- writer.Write(vbLf & "[")\r
- for fldNum=firstCol to rdr.FieldCount -1\r
- if IsNothing(oParse) then\r
- n=Nothing\r
- else\r
- n=oParse.Headings(fldNum-firstCol)\r
- end if\r
- if IsNothing(n) then n=rdr.GetName(fldNum)\r
- writer.Write("""" & escapeJSON(n) & """")\r
- next\r
- writer.Write("]")\r
- end if\r
- while (rowcnt < numrows) and (not eof)\r
- if rdr.Read() then\r
- if rowcnt > 0 or SendHdg then writer.Write(",")\r
- writer.Write(vbLf & "[")\r
- for fldNum = firstCol to rdr.FieldCount -1\r
- strFieldItem = ""\r
- if not rdr.IsDBNull(fldNum) then\r
- select case rdr.GetFieldType(fldNum).Name\r
- case "DateTime":\r
- dbDate=rdr.GetDateTime(fldNum)\r
- strFieldItem = replace(dbDate.ToString("s"),"T"," ") ' convert to ISO-8601 format\r
- case else:\r
- strFieldItem = escapeJSON(rdr.GetValue(fldNum))\r
- end select\r
- end if\r
- if fldNum > firstCol then writer.Write(",")\r
- writer.Write("""" & strFieldItem & """")\r
- next\r
- writer.Write("]")\r
- rowcnt += 1\r
- else\r
- eof=true\r
- end if\r
- end while\r
-\r
- case "xl":\r
- writer.Write(vbLf & "<s:Row>")\r
- for fldNum=firstCol to rdr.FieldCount-1\r
- if IsNothing(oParse) then\r
- n=Nothing\r
- else\r
- n=oParse.Headings(fldNum-firstCol)\r
- end if\r
- if IsNothing(n) then n=rdr.GetName(fldNum)\r
- writer.Write("<s:Cell><s:Data s:Type='String'>" & server.HTMLEncode(n) & "</s:Data></s:Cell>")\r
- next\r
- writer.Write("</s:Row>")\r
- while (rowcnt < numrows) and (not eof)\r
- if rdr.Read() then\r
- rowcnt += 1\r
- writer.Write("<s:Row>")\r
- for fldNum = firstCol to rdr.FieldCount -1\r
- strFieldItem = ""\r
- fldAttr = ""\r
- fldType = "String"\r
- if not rdr.IsDBNull(fldNum) then\r
- select case UCase(Left(rdr.GetFieldType(fldNum).Name, 3))\r
- case "DAT":\r
- dbDate=rdr.GetDateTime(fldNum)\r
- strFieldItem = dbDate.ToString("s") ' convert to ISO-8601 format\r
- fldType = "DateTime"\r
- fldAttr = " s:StyleID='sDate'"\r
- case "INT", "DOU", "DEC":\r
- strFieldItem = CStr(rdr.GetValue(fldNum))\r
- fldType = "Number"\r
- case else:\r
- strFieldItem = server.HTMLEncode(rdr.GetValue(fldNum))\r
- end select\r
- end if\r
- writer.Write("<s:Cell" & fldAttr & "><s:Data s:Type='" & fldType & "'>" & strFieldItem & "</s:Data></s:Cell>")\r
- next\r
- writer.Write("</s:Row>")\r
- else\r
- eof=true\r
- end if\r
- end while\r
-\r
- case else:\r
- if SendHdg then\r
- writer.Write(vbLf & "<tr>")\r
- for fldNum=firstCol to rdr.FieldCount -1\r
- if IsNothing(oParse) then\r
- n=Nothing\r
- else\r
- n=oParse.Headings(fldNum-firstCol)\r
- end if\r
- if IsNothing(n) then n=rdr.GetName(fldNum)\r
- writer.Write("<td>" & server.HTMLEncode(n) & "</td>")\r
- next\r
- writer.Write("</tr>")\r
- end if\r
- while (rowcnt < numrows) and (not eof)\r
- if rdr.Read() then\r
- rowcnt += 1\r
- writer.Write("<tr>")\r
- for fldNum = firstCol to rdr.FieldCount -1\r
- strFieldItem = ""\r
- if not rdr.IsDBNull(fldNum) then\r
- select case rdr.GetFieldType(fldNum).Name\r
- case "DateTime":\r
- dbDate=rdr.GetDateTime(fldNum)\r
- strFieldItem = replace(dbDate.ToString("s"),"T"," ") ' convert to ISO-8601 format\r
- case else:\r
- strFieldItem = server.HTMLEncode(rdr.GetValue(fldNum))\r
- end select\r
- end if\r
- writer.Write("<td>" & strFieldItem & "</td>")\r
- next\r
- writer.Write("</tr>")\r
- else\r
- eof=true\r
- end if\r
- end while\r
- end select\r
- totcnt += rowcnt\r
-\r
- if not eof and gettotal then\r
- if limitQuery then\r
- rdr.Close()\r
- dim countSql,cnt\r
- countSql="SELECT " & oParse.UnparseColumnList() & " FROM " & oParse.FromClause\r
- if not IsNothing(oParse.WhereClause) then countSql &= " WHERE " & oParse.WhereClause\r
- if oParse.GroupBy.count > 0 then countSql &= " GROUP BY " & join(oParse.GroupBy.ToArray(),",")\r
- if not IsNothing(oParse.HavingClause) then countSql &= " HAVING " & oParse.HavingClause\r
- countSql="SELECT COUNT(*) FROM (" & countSql & ")"\r
- if dbDialect<>"Oracle" then countSql &= " AS rico_Main"\r
- DebugMsgs.add(countSql)\r
- command.CommandText = countSql\r
- totcnt = command.ExecuteScalar()\r
- eof=true\r
- else\r
- while rdr.Read()\r
- totcnt += 1\r
- end while\r
- eof=true\r
- end if\r
- end if\r
- if eof then RenderQueryRows=totcnt\r
- rdr.Close()\r
-End Function\r
-\r
-\r
-' returns the parameter symbol to insert into the sql string\r
-Private Function PushParam(ByVal newvalue) as String\r
- dim ParamName as String\r
- newvalue=cstr(newvalue)\r
- if newvalue="" then newvalue=" " ' empty string gets converted to TEXT data type instead of VARCHAR\r
- select case dbClassName\r
- case "SqlConnection":\r
- ParamName="@P" & CStr(command.parameters.count)\r
- PushParam=ParamName\r
- case else:\r
- ParamName=""\r
- PushParam="?"\r
- end select\r
- command.parameters.add(ParamName,newvalue)\r
- DebugMsgs.add("Param " & ParamName & " value=" & newvalue)\r
-End Function\r
-\r
-\r
-' assumes oParse is already initialized\r
-Private sub ApplyQStringParms()\r
- dim i, a, flen\r
- dim j as Integer, fop as String, ParamSymbol as String\r
- dim newfilter as string, qs as string, value as string\r
-\r
- for each qs in Request.QueryString\r
- select case left(qs,1)\r
- \r
- ' user-invoked condition\r
- case "w","h":\r
- i=mid(qs,2)\r
- if IsNumeric(i) then\r
- i=CInt(i)\r
- if i<0 or i>=filters.Count then exit for\r
- value=Request.QueryString(qs)\r
- newfilter=filters(i)\r
- j=InStr(1,newfilter," in (?)",1)\r
- if j>0 then\r
- a=split(value,",")\r
- for i=0 to ubound(a)\r
- ParamSymbol=PushParam(a(i))\r
- a(i)=ParamSymbol\r
- next\r
- newfilter=left(newfilter,j+4) & join(a,",") & mid(newfilter,j+6)\r
- elseif InStr(newfilter,"?")>0 then\r
- ParamSymbol=PushParam(value)\r
- if ParamSymbol<>"?" then newfilter=replace(newfilter,"?",ParamSymbol)\r
- end if\r
- if left(qs,1)="h" then\r
- oParse.AddHavingCondition(newfilter)\r
- else\r
- oParse.AddWhereCondition(newfilter)\r
- end if\r
- end if\r
- \r
- ' sort\r
- case "s":\r
- i=mid(qs,2)\r
- if not IsNumeric(i) then exit for\r
- i=CInt(i)\r
- if i<0 or i>=oParse.SelectList.count then exit for\r
- value=ucase(left(Request.QueryString(qs),4))\r
- if value<>"ASC" and value<>"DESC" then value="ASC"\r
- if orderByRef then\r
- oParse.AddSort(CStr(i+1) & " " & value)\r
- else\r
- oParse.AddSort(oParse.SelectList(i).sql & " " & value)\r
- end if\r
- \r
- ' user-supplied filter\r
- case "f":\r
- a=split(qs,"[")\r
- if ubound(a)=2 then\r
- if a(2)="op]" then\r
- i=left(a(1),len(a(1))-1)\r
- if not IsNumeric(i) then exit for\r
- if len(i)>3 then exit for\r
- i=CInt(i)\r
- if i<0 or i>oParse.SelectList.count then exit for\r
- fop=Request.QueryString(qs)\r
- newfilter=oParse.SelectList(i).sql\r
- select case fop\r
- case "EQ":\r
- newfilter = "(" & AddCoalesce(newfilter) & " IN " & GetMultiParmFilter(qs) & ")"\r
- case "LE":\r
- newfilter &= "<=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))\r
- case "GE":\r
- newfilter &= ">=" & PushParam(Request.QueryString(replace(qs,"[op]","[0]")))\r
- case "NULL": newfilter &= " is null"\r
- case "NOTNULL": newfilter &= " is not null"\r
- case "LIKE":\r
- newfilter &= " LIKE " & PushParam(replace(Request.QueryString(replace(qs,"[op]","[0]")),"*",Wildcard))\r
- case "NE"\r
- newfilter = "(" & AddCoalesce(newfilter) & " NOT IN " & GetMultiParmFilter(qs) & ")"\r
- end select\r
- dim sql=oParse.SelectList(i).sql\r
- if (InStr(sql,"min(")>0 or _\r
- InStr(sql,"max(")>0 or _\r
- InStr(sql,"sum(")>0 or _\r
- InStr(sql,"count(")>0) and _\r
- InStr(sql,"(select ")<1 then\r
- oParse.AddHavingCondition(newfilter)\r
- else\r
- oParse.AddWhereCondition(newfilter)\r
- end if\r
- end if\r
- end if\r
- end select\r
- next\r
-end sub\r
-\r
-\r
-Private function AddCoalesce(newfilter as String) as String\r
- if dbDialect="Access" then\r
- newfilter="iif(IsNull(" & newfilter & "),''," & newfilter & ")"\r
- else\r
- newfilter="coalesce(" & newfilter & ",'')"\r
- end if\r
- AddCoalesce=newfilter\r
-end function\r
-\r
-\r
-Private function GetMultiParmFilter(qs as String) as String\r
- dim flenStr as String = Request.QueryString(replace(qs,"[op]","[len]"))\r
- if not IsNumeric(flenStr) then exit function\r
- dim flen as Integer = CInt(flenStr)\r
- dim j as Integer, param as String, filter as String = ""\r
- for j=0 to flen-1\r
- if j>0 then filter &= ","\r
- param=Request.QueryString(replace(qs,"[op]","[" & j & "]"))\r
- filter &= PushParam(param)\r
- next\r
- GetMultiParmFilter = "(" & filter & ")"\r
-end function\r
-\r
-\r
-Public function XmlStringCell(value as object) as String\r
- dim result\r
- if IsDBNull(value) then result="" else result=server.HTMLEncode(value)\r
- XmlStringCell="<td>" & result & "</td>"\r
-end function\r
-\r
-\r
-' for the root node, parentID should "" (empty string)\r
-' containerORleaf: L/zero (leaf), C/non-zero (container)\r
-' selectable: 0->not selectable, 1->selectable\r
-Public function WriteTreeRow(parentID,ID,description,containerORleaf,selectable)\r
- HeaderRows.Add(TreeRow(parentID,ID,description,containerORleaf,selectable))\r
-end function\r
-\r
-Public function TreeRow(parentID,ID,description,containerORleaf,selectable)\r
- TreeRow="<tr>" & XmlStringCell(parentID) & XmlStringCell(ID) & XmlStringCell(description) & XmlStringCell(containerORleaf) & XmlStringCell(selectable) & "</tr>"\r
-end function\r
-\r
-'******************************************************************************************\r
-'' @SDESCRIPTION: takes a given string and makes it JSON valid (http://json.org/)\r
-'' @AUTHOR: Michael Rebec\r
-'' @DESCRIPTION: all characters which needs to be escaped are beeing replaced by their\r
-'' unicode representation according to the\r
-'' RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627\r
-'' @PARAM: val [string]: value which should be escaped\r
-'' @RETURN: [string] JSON valid string\r
-'******************************************************************************************\r
-public function escapeJSON(val)\r
- const cDoubleQuote = &h22\r
- const cRevSolidus = &h5C\r
- const cSolidus = &h2F\r
- dim i as integer, currentDigit as string\r
-\r
- for i = 1 to (len(val))\r
- currentDigit = mid(val, i, 1)\r
- if asc(currentDigit)> &h00 and asc(currentDigit) <&h1F then\r
- currentDigit = escapeJSONSquence(currentDigit)\r
- elseif asc(currentDigit)>= &hC280 and asc(currentDigit) <= &hC2BF then\r
- currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC200), 2, 0), 2)\r
- elseif asc(currentDigit)>= &hC380 and asc(currentDigit) <= &hC3BF then\r
- currentDigit = "\u00" + right(padLeft(hex(asc(currentDigit) - &hC2C0), 2, 0), 2)\r
- else\r
- select case asc(currentDigit)\r
- case cDoubleQuote: currentDigit = escapeJSONSquence(currentDigit)\r
- case cRevSolidus: currentDigit = escapeJSONSquence(currentDigit)\r
- case cSolidus: currentDigit = escapeJSONSquence(currentDigit)\r
- end select\r
- end if\r
- escapeJSON = escapeJSON & currentDigit\r
- next\r
-end function\r
- \r
-function escapeJSONSquence(digit)\r
- escapeJSONSquence = "\u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)\r
-end function \r
- \r
-function padLeft(value, totalLength, paddingChar)\r
- padLeft = right(clone(paddingChar, totalLength) & value, totalLength)\r
-end function\r
- \r
-public function clone(byVal str, n)\r
- dim i as integer\r
- for i = 1 to n : clone = clone & str : next\r
-end function\r
-\r
-</script>\r
projects / infodrom / rico3 / blobdiff