If you are into advanced AJAX techniques you probably will stumble across JSON (www.) which makes developing (and therefore the life) a lot easier when working with AJAX. If you already stumbled across and you use JSON within classic ASP you might find this article useful. It deals with escaping characters for JSON acording to the RFC4627#2.5
I haven’t found any snippet out there for classic ASP so we had to write our own. And so my work colleague - an old algorithm guru - just came up with this function which covers all the requirements specified in the JSON RFC.
What we want to achieve…
- <script>
- alert({foo:"<%= "some va""lue" %>"}.foo);
- </script>
The code snippet above will result in a javascript error because we are passing an apostrophe from ASP to Javascript which leads to an early closing of the string: foo:”some va”lue” (there is one apostrophe too much). The same thing happens for other characters as well. If you have line breaks, german umlaute, hidden special characters, etc. All those need to be escaped now in order that the javascript simple object notation (JSON) can interpret it. Thats the function which does the escaping (there are 3 more functions cause they’re used within the escapeJSON()):
- '******************************************************************************************
- '' @SDESCRIPTION: takes a given string and makes it JSON valid (http:///)
- '' @AUTHOR: Michael Rebec
- '' @DESCRIPTION: all characters which needs to be escaped are beeing replaced by their
- '' unicode representation according to the
- '' RFC4627#2.5 -
- '' @PARAM: val [string]: value which should be escaped
- '' @RETURN: [string] JSON valid string
- '******************************************************************************************
- public function escapeJSON(val)
- cDoubleQuote = &h22
- cRevSolidus = &h5C
- cSolidus = &h2F
- for i = 1 to (len(val))
- currentDigit = mid(val, i, 1)
- if asc(currentDigit) > &h00 and asc(currentDigit) < &h1F then
- currentDigit = escapeJSONSquence(currentDigit)
- elseif asc(currentDigit) >= &hC280 and asc(currentDigit) <= &hC2BF then
- currentDigit = "u00" + right(padLeft(hex(asc(currentDigit) - &hC200), 2, 0), 2)
- elseif asc(currentDigit) >= &hC380 and asc(currentDigit) <= &hC3BF then
- currentDigit = "u00" + right(padLeft(hex(asc(currentDigit) - &hC2C0), 2, 0), 2)
- else
- select case asc(currentDigit)
- case cDoubleQuote: currentDigit = escapeJSONSquence(currentDigit)
- case cRevSolidus: currentDigit = escapeJSONSquence(currentDigit)
- case cSolidus: currentDigit = escapeJSONSquence(currentDigit)
- end select
- end if
- escapeJSON = escapeJSON & currentDigit
- next
- end function
- function escapeJSONSquence(digit)
- escapeJSONSquence = "u00" + right(padLeft(hex(asc(digit)), 2, 0), 2)
- end function
- function padLeft(value, totalLength, paddingChar)
- padLeft = right(clone(paddingChar, totalLength) & value, totalLength)
- end function
- public function clone(byVal str, n)
- for i = 1 to n : clone = clone & str : next
- end function
- [/asp]
- So now we should be able to escape the strings for JSON like this and no error should occur...
- [asp]
- <script>
- alert({foo:"<%= escapeJSON("some va""lue") %>"}.foo);
- </script>
This stuff has been tested and works for all characters so everything can be transfered with JSON now 
I would suggest to group the whole functions into a class called JSON with a method escape() just for a nicer use. In my case its in a utility class StringOperations where I have several string manipulation methods. If you are interested you can download the full String class also which include the JSON escaping method:
Thanks a ton! I was going crazy coz wasn’t finding one suitable solution for ASP. Thanks again!
Hi Michal,
I’m having a problem converting the string back to special characters. When I get data from JSON and the strings are escaped, and I need to put that data into a form field the uuxx numbers are still there instead of the special characters. Do you have, or know of any function that reverses this process?
Erik
I rate this code: FLUNK.
Your code:
- Escapes characters unnecessarily (such as forward slash).
- Escapes using more characters than needed, making the JSON longer (using hex notation instead of simple backslash-escaping).
- Escapes every high Ascii character as u00__ which is not only longer than x__ but completely ignores the first byte of Unicode characters, making the result meaningless.
- Has goofy stuff like “- &hC2C0″ which is clearly an undefined operation to perform on Unicode between &hC380 and &hC3BF. Perhaps you’re matching character sets to character sets, but this is something you’re supposed to solve with fonts, not subtraction to turn one code into another. To make your preposterous claim “This stuff has been tested and works for all characters so everything can be transfered with JSON now” valid, you have to rip out this junk. I don’t care how elaborate a character map you use, you’ll still be altering characters, hardly the desire of most people who want to send Unicode characters through JSON from ASP.
Here is my version:
Function JSONEscape(json)
Dim Pos
Dim Char
Dim Code
JSONEscape = “”
If IsNull(json) Then Exit Function
For Pos = 1 To Len(json)
Char = Mid(json, Pos, 1)
Code = AscW(Char)
If (Code >= 32 And Code <= 127) And Code 34 And Code 39 And Code 60 And Code 92 Then ‘printable, plus skip ‘” and to avoid false HTML tags 0 Then
JSONEscape = JSONEscape & “” & VBA.Mid(“bfnOrtv’”"”, Code, 1)
Else
Code = AscW(Char)
If (Code >= 0 And Code <= 255) Then ‘escape nonprinting, high ascii, and < characters (to avoid false HTML tags)’
JSONEscape = JSONEscape & “x” & VBA.Right(“0″ & Hex(Code), 2)
Else
JSONEscape = JSONEscape & “u” & VBA.Right(“000″ & Hex(Code), 4)
End If
End If
End If
Next
End Function[/as]
For want of a preview function, a p was lost
…
I know this is a very old thread but to whom it may concern (I know somebody is going to read this and think a, just what I need..)..
Emtucifor your code is “FLUNKED”.. How can you publish this forever to be read on the internet.. The replacements in your string do not even work.. All special characters like horizontal TAB are Null.
Ik know ASP != VB but I needed it in VB and cleaned it up, included it in my Anything2JSON class..
I’m using a quick and dirty array, only initializing it once (you should use this as a class!).
It can replace the specials to UNICODE, optionally you can choose to replace , ‘ [ ] { } ; too.
You can encode any Scripting.Dictionary object, VB array, String, Integer, Double etc. etc. to a valid JSON format, it it is not going to look pretty, it does not do indenting, but it will be valid!
String to UNICODE is not internal in the Anything2JSON functions, first use JSONEscape if you want to use special characters.
This code is far from perfect and should be treated as an Alpha release. You are free to do anything you want with it according to the MIT license.
Drop a line if you spot a bug or something..
'##################################################################
' Class: cAnyThing2JSON v0.1
' Class for encoding strings to JSON in compatible UNICODE text
' Written by removed apon request
' License CC:
'
' Permission is hereby granted, free of charge, to any person
' obtaining a copy of this software and associated documentation
' files (the "Software"), to deal in the Software without
' restriction, including without limitation the rights to use,
' copy, modify, merge, publish, distribute, sublicense, and/or sell
' copies of the Software, and to permit persons to whom the
' Software is furnished to do so, subject to the following
' conditions:
'
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
' OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
' HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
' WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
' OTHER DEALINGS IN THE SOFTWARE.
'##################################################################
Private Exceptions() As String
Private UNICODE_REP(8 To 125) As String
Private Sub Class_Initialize()
ReDim Exceptions(0) As String
errIndex = 0
' Unicode replacements for JSON (including characters that do not NEED to be replaced)
UNICODE_REP(8) = "b"
UNICODE_REP(9) = "t"
UNICODE_REP(10) = "n"
UNICODE_REP(12) = "f"
UNICODE_REP(13) = "r"
UNICODE_REP(34) = "" & Chr(34)
' These are only replaced if you supply Extra=True to the JSONEscape function
UNICODE_REP(39) = "'"
UNICODE_REP(44) = ","
UNICODE_REP(59) = ";"
UNICODE_REP(91) = "["
UNICODE_REP(92) = "\"
UNICODE_REP(93) = "]"
UNICODE_REP(123) = "{"
UNICODE_REP(125) = "}"
End Sub
Function JSONEscape(ByVal strJSON As String, Optional ByVal Extras As Boolean = False) As String
'Function esccapes according to the JSON specification.
'See: http://www.
'Highlights:
' Escapes following with a reverse solidus ():
' - quotation mark (")
' - reverse solidus ()
' - forward solidus (/)
' - backspace (BS)
' - formfeed (FF)
' - newline (LF)
' - carriage return (CR)
' - horizontal tab (TAB)
' Does NOT escape u0001 hexademical UNICODE characters, you should do this yourself if you use them!
' You can use Scripting.RegExp's Replace function to replace these by: ^(.*)(u[0-9a-fA-F]{4})(.*)$ => $1$2$3
Dim Pos As Long
Dim Code As Integer
Dim Char As String
For Pos = 1 To Len(strJSON)
Char = Mid(strJSON, Pos, 1)
Code = AscW(Char)
Select Case Code
' Specials according to JSON spec
Case 34, 92, 47, 8, 12, 10, 13, 9
JSONEscape = JSONEscape & UNICODE_REP(Code)
' Specials used in JSON format
Case 39, 44, 59, 91, 93, 123, 125
' If Extras is true then do more escaping: specials for JSON syntax for fragile json decoders.
If Extras Then
JSONEscape = JSONEscape & UNICODE_REP(Code)
Else
JSONEscape = JSONEscape & Char
End If
' Normal characters -> pass trough
Case 32 To 126
JSONEscape = JSONEscape & Char
' Anything not caught before but in range of plain ASCII
Case 0 To 255
JSONEscape = JSONEscape & "x" & Right("0" & Hex(Code), 2)
' Anything not caught before, thus out of ASCII range
Case Else
JSONEscape = JSONEscape & "u" & Right("000" & Hex(Code), 4)
End Select
Next Pos
End Function
' Transform a Scripting.Dictionary to JSON
Public Function Dict2JSON(ByVal objDict As Dictionary, Optional ByVal Pretty As Boolean = False) As String
Dim strKey As Variant
Dim CrLf As String
If Pretty Then crfl = vbCrLf
' For each object in the dictionary find it's type, parse it, return it, using Anything2JSON()
For Each strKey In objDict
' Concatenating the objects into a JSON formatted string
Dict2JSON = Dict2JSON & Chr(34) & strKey & Chr(34) & ":" & Anything2JSON(objDict(strKey), Pretty) & "," & CrLf
Next strKey
' Remove the extra trailing ","
Dict2JSON = Left(Dict2JSON, Len(Dict2JSON) - 1)
' Wrap in JSON's object wrappers
Dict2JSON = "{" & CrLf & Dict2JSON & CrLf & "}"
End Function
Private Function Array2JSON(ByVal arrIN As Variant, Optional ByVal Pretty As Boolean = False) As String
Dim arrItem As Variant
Dim CrLf As String
If Pretty Then crfl = vbCrLf
' For each var in the array find it's type, parse it, return it, using Anything2JSON()
For i = LBound(arrIN) To UBound(arrIN)
' Concatenating the objects into a JSON formatted string
Array2JSON = Array2JSON & Anything2JSON(arrIN(i), Pretty) & "," & CrLf
Next i
' Remove the extra trailing ","
Array2JSON = Left(Array2JSON, Len(Array2JSON) - 1)
' Wrap in JSON's array wrappers
Array2JSON = "[" & CrLf & Array2JSON & CrLf & "]"
End Function
' Find out what the type of the object (objIN) is, parse it using the appropriate function and return it.
Public Function Anything2JSON(ByRef objIN As Variant, Optional ByVal Pretty As Boolean = False) As String
Select Case TypeName(objIN)
Case "Dictionary"
Anything2JSON = Dict2JSON(objIN, Pretty)
Case "String()", "Variant()", "Object()", "Dictionary()"
Anything2JSON = Array2JSON(objIN, Pretty)
Case "String"
Anything2JSON = Chr(34) & objIN & Chr(34)
Case "Null", "DBNull", "Nothing", "Empty"
Anything2JSON = "null"
Case "Boolean"
Anything2JSON = IIf(objIN, "true", "false")
Case "Integer", "Double", "Long", "ULong", "UShort", "UInteger", "Decimal"
Anything2JSON = objIN
Case "Date"
Anything2JSON = Format(objIN, "yyyy-mm-dd")
Case Else
Exception ("Unknown or unimplemented object: " & TypeName(objIN))
End Select
End Function
' Used for exception handling, only 1 is actually implemented,
' only included for the sake of a complete picture.
Private Function Exception(strException)
ReDim Preserve Exceptions(UBound(Exceptions)) As String
Exceptions(UBound(Exceptions)) = strException
Debug.Print "Exception in cAnything2JSON: " & strException
End Function
' Return an array of Errors/Exceptions
Public Function getError() As Variant
getError = getExceptions()
End Function
' Return an array of Errors/Exceptions
Public Function getExceptions() As Variant
getExceptions = Exceptions
End Function
And the second comment in the last If statement should be removed. It is a leftover after reordering the code to hit most likely conditions first in the loop.
Control character 31 isn’t escaped.
To fix: “asc(currentDigit) <&h1F" needs to be "asc(currentDigit) <=&h1F"
Thanks alot for this code!
you may simplify with tmp var
class JsonTool
public function escape(val)
dim i,l,currentDigit, ascii
l = len( val )
for i = 1 to l
currentDigit = mid(val, i, 1)
ascii = asc( currentDigit )
if &h00 <= ascii and ascii <= &h1F then
currentDigit = escapeSequence(ascii)
elseif &hC280 <= ascii and ascii <= &hC2BF then
currentDigit = escapeSequence(ascii - &hC200) ' "u00" + right(padLeft(hex(ascii ), 2, 0), 2)
elseif &hC380 <= ascii and ascii <= &hC3BF then
currentDigit = escapeSequence(ascii - &hC2C0 ) ' "u00" + right(padLeft(hex(ascii - &hC2C0), 2, 0), 2)
elseif ascii = &h22 then 'cDoubleQuote
currentDigit = escapeSequence(ascii)
elseif ascii = &h5C then 'cRevSolidus
currentDigit = escapeSequence(ascii)
elseif ascii = &h2F then 'cSoliduscSolidus
currentDigit = escapeSequence(ascii)
end if
escape = escape & currentDigit
next
end function
private function escapeSequence(ascii)
escapeSequence = "u00" & right(padLeft(hex(ascii), 2, 0), 2)
end function
private function padLeft(value, totalLength, paddingChar)
padLeft = right(clone(paddingChar, totalLength) & value, totalLength)
end function
private function clone(byVal str, n)
for i = 1 to n : clone = clone & str : next
end function
end class