├── LICENCE.txt ├── README.md ├── test.asp └── jsonObject.class.asp /LICENCE.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | Copyright (c) 2016 RCDMK - rcdmk[at]hotmail[dot]com 3 | 4 | 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: 5 | 6 | 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. 7 | 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # JSON object class 3.9.0 2 | 3 | ## By RCDMK - rcdmk[at]hotmail[dot]com 4 | 5 | ### Licence: 6 | MIT license: http://opensource.org/licenses/mit-license.php 7 | The MIT License (MIT) 8 | Copyright (c) 2016 RCDMK - rcdmk[at]hotmail[dot]com 9 | 10 | 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: 11 | 12 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 13 | 14 | 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. 15 | 16 | ### How to use: 17 | 18 | > This lib requires LCID (Locale Code IDentifier) property of your ASP application before use. 19 | > You can do this by setting the LCID in one of the following ways: 20 | > * On the page declaration at the top of the page to set it to the entire page (eg.: `<%@ LCID=1046 %>`), OR 21 | > * On the `Session` object to set it to all pages in the entire session (eg.: `Session.LCID = 1046`), OR 22 | > * On the `Response` object, before using the class, to set it beyond this point on the page (eg.: `Response.LCID = 1046`) 23 | 24 | ```vb 25 | Response.LCID = 1046 ' REQUIRED! Set your LCID here (1046 = Brazilian). Could also be the LCID property of the page declaration or the Session.LCID property 26 | 27 | ' instantiate the class 28 | set JSON = New JSONobject 29 | 30 | ' add properties 31 | JSON.Add "prop1", "someString" 32 | JSON.Add "prop2", 12.3 33 | JSON.Add "prop3", Array(1, 2, "three") 34 | 35 | ' remove properties 36 | JSON.Remove "prop2" 37 | JSON.Remove "thisDoesNotExistsAndWillDoNothing" 38 | 39 | ' change some values 40 | JSON.Change "prop1", "someOtherString" 41 | JSON.Change "prop4", "thisWillBeCreated" ' this property doen't exists and will be created automagically 42 | 43 | ' get the values 44 | Response.Write JSON.Value("prop1") & "
" 45 | Response.Write JSON.Value("prop2") & "
" 46 | Response.Write JSON("prop3").Serialize() & "
" ' default function is equivalent to `.Value(propName)` - this property returns a JSONarray object 47 | Response.Write JSON("prop4") & "
" 48 | 49 | ' get the JSON formatted output 50 | Dim jsonString 51 | jsonString = JSON.Serialize() ' this will contain the string representation of the JSON object 52 | 53 | JSON.Write() ' this will write the output to the Response - equivalent to: Response.Write JSON.Serialize() 54 | 55 | ' load and parse some JSON formatted string 56 | jsonString = "[{ ""strings"" : ""valorTexto"", ""numbers"": 123.456, ""arrays"": [1, ""2"", 3.4, [5, 6, [7, 8]]], ""objects"": { ""prop1"": ""outroTexto"", ""prop2"": [ { ""id"": 1, ""name"": ""item1"" }, { ""id"": 2, ""name"": ""item2"", ""teste"": { ""maisum"": [1, 2, 3] } } ] } }]" ' double double quotes here because of the VBScript quotes scaping 57 | 58 | set oJSONoutput = JSON.Parse(jsonString) ' this method returns the parsed object. Arrays are parsed to JSONarray objects 59 | 60 | JSON.Write() ' outputs: '{"data":[{"strings":"valorTexto","numbers":123.456,"arrays":[1,"2",3.4,[5,6,[7,8]]],"objects":{"prop1":"outroTexto","prop2":[{"id":1,"name":"item1"},{"id":2,"name":"item2","teste":{"maisum":[1,2,3]}}]}}]}' 61 | oJSONoutput.Write() ' outputs: '[{"strings":"valorTexto","numbers":123.456,"arrays":[1,"2",3.4,[5,6,[7,8]]],"objects":{"prop1":"outroTexto","prop2":[{"id":1,"name":"item1"},{"id":2,"name":"item2","teste":{"maisum":[1,2,3]}}]}}]' 62 | 63 | ' if the string represents an object (not an array of objects), the current object is returned so there is no need to set the return to a new variable 64 | jsonString = "{ ""strings"" : ""valorTexto"", ""numbers"": 123.456, ""arrays"": [1, ""2"", 3.4, [5, 6, [7, 8]]] }" 65 | 66 | JSON.Parse(jsonString) 67 | JSON.Write() ' outputs: '{"strings":"valorTexto","numbers":123.456,"arrays":[1,"2",3.4,[5,6,[7,8]]]}' 68 | ``` 69 | 70 | To load records from a database: 71 | 72 | ```vb 73 | ' load records from an ADODB.Recordset 74 | dim cn, rs 75 | set cn = CreateObject("ADODB.Connection") 76 | cn.Open "yourConnectionStringGoesHere" 77 | 78 | set rs = cn.execute("SELECT id, nome, valor FROM pedidos ORDER BY id ASC") 79 | ' this could also be: 80 | ' set rs = CreateObject("ADODB.Recordset") 81 | ' rs.Open "SELECT id, nome, valor FROM pedidos ORDER BY id ASC", cn 82 | 83 | JSON.LoadRecordset rs 84 | JSONarr.LoadRecordset rs 85 | 86 | rs.Close 87 | cn.Close 88 | set rs = Nothing 89 | set cn = Nothing 90 | 91 | JSON.Write() ' outputs: {"data":[{"id":1,"nome":"nome 1","valor":10.99},{"id":2,"nome":"nome 2","valor":19.1}]} 92 | JSONarr.Write() ' outputs: [{"id":1,"nome":"nome 1","valor":10.99},{"id":2,"nome":"nome 2","valor":19.1}] 93 | ``` 94 | 95 | To change the default property name ("data") when loading arrays and recordsets, use the `defaultPropertyName` property: 96 | 97 | ```vb 98 | JSON.defaultPropertyName = "CustomName" 99 | JSON.Write() ' outputs: {"CustomName":[{"id":1,"nome":"nome 1","valor":10.99},{"id":2,"nome":"nome 2","valor":19.1}]} 100 | ``` 101 | 102 | If you want to use arrays, I have something for you too 103 | 104 | ```vb 105 | ' instantiate the class 106 | set JSONarr = New JSONarray 107 | 108 | ' add something to the array 109 | JSONarr.Push JSON ' Can be JSON objects, and even JSON arrays 110 | JSONarr.Push 1.25 ' Can be numbers 111 | JSONarr.Push "and strings too" 112 | 113 | ' write to page 114 | JSONarr.Write() ' Guess what? This does the same as the Write method from JSON object 115 | ``` 116 | 117 | To loop arrays you have to access the `items` property of the `JSONarray` object and you can also access the items trough its index: 118 | 119 | ```vb 120 | dim i, item 121 | 122 | 123 | ' more readable loop 124 | for each item in JSONarr.items 125 | if isObject(item) and typeName(item) = "JSONobject" then 126 | item.write() 127 | else 128 | response.write item 129 | end if 130 | 131 | response.write "
" 132 | next 133 | 134 | 135 | ' faster but less readable 136 | for i = 0 to JSONarr.length - 1 137 | if isObject(JSONarr(i)) then 138 | set item = JSONarr(i) 139 | 140 | if typeName(item) = "JSONobject" then 141 | item.write() 142 | else 143 | response.write item 144 | end if 145 | else 146 | item = JSONarr(i) 147 | response.write item 148 | end if 149 | 150 | response.write "
" 151 | next 152 | ``` 153 | -------------------------------------------------------------------------------- /test.asp: -------------------------------------------------------------------------------- 1 | <% 2 | Option Explicit 3 | Response.LCID = 1046 ' Brazilian LCID (use your locale code here). 4 | ' Could also be the LCID property of the page declaration or Session.LCID to set it to the entire session. 5 | response.buffer = true 6 | %> 7 | 8 | 9 | 10 | 11 | 12 | ASPJSON 13 | 14 | 29 | 30 | 31 |

JSON Object and Array Tests

32 | <% 33 | server.ScriptTimeout = 10 34 | dim jsonObj, jsonString, jsonArr, outputObj 35 | dim testLoad, testAdd, testRemove, testValue, testChange, testArrayPush, testLoadRecordset 36 | dim testLoadArray, testChangeDefaultPropertyName, testGetItemAt 37 | 38 | testLoad = true 39 | testLoadArray = true 40 | testAdd = true 41 | testRemove = true 42 | testValue = true 43 | testChange = true 44 | 45 | testArrayPush = true 46 | 47 | testLoadRecordset = true 48 | 49 | testChangeDefaultPropertyName = true 50 | 51 | set jsonObj = new JSONobject 52 | set jsonArr = new jsonArray 53 | 54 | jsonObj.debug = false 55 | 56 | if testLoad then 57 | jsonString = "{ ""strings"" : ""valorTexto"", ""numbers"": 123.456, ""bools"": true, ""arrays"": [1, ""2"", 3.4, [5, -6, [7, 8, [[[""9"", ""10""]]]]]], ""emptyArray"": [], ""emptyObject"": {}, ""objects"": { ""prop1"": ""outroTexto"", ""prop2"": [ { ""id"": 1, ""name"": ""item1"" }, { ""id"": 2, ""name"": ""item2"", ""teste"": { ""maisum"": [1, 2, 3] } } ] }, ""multiline"": ""Texto com\r\nMais de\r\numa linha e escapado com \\."" }" 58 | 59 | if testLoadArray then jsonString = "[" & jsonString & "]" 60 | 61 | dim start 62 | start = timer() 63 | set outputObj = jsonObj.parse(jsonString) 64 | 65 | if testLoadArray and left(jsonString, 1) <> "[" then jsonString = "[" & jsonString & "]" 66 | %> 67 |

Parse Input

68 | 
<%= jsonString %>
69 | <% 70 | response.flush 71 | 72 | dim start 73 | start = timer() 74 | set outputObj = jsonObj.parse(jsonString) 75 | if testLoadArray then set jsonArr = outputObj 76 | 77 | response.Write "Load time: " & (timer() - start) & " s
" 78 | end if 79 | 80 | if testAdd then 81 | dim arr, multArr, nestedObject 82 | arr = Array(1, "teste", 234.56, "mais teste", "234", now) 83 | 84 | redim multArr(2, 3) 85 | multArr(0, 0) = "0,0" 86 | multArr(0, 1) = "0,1" 87 | multArr(0, 2) = "0,2" 88 | multArr(0, 3) = "0,3" 89 | 90 | multArr(1, 0) = "1,0" 91 | multArr(1, 1) = "1,1" 92 | multArr(1, 2) = "1,2" 93 | multArr(1, 3) = "1,3" 94 | 95 | multArr(2, 0) = "2,0" 96 | multArr(2, 1) = "2,1" 97 | multArr(2, 2) = "2,2" 98 | multArr(2, 3) = "2,3" 99 | 100 | jsonObj.add "nome", "Jozé" 101 | jsonObj.add "ficticio", true 102 | jsonObj.add "idade", 25 103 | jsonObj.add "saldo", -52 104 | jsonObj.add "bio", "Nascido em São Paulo\Brasil" & vbcrlf & "Sem filhos" & vbcrlf & vbtab & "Jogador de WoW" 105 | jsonObj.add "data", now 106 | jsonObj.add "lista", arr 107 | jsonObj.add "lista2", multArr 108 | 109 | set nestedObject = new JSONobject 110 | nestedObject.add "sub1", "value of sub1" 111 | nestedObject.add "sub2", "value of ""sub2""" 112 | 113 | jsonObj.add "nested", nestedObject 114 | end if 115 | 116 | if testRemove then 117 | jsonObj.remove "numbers" 118 | jsonObj.remove "aNonExistantPropertyName" ' this sould run silently, even to non existant properties 119 | end if 120 | 121 | if testChangeDefaultPropertyName then 122 | jsonObj.defaultPropertyName = "CustomName" 123 | jsonArr.defaultPropertyName = "CustomArrName" 124 | end if 125 | 126 | if testValue then 127 | %>

Get Values

<% 128 | response.write "nome: " & jsonObj.value("nome") & "
" 129 | response.write "idade: " & jsonObj("idade") & "
" ' short syntax 130 | response.write "non existant property:" & jsonObj("aNonExistantPropertyName") & "(" & typeName(jsonObj("aNonExistantPropertyName")) & ")
" 131 | 132 | if isObject(jsonObj(jsonObj.defaultPropertyName)) then 133 | response.write "default property name (" & jsonObj.defaultPropertyName & "): 
" & jsonObj(jsonObj.defaultPropertyName).Serialize() & "
" 134 | else 135 | response.write "default property name (" & jsonObj.defaultPropertyName & "):" & jsonObj(jsonObj.defaultPropertyName) & "
" 136 | end if 137 | end if 138 | 139 | if testChange then 140 | %>

Change Values

<% 141 | 142 | response.write "nome before: " & jsonObj.value("nome") & "
" 143 | 144 | jsonObj.change "nome", "Mario" 145 | 146 | response.write "nome after: " & jsonObj.value("nome") & "
" 147 | 148 | jsonObj.change "nonExisting", -1 149 | 150 | response.write "Non existing property is created with: " & jsonObj.value("nonExisting") & "
" 151 | end if 152 | 153 | if testArrayPush then 154 | dim newJson 155 | set newJson = new JSONobject 156 | newJson.add "newJson", "property" 157 | newJson.add "version", newJson.version 158 | 159 | jsonArr.Push newJson 160 | jsonArr.Push 1 161 | jsonArr.Push "strings too" 162 | end if 163 | 164 | if testLoadRecordset then 165 | %>

Load a Recordset

166 | 173 | <% 174 | dim rs 175 | set rs = createObject("ADODB.Recordset") 176 | 177 | ' prepera an in memory recordset 178 | ' could be, and mostly, loaded from a database 179 | rs.CursorType = adOpenKeyset 180 | rs.CursorLocation = adUseClient 181 | rs.LockType = adLockOptimistic 182 | 183 | rs.Fields.Append "ID", adInteger, , adFldKeyColumn 184 | rs.Fields.Append "Nome", adVarChar, 50, adFldMayBeNull 185 | rs.Fields.Append "Valor", adDecimal, 14, adFldMayBeNull 186 | rs.Fields("Valor").NumericScale = 2 187 | 188 | rs.Open 189 | 190 | rs.AddNew 191 | rs("ID") = 1 192 | rs("Nome") = "Nome 1" 193 | rs("Valor") = 10.99 194 | rs.Update 195 | 196 | rs.AddNew 197 | rs("ID") = 2 198 | rs("Nome") = "Nome 2" 199 | rs("Valor") = 29.90 200 | rs.Update 201 | 202 | rs.moveFirst 203 | jsonObj.LoadFirstRecord rs 204 | ' or 205 | rs.moveFirst 206 | jsonArr.LoadRecordSet rs 207 | 208 | rs.Close 209 | 210 | set rs = nothing 211 | end if 212 | 213 | if testLoad then 214 | start = timer() 215 | %> 216 |

Parse Output

217 | 
<%= outputObj.write %>
218 | <% 219 | response.write timer() - start 220 | response.write " s
" 221 | response.flush 222 | end if 223 | %> 224 | 225 |

JSON Object Output<% if testLoad then %> (Same as parse output: <% if typeName(jsonObj) = typeName(outputObj) then %>yes<% else %>no<% end if %>)<% end if %>

226 | <% 227 | jsonString = jsonObj.Serialize() 228 | %> 229 | 
<%= left(jsonString, 2000) %><% if len(jsonString) > 2000 then %>... (too long, truncated)<% end if %>
230 | <% response.flush %> 231 | 232 |

Array Output<% if testLoad then %> (Same as parse output: <% if typeName(jsonArr) = typeName(outputObj) then %>yes<% else %>no<% end if %>)<% end if %>

233 | <% 234 | jsonString = jsonArr.Serialize() 235 | %> 236 | 
<%= left(jsonString, 2000) %><% if len(jsonString) > 2000 then %>... (too long, truncated)<% end if %>
237 | <% response.flush %> 238 | 239 |

Array Loop

240 | 
<%
241 | 	dim i, items, item
242 | 	
243 | 
244 | 	' more readable loop
245 | 	i = 0
246 | 	response.write "For Each Loop (readability):
==============
"
247 | 	start = timer()
248 | 	for each item in jsonArr.items
249 | 		response.write "Index "
250 | 		response.write i
251 | 		response.write ": "
252 | 	
253 | 		if isObject(item) and typeName(item) = "JSONobject" then
254 | 			item.write()
255 | 		else
256 | 			response.write item
257 | 		end if
258 | 		
259 | 		response.write "
"
260 | 		i = i + 1
261 | 		if i mod 100 = 0 then response.flush
262 | 	next
263 | 	response.write timer() - start
264 | 	response.write " s
"
265 | 
266 | 	response.write "

For Loop (speed):
=========
"
267 | 	start = timer()
268 | 
269 | 	' faster but less readable
270 | 	for i = 0 to jsonArr.length - 1
271 | 		response.write "Index "
272 | 		response.write i
273 | 		response.write ": "
274 | 	
275 | 		if isObject(jsonArr(i)) then
276 | 			set item = jsonArr(i)
277 | 			
278 | 			if typeName(item) = "JSONobject" then
279 | 				item.write()
280 | 			else
281 | 				response.write item
282 | 			end if
283 | 		else
284 | 			item = jsonArr(i)
285 | 			response.write item
286 | 		end if
287 | 		
288 | 		response.write "
"
289 | 		if i mod 100 = 0 then response.flush
290 | 	next
291 | 	response.write timer() - start
292 | 	response.write " s
"
293 | 
294 | 	set newJson = nothing
295 | 	set outputObj = nothing
296 | 	set jsonObj = nothing
297 | 	set jsonArr = nothing
298 | 	%>
299 | 300 |

JSON Script Output

301 | 302 | <% 303 | dim realOutput 304 | dim expectedOutput 305 | 306 | dim javascriptCode 307 | dim javascriptkey 308 | 309 | dim jsonScr 310 | 311 | javascriptCode = "function() { alert('test'); }" 312 | javascriptKey = "script" 313 | 314 | expectedOutput = "{""" & javascriptKey & """:" & javascriptCode & "}" 315 | 316 | set jsonScr = new JSONscript 317 | jsonScr.value = javascriptCode 318 | 319 | set jsonObj = new JSONobject 320 | jsonObj.Add javascriptKey, jsonScr 321 | 322 | realOutput = jsonObj.Serialize() 323 | 324 | %>

Output<% if (realOutput = expectedOutput) then %> (correct)<% else %> (INCORRECT!)<% end if %>

325 | 
<%= realOutput %>
326 | 327 | 328 | 329 | -------------------------------------------------------------------------------- /jsonObject.class.asp: -------------------------------------------------------------------------------- 1 | <% 2 | ' JSON object class 3.9.0 Aug, 13th - 2025 3 | ' https://github.com/rcdmk/aspJSON 4 | ' 5 | ' License MIT - see LICENCE.txt for details 6 | 7 | const JSON_ROOT_KEY = "[[JSONroot]]" 8 | const JSON_DEFAULT_PROPERTY_NAME = "data" 9 | const JSON_SPECIAL_VALUES_REGEX = "^(?:(?:t(?:r(?:ue?)?)?)|(?:f(?:a(?:l(?:se?)?)?)?)|(?:n(?:u(?:ll?)?)?)|(?:u(?:n(?:d(?:e(?:f(?:i(?:n(?:ed?)?)?)?)?)?)?)?))$" 10 | const JSON_UNICODE_CHARS_REGEX = "\\u(\d{4})" 11 | 12 | const JSON_ERROR_PARSE = 1 13 | const JSON_ERROR_PROPERTY_ALREADY_EXISTS = 2 14 | const JSON_ERROR_PROPERTY_DOES_NOT_EXISTS = 3 ' DEPRECATED 15 | const JSON_ERROR_NOT_AN_ARRAY = 4 16 | const JSON_ERROR_NOT_A_STRING = 5 17 | const JSON_ERROR_INDEX_OUT_OF_BOUNDS = 9 ' Numbered to have the same error number as the default "Subscript out of range" exeption 18 | 19 | class JSONobject 20 | dim i_debug, i_depth, i_parent 21 | dim i_properties, i_version, i_defaultPropertyName 22 | dim i_properties_count, i_properties_capacity 23 | private vbback 24 | 25 | ' Set to true to show the internals of the parsing mecanism 26 | public property get debug 27 | debug = i_debug 28 | end property 29 | 30 | public property let debug(value) 31 | i_debug = value 32 | end property 33 | 34 | 35 | ' Gets/sets the default property name generated when loading recordsets and arrays (default "data") 36 | public property get defaultPropertyName 37 | defaultPropertyName = i_defaultPropertyName 38 | end property 39 | 40 | public property let defaultPropertyName(value) 41 | i_defaultPropertyName = value 42 | end property 43 | 44 | 45 | ' The depth of the object in the chain, starting with 1 46 | public property get depth 47 | depth = i_depth 48 | end property 49 | 50 | 51 | ' The property pairs ("name": "value" - pairs) 52 | public property get pairs 53 | dim tmp 54 | tmp = i_properties 55 | if i_properties_count < i_properties_capacity then 56 | redim preserve tmp(i_properties_count - 1) 57 | end if 58 | pairs = tmp 59 | end property 60 | 61 | 62 | ' The parent object 63 | public property get parent 64 | set parent = i_parent 65 | end property 66 | 67 | public property set parent(value) 68 | set i_parent = value 69 | i_depth = i_parent.depth + 1 70 | end property 71 | 72 | 73 | ' The class version 74 | public property get version 75 | version = i_version 76 | end property 77 | 78 | 79 | ' Constructor and destructor 80 | private sub class_initialize() 81 | i_version = "3.9.0" 82 | i_depth = 0 83 | i_debug = false 84 | i_defaultPropertyName = JSON_DEFAULT_PROPERTY_NAME 85 | 86 | set i_parent = nothing 87 | redim i_properties(-1) 88 | i_properties_capacity = 0 89 | i_properties_count = 0 90 | 91 | vbback = Chr(8) 92 | end sub 93 | 94 | private sub class_terminate() 95 | dim i 96 | for i = 0 to ubound(i_properties) 97 | set i_properties(i) = nothing 98 | next 99 | 100 | redim i_properties(-1) 101 | end sub 102 | 103 | 104 | ' Parse a JSON string and populate the object 105 | public function parse(byval strJson) 106 | dim regex, i, size, char, prevchar, quoted 107 | dim mode, item, key, keyStart, value, openArray, openObject 108 | dim actualLCID, tmpArray, tmpObj, addedToArray 109 | dim root, currentObject, currentArray 110 | 111 | log("Load string: """ & strJson & """") 112 | 113 | ' Store the actual LCID and use the en-US to conform with the JSON standard 114 | actualLCID = Response.LCID 115 | Response.LCID = 1033 116 | 117 | strJson = trim(strJson) 118 | 119 | size = len(strJson) 120 | 121 | ' At least 2 chars to continue 122 | if size < 2 then err.raise JSON_ERROR_PARSE, TypeName(me), "Invalid JSON string to parse" 123 | 124 | ' Init the regex to be used in the loop 125 | set regex = new regexp 126 | regex.global = true 127 | regex.ignoreCase = true 128 | regex.pattern = "\w" 129 | 130 | ' setup initial values 131 | i = 0 132 | set root = me 133 | key = JSON_ROOT_KEY 134 | mode = "init" 135 | quoted = false 136 | set currentObject = root 137 | 138 | ' main state machine 139 | do while i < size 140 | i = i + 1 141 | char = mid(strJson, i, 1) 142 | 143 | ' root, object or array start 144 | if mode = "init" then 145 | log("Enter init") 146 | 147 | ' if we are in root, clear previous object properties 148 | if key = JSON_ROOT_KEY and TypeName(currentArray) <> "JSONarray" then 149 | redim i_properties(-1) 150 | i_properties_capacity = 0 151 | i_properties_count = 0 152 | end if 153 | 154 | ' Init object 155 | if char = "{" then 156 | log("Create object") 462 | 463 | ' If it's an open object, we close it and set the current object as it's parent 464 | if isobject(currentObject.parent) then 465 | if TypeName(currentObject.parent) = "JSONobject" then 466 | set currentObject = currentObject.parent 467 | 468 | ' If the parent is and array 469 | elseif TypeName(currentObject.parent) = "JSONarray" then 470 | set tmpObj = currentObject.parent 471 | 472 | ' we search for the next parent object to set the current object 473 | while isObject(tmpObj) and TypeName(tmpObj) = "JSONarray" 474 | set tmpObj = tmpObj.parent 475 | wend 476 | 477 | set currentObject = tmpObj 478 | end if 479 | else 480 | currentObject = currentObject.parent 481 | end if 482 | 483 | openObject = openObject - 1 484 | 485 | mode = "next" 486 | end if 487 | end if 488 | 489 | prevchar = char 490 | loop 491 | 492 | set regex = nothing 493 | 494 | Response.LCID = actualLCID 495 | 496 | set parse = root 497 | end function 498 | 499 | ' Add a new property (key-value pair) 500 | public sub add(byval prop, byval obj) 501 | dim p 502 | getProperty prop, p 503 | 504 | if GetTypeName(p) = "JSONpair" then 505 | err.raise JSON_ERROR_PROPERTY_ALREADY_EXISTS, TypeName(me), "A property already exists with the name: " & prop & "." 506 | else 507 | dim item 508 | set item = new JSONpair 509 | item.name = prop 510 | set item.parent = me 511 | 512 | dim itemType 513 | itemType = GetTypeName(obj) 514 | 515 | if isArray(obj) then 516 | dim item2 517 | set item2 = new JSONarray 518 | item2.items = obj 519 | set item2.parent = me 520 | 521 | set item.value = item2 522 | 523 | elseif itemType = "Field" then 524 | item.value = obj.value 525 | elseif isObject(obj) and itemType <> "IStringList" then 526 | set item.value = obj 527 | else 528 | item.value = obj 529 | end if 530 | 531 | if i_properties_count >= i_properties_capacity then 532 | redim preserve i_properties(i_properties_capacity * 1.2 + 1) 533 | i_properties_capacity = ubound(i_properties) + 1 534 | end if 535 | 536 | set i_properties(i_properties_count) = item 537 | i_properties_count = i_properties_count + 1 538 | end if 539 | end sub 540 | 541 | ' Remove a property from the object (key-value pair) 542 | public sub remove(byval prop) 543 | dim p, i 544 | i = getProperty(prop, p) 545 | 546 | ' property exists 547 | if i > -1 then ArraySlice i_properties, i 548 | end sub 549 | 550 | ' Return the value of a property by its key 551 | public default function value(byval prop) 552 | dim p 553 | getProperty prop, p 554 | 555 | if GetTypeName(p) = "JSONpair" then 556 | if isObject(p.value) then 557 | set value = p.value 558 | else 559 | value = p.value 560 | end if 561 | else 562 | value = null 563 | end if 564 | end function 565 | 566 | ' Change the value of a property 567 | ' Creates the property if it didn't exists 568 | public sub change(byval prop, byval obj) 569 | dim p 570 | getProperty prop, p 571 | 572 | if GetTypeName(p) = "JSONpair" then 573 | if isArray(obj) then 574 | set item = new JSONarray 575 | item.items = obj 576 | set item.parent = me 577 | 578 | p.value = item 579 | 580 | elseif isObject(obj) then 581 | set p.value = obj 582 | else 583 | p.value = obj 584 | end if 585 | else 586 | add prop, obj 587 | end if 588 | end sub 589 | 590 | ' Returns the index of a property if it exists, else -1 591 | ' @param prop as string - the property name 592 | ' @param out outProp as variant - will be filled with the property value, nothing if not found 593 | private function getProperty(byval prop, byref outProp) 594 | dim i, p, found 595 | set outProp = nothing 596 | found = false 597 | 598 | i = 0 599 | 600 | do while i < i_properties_count 601 | set p = i_properties(i) 602 | 603 | if p.name = prop then 604 | set outProp = p 605 | found = true 606 | 607 | exit do 608 | end if 609 | 610 | i = i + 1 611 | loop 612 | 613 | if not found then 614 | if prop = i_defaultPropertyName then 615 | i = getProperty(JSON_ROOT_KEY, outProp) 616 | else 617 | i = -1 618 | end if 619 | end if 620 | 621 | getProperty = i 622 | end function 623 | 624 | 625 | ' Serialize the current object to a JSON formatted string 626 | public function Serialize() 627 | dim actualLCID, out 628 | actualLCID = Response.LCID 629 | Response.LCID = 1033 630 | 631 | out = serializeObject(me) 632 | 633 | Response.LCID = actualLCID 634 | 635 | Serialize = out 636 | end function 637 | 638 | ' Writes the JSON serialized object to the response 639 | public sub write() 640 | response.write Serialize 641 | end sub 642 | 643 | 644 | ' Helpers 645 | ' Serializes a JSON object to JSON formatted string 646 | public function serializeObject(obj) 647 | dim out, prop, value, i, pairs, valueType 648 | out = "{" 649 | 650 | pairs = obj.pairs 651 | 652 | for i = 0 to ubound(pairs) 653 | set prop = pairs(i) 654 | 655 | if out <> "{" then out = out & "," 656 | 657 | if isobject(prop.value) then 658 | set value = prop.value 659 | else 660 | value = prop.value 661 | end if 662 | 663 | if prop.name = JSON_ROOT_KEY then 664 | out = out & ("""" & obj.defaultPropertyName & """:") 665 | else 666 | out = out & ("""" & prop.name & """:") 667 | end if 668 | 669 | if isArray(value) or GetTypeName(value) = "JSONarray" then 670 | out = out & serializeArray(value) 671 | 672 | elseif isObject(value) and GetTypeName(value) = "JSONscript" then 673 | out = out & value.Serialize() 674 | 675 | elseif isObject(value) then 676 | out = out & serializeObject(value) 677 | 678 | else 679 | out = out & serializeValue(value) 680 | end if 681 | next 682 | 683 | out = out & "}" 684 | 685 | serializeObject = out 686 | end function 687 | 688 | ' Serializes a value to a valid JSON formatted string representing the value 689 | ' (quoted for strings, the type name for objects, null for nothing and null values) 690 | public function serializeValue(byval value) 691 | dim out 692 | 693 | select case lcase(GetTypeName(value)) 694 | case "null" 695 | out = "null" 696 | 697 | case "nothing" 698 | out = "undefined" 699 | 700 | case "boolean" 701 | if value then 702 | out = "true" 703 | else 704 | out = "false" 705 | end if 706 | 707 | case "byte", "integer", "long", "single", "double", "currency", "decimal" 708 | out = value 709 | 710 | case "date" 711 | out = """" & year(value) & "-" & padZero(month(value), 2) & "-" & padZero(day(value), 2) & "T" & padZero(hour(value), 2) & ":" & padZero(minute(value), 2) & ":" & padZero(second(value), 2) & """" 712 | 713 | case "string", "char", "empty" 714 | out = """" & EscapeCharacters(value) & """" 715 | 716 | case else 717 | out = """" & GetTypeName(value) & """" 718 | end select 719 | 720 | serializeValue = out 721 | end function 722 | 723 | ' Pads a numeric string with zeros at left 724 | private function padZero(byval number, byval length) 725 | dim result 726 | result = number 727 | 728 | while len(result) < length 729 | result = "0" & result 730 | wend 731 | 732 | padZero = result 733 | end function 734 | 735 | ' Serializes an array item to JSON formatted string 736 | private function serializeArrayItem(byref elm) 737 | dim out, val 738 | 739 | if isobject(elm) then 740 | if GetTypeName(elm) = "JSONobject" then 741 | set val = elm 742 | 743 | elseif GetTypeName(elm) = "JSONarray" then 744 | val = elm.items 745 | 746 | elseif isObject(elm.value) then 747 | set val = elm.value 748 | 749 | else 750 | val = elm.value 751 | end if 752 | else 753 | val = elm 754 | end if 755 | 756 | if isArray(val) or GetTypeName(val) = "JSONarray" then 757 | out = out & serializeArray(val) 758 | 759 | elseif isObject(val) then 760 | out = out & serializeObject(val) 761 | 762 | else 763 | out = out & serializeValue(val) 764 | end if 765 | 766 | serializeArrayItem = out 767 | end function 768 | 769 | ' Serializes an array or JSONarray object to JSON formatted string 770 | public function serializeArray(byref arr) 771 | dim i, j, k, dimensions, out, innerArray, elm, val 772 | 773 | out = "[" 774 | 775 | if isobject(arr) then 776 | log("Serializing jsonArray object") 777 | innerArray = arr.items 778 | else 779 | log("Serializing VB array") 780 | innerArray = arr 781 | end if 782 | 783 | dimensions = NumDimensions(innerArray) 784 | 785 | if dimensions > 1 then 786 | log("Multidimensional array") 787 | for j = 0 to ubound(innerArray, 1) 788 | out = out & "[" 789 | 790 | for k = 0 to ubound(innerArray, 2) 791 | if k > 0 then out = out & "," 792 | 793 | if isObject(innerArray(j, k)) then 794 | set elm = innerArray(j, k) 795 | else 796 | elm = innerArray(j, k) 797 | end if 798 | 799 | out = out & serializeArrayItem(elm) 800 | next 801 | 802 | out = out & "]" 803 | next 804 | else 805 | for j = 0 to ubound(innerArray) 806 | if j > 0 then out = out & "," 807 | 808 | if isobject(innerArray(j)) then 809 | set elm = innerArray(j) 810 | else 811 | elm = innerArray(j) 812 | end if 813 | 814 | out = out & serializeArrayItem(elm) 815 | next 816 | end if 817 | 818 | out = out & "]" 819 | 820 | serializeArray = out 821 | end function 822 | 823 | 824 | ' Returns the number of dimensions an array has 825 | public Function NumDimensions(byref arr) 826 | Dim dimensions 827 | dimensions = 0 828 | 829 | On Error Resume Next 830 | 831 | Do While Err.number = 0 832 | dimensions = dimensions + 1 833 | UBound arr, dimensions 834 | Loop 835 | On Error Goto 0 836 | 837 | NumDimensions = dimensions - 1 838 | End Function 839 | 840 | ' DEPRECATED: Pushes (adds) a value to an array, expanding it 841 | public function ArrayPush(byref arr, byref value) 842 | redim preserve arr(ubound(arr) + 1) 843 | 844 | if isobject(value) then 845 | set arr(ubound(arr)) = value 846 | else 847 | arr(ubound(arr)) = value 848 | end if 849 | 850 | ArrayPush = arr 851 | end function 852 | 853 | ' Removes a value from an array 854 | private function ArraySlice(byref arr, byref index) 855 | dim i 856 | i = index 857 | 858 | for i = index to i_properties_count - 2 859 | if isObject(arr(i)) then set arr(i) = nothing 860 | 861 | if isObject(arr(i + 1)) then 862 | set arr(i) = arr(i + 1) 863 | else 864 | arr(i) = arr(i + 1) 865 | end if 866 | next 867 | 868 | i_properties_count = i_properties_count - 1 869 | 870 | if i_properties_count < i_properties_capacity / 2 then 871 | redim preserve arr(i_properties_count * 1.2 + 1) 872 | i_properties_capacity = ubound(i_properties) + 1 873 | end if 874 | 875 | ArraySlice = arr 876 | end function 877 | 878 | ' Load properties from an ADO RecordSet object into an array 879 | ' @param rs as ADODB.RecordSet 880 | public sub LoadRecordSet(byref rs) 881 | dim arr, obj, field 882 | 883 | set arr = new JSONArray 884 | 885 | while not rs.eof 886 | set obj = new JSONobject 887 | 888 | for each field in rs.fields 889 | obj.Add field.name, field.value 890 | next 891 | 892 | arr.Push obj 893 | 894 | rs.movenext 895 | wend 896 | 897 | set obj = nothing 898 | 899 | change i_defaultPropertyName, arr 900 | end sub 901 | 902 | ' Load properties from the first record of an ADO RecordSet object 903 | ' @param rs as ADODB.RecordSet 904 | public sub LoadFirstRecord(byref rs) 905 | dim field 906 | 907 | for each field in rs.fields 908 | add field.name, field.value 909 | next 910 | end sub 911 | 912 | ' Returns the value's type name (usefull for types not supported by VBS) 913 | public function GetTypeName(byval value) 914 | dim valueType 915 | 916 | on error resume next 917 | valueType = TypeName(value) 918 | 919 | if err.number <> 0 then 920 | select case varType(value) 921 | case 14 ' MySQL Decimal 922 | valueType = "Decimal" 923 | case 16 ' MySQL TinyInt 924 | valueType = "Integer" 925 | end select 926 | end if 927 | on error goto 0 928 | 929 | GetTypeName = valueType 930 | end function 931 | 932 | ' Escapes special characters in the text 933 | ' @param text as String 934 | public function EscapeCharacters(byval text) 935 | dim result 936 | 937 | result = text 938 | 939 | if not isNull(text) then 940 | result = cstr(result) 941 | 942 | result = replace(result, "\", "\\") 943 | result = replace(result, """", "\""") 944 | result = replace(result, vbcr, "\r") 945 | result = replace(result, vblf, "\n") 946 | result = replace(result, vbtab, "\t") 947 | result = replace(result, vbback, "\b") 948 | end if 949 | 950 | EscapeCharacters = result 951 | end function 952 | 953 | ' Used to write the log messages to the response on debug mode 954 | private sub log(byval msg) 955 | if i_debug then response.write "
  • " & msg & "
    • " & vbcrlf 956 | end sub 957 | end class 958 | 959 | 960 | ' JSON array class 961 | ' Represents an array of JSON objects and values 962 | class JSONarray 963 | dim i_items, i_depth, i_parent, i_version, i_defaultPropertyName 964 | dim i_items_count, i_items_capacity 965 | 966 | ' The class version 967 | public property get version 968 | version = i_version 969 | end property 970 | 971 | ' The actual array items 972 | public property get items 973 | dim tmp 974 | tmp = i_items 975 | if i_items_count < i_items_capacity then 976 | redim preserve tmp(i_items_count - 1) 977 | end if 978 | items = tmp 979 | end property 980 | 981 | public property let items(value) 982 | if isArray(value) then 983 | i_items = value 984 | i_items_count = ubound(value) + 1 985 | i_items_capacity = i_items_count 986 | else 987 | err.raise JSON_ERROR_NOT_AN_ARRAY, TypeName(me), "The value assigned is not an array." 988 | end if 989 | end property 990 | 991 | ' The capacity of the underlying array 992 | public property get capacity 993 | capacity = i_items_capacity 994 | end property 995 | 996 | ' The length of the array 997 | public property get length 998 | length = i_items_count 999 | end property 1000 | 1001 | ' The depth of the array in the chain (starting with 1) 1002 | public property get depth 1003 | depth = i_depth 1004 | end property 1005 | 1006 | ' The parent object or array 1007 | public property get parent 1008 | set parent = i_parent 1009 | end property 1010 | 1011 | public property set parent(value) 1012 | set i_parent = value 1013 | i_depth = i_parent.depth + 1 1014 | i_defaultPropertyName = i_parent.defaultPropertyName 1015 | end property 1016 | 1017 | ' Gets/sets the default property name generated when loading recordsets and arrays (default "data") 1018 | public property get defaultPropertyName 1019 | defaultPropertyName = i_defaultPropertyName 1020 | end property 1021 | 1022 | public property let defaultPropertyName(value) 1023 | i_defaultPropertyName = value 1024 | end property 1025 | 1026 | 1027 | 1028 | ' Constructor and destructor 1029 | private sub class_initialize 1030 | i_version = "2.4.0" 1031 | i_defaultPropertyName = JSON_DEFAULT_PROPERTY_NAME 1032 | redim i_items(-1) 1033 | i_items_count = 0 1034 | i_items_capacity = 0 1035 | i_depth = 0 1036 | end sub 1037 | 1038 | private sub class_terminate 1039 | dim i, j, js, dimensions 1040 | 1041 | dimensions = 0 1042 | 1043 | On Error Resume Next 1044 | 1045 | Do While Err.number = 0 1046 | dimensions = dimensions + 1 1047 | UBound i_items, dimensions 1048 | Loop 1049 | 1050 | On Error Goto 0 1051 | 1052 | dimensions = dimensions - 1 1053 | 1054 | for i = 1 to dimensions 1055 | for j = 0 to ubound(i_items, i) 1056 | if dimensions = 1 then 1057 | set i_items(j) = nothing 1058 | else 1059 | set i_items(i - 1, j) = nothing 1060 | end if 1061 | next 1062 | next 1063 | end sub 1064 | 1065 | ' Adds a value to the array 1066 | public sub Push(byref value) 1067 | if i_items_count >= i_items_capacity then 1068 | redim preserve i_items(i_items_capacity * 1.2 + 1) 1069 | i_items_capacity = ubound(i_items) + 1 1070 | end if 1071 | 1072 | if isobject(value) then 1073 | set i_items(i_items_count) = value 1074 | else 1075 | i_items(i_items_count) = value 1076 | end if 1077 | 1078 | i_items_count = i_items_count + 1 1079 | end sub 1080 | 1081 | ' Load properties from a ADO RecordSet object 1082 | public sub LoadRecordSet(byref rs) 1083 | dim obj, field 1084 | 1085 | while not rs.eof 1086 | set obj = new JSONobject 1087 | 1088 | for each field in rs.fields 1089 | obj.Add field.name, field.value 1090 | next 1091 | 1092 | Push obj 1093 | 1094 | rs.movenext 1095 | wend 1096 | 1097 | set obj = nothing 1098 | end sub 1099 | 1100 | ' Returns the item at the specified index 1101 | ' @param index as int - the desired item index 1102 | public default function ItemAt(byval index) 1103 | dim len 1104 | len = me.length 1105 | 1106 | if len > 0 and index < len then 1107 | if isObject(i_items(index)) then 1108 | set ItemAt = i_items(index) 1109 | else 1110 | ItemAt = i_items(index) 1111 | end if 1112 | else 1113 | err.raise JSON_ERROR_INDEX_OUT_OF_BOUNDS, TypeName(me), "Index out of bounds." 1114 | end if 1115 | end function 1116 | 1117 | ' Serializes this JSONarray object in JSON formatted string value 1118 | ' (uses the JSONobject.SerializeArray method) 1119 | public function Serialize() 1120 | dim js, out, instantiated, actualLCID 1121 | 1122 | actualLCID = Response.LCID 1123 | Response.LCID = 1033 1124 | 1125 | if not isEmpty(i_parent) then 1126 | if TypeName(i_parent) = "JSONobject" then 1127 | set js = i_parent 1128 | i_defaultPropertyName = i_parent.defaultPropertyName 1129 | end if 1130 | end if 1131 | 1132 | if isEmpty(js) then 1133 | set js = new JSONobject 1134 | js.defaultPropertyName = i_defaultPropertyName 1135 | instantiated = true 1136 | end if 1137 | 1138 | out = js.SerializeArray(me) 1139 | 1140 | if instantiated then set js = nothing 1141 | 1142 | Response.LCID = actualLCID 1143 | 1144 | Serialize = out 1145 | end function 1146 | 1147 | ' Writes the serialized array to the response 1148 | public function Write() 1149 | Response.Write Serialize() 1150 | end function 1151 | end class 1152 | 1153 | 1154 | class JSONscript 1155 | dim i_version 1156 | dim s_value, s_nullString 1157 | 1158 | ' The value 1159 | public property get value 1160 | value = s_value 1161 | end property 1162 | 1163 | public property let value(newValue) 1164 | if (TypeName(newValue) <> "String") then 1165 | err.raise JSON_ERROR_NOT_A_STRING, TypeName(me), "The value assigned is not a string." 1166 | end if 1167 | 1168 | if (len(newValue) = 0) then newValue = s_nullString 1169 | s_value = newValue 1170 | end property 1171 | 1172 | ' Constructor and destructor 1173 | private sub class_initialize() 1174 | i_version = "1.0.0" 1175 | 1176 | s_nullString = "null" 1177 | s_value = s_nullString 1178 | end sub 1179 | 1180 | ' Serializes this object by outputting the raw value 1181 | public function Serialize() 1182 | Serialize = s_value 1183 | end function 1184 | 1185 | ' Writes the serialized object to the response 1186 | public function Write() 1187 | Response.Write Serialize() 1188 | end function 1189 | end class 1190 | 1191 | 1192 | ' JSON pair class 1193 | ' represents a name/value pair of a JSON object 1194 | class JSONpair 1195 | dim i_name, i_value 1196 | dim i_parent 1197 | 1198 | ' The name or key of the pair 1199 | public property get name 1200 | name = i_name 1201 | end property 1202 | 1203 | public property let name(val) 1204 | i_name = val 1205 | end property 1206 | 1207 | ' The value of the pair 1208 | public property get value 1209 | if isObject(i_value) then 1210 | set value = i_value 1211 | else 1212 | value = i_value 1213 | end if 1214 | end property 1215 | 1216 | public property let value(val) 1217 | i_value = val 1218 | end property 1219 | 1220 | public property set value(val) 1221 | set i_value = val 1222 | end property 1223 | 1224 | ' The parent object 1225 | public property get parent 1226 | set parent = i_parent 1227 | end property 1228 | 1229 | public property set parent(val) 1230 | set i_parent = val 1231 | end property 1232 | 1233 | 1234 | ' Constructor and destructor 1235 | private sub class_initialize 1236 | end sub 1237 | 1238 | private sub class_terminate 1239 | if isObject(value) then set value = nothing 1240 | end sub 1241 | end class 1242 | %> 1243 | --------------------------------------------------------------------------------