1<%
2 '
3 ' Copyright (c) 2003-2010, CKSource - Frederico Knabben. All rights reserved.
4 ' For licensing, see LICENSE.html or http://ckeditor.com/license
5
6' Shared variable for all instances ("static")
7dim CKEDITOR_initComplete
8dim CKEDITOR_returnedEvents
9
10 ''
11 ' \brief CKEditor class that can be used to create editor
12 ' instances in ASP pages on server side.
13 ' @see http://ckeditor.com
14 '
15 ' Sample usage:
16 ' @code
17 ' editor = new CKEditor
18 ' editor.editor "editor1", "<p>Initial value.</p>", empty, empty
19 ' @endcode
20
21Class CKEditor
22
23	''
24	' The version of %CKEditor.
25	private version
26
27	''
28	' A constant string unique for each release of %CKEditor.
29	private mTimeStamp
30
31	''
32	' URL to the %CKEditor installation directory (absolute or relative to document root).
33	' If not set, CKEditor will try to guess it's path.
34	'
35	' Example usage:
36	' @code
37	' editor.basePath = "/ckeditor/"
38	' @endcode
39	Public basePath
40
41	''
42	' A boolean variable indicating whether CKEditor has been initialized.
43	' Set it to true only if you have already included
44	' &lt;script&gt; tag loading ckeditor.js in your website.
45	Public initialized
46
47	''
48	' Boolean variable indicating whether created code should be printed out or returned by a function.
49	'
50	' Example 1: get the code creating %CKEditor instance and print it on a page with the "echo" function.
51	' @code
52	' editor = new CKEditor
53	' editor.returnOutput = true
54	' code = editor.editor("editor1", "<p>Initial value.</p>", empty, empty)
55	' response.write "<p>Editor 1:</p>"
56	' response.write code
57	' @endcode
58	Public returnOutput
59
60	''
61	' A Dictionary with textarea attributes.
62	'
63	' When %CKEditor is created with the editor() method, a HTML &lt;textarea&gt; element is created,
64	' it will be displayed to anyone with JavaScript disabled or with incompatible browser.
65	public textareaAttributes
66
67	''
68	' A string indicating the creation date of %CKEditor.
69	' Do not change it unless you want to force browsers to not use previously cached version of %CKEditor.
70	public timestamp
71
72	''
73	' A dictionary that holds the instance configuration.
74	private oInstanceConfig
75
76	''
77	' A dictionary that holds the configuration for all the instances.
78	private oAllInstancesConfig
79
80	''
81	' A dictionary that holds event listeners for the instance.
82	private oInstanceEvents
83
84	''
85	' A dictionary that holds event listeners for all the instances.
86	private oAllInstancesEvents
87
88	''
89	' A Dictionary that holds global event listeners (CKEDITOR object)
90	private oGlobalEvents
91
92
93	Private Sub Class_Initialize()
94		version = "3.4.2"
95		timeStamp = "AA4E4NT"
96		mTimeStamp = "AA4E4NT"
97
98		Set oInstanceConfig = CreateObject("Scripting.Dictionary")
99		Set oAllInstancesConfig = CreateObject("Scripting.Dictionary")
100
101		Set oInstanceEvents = CreateObject("Scripting.Dictionary")
102		Set oAllInstancesEvents = CreateObject("Scripting.Dictionary")
103		Set oGlobalEvents = CreateObject("Scripting.Dictionary")
104
105		Set textareaAttributes = CreateObject("Scripting.Dictionary")
106		textareaAttributes.Add "rows", 8
107		textareaAttributes.Add "cols", 60
108	End Sub
109
110	''
111	 ' Creates a %CKEditor instance.
112	 ' In incompatible browsers %CKEditor will downgrade to plain HTML &lt;textarea&gt; element.
113	 '
114	 ' @param name (string) Name of the %CKEditor instance (this will be also the "name" attribute of textarea element).
115	 ' @param value (string) Initial value.
116	 '
117	 ' Example usage:
118	 ' @code
119	 ' set editor = New CKEditor
120	 ' editor.editor "field1", "<p>Initial value.</p>"
121	 ' @endcode
122	 '
123	 ' Advanced example:
124	 ' @code
125	 ' set editor = new CKEditor
126	 ' set config = CreateObject("Scripting.Dictionary")
127	 ' config.Add "toolbar", Array( _
128	 '	Array( "Source", "-", "Bold", "Italic", "Underline", "Strike" ), _
129	 '	Array( "Image", "Link", "Unlink", "Anchor" ) _
130	 ' )
131	 ' set events = CreateObject("Scripting.Dictionary")
132	 ' events.Add "instanceReady", "function (evt) { alert('Loaded second editor: ' + evt.editor.name );}"
133
134	 ' editor.editor "field1", "<p>Initial value.</p>", config, events
135	 ' @endcode
136	 '
137	public function editor(name, value)
138		dim attr, out, js, customConfig, extraConfig
139		dim attribute
140
141		attr = ""
142
143		for each attribute in textareaAttributes
144			attr = attr & " " &  attribute & "=""" & replace( textareaAttributes( attribute ), """", "&quot" ) & """"
145		next
146
147		out = "<textarea name=""" & name & """" & attr & ">" & Server.HtmlEncode(value) & "</textarea>" & vbcrlf
148
149		if not(initialized) then
150			out = out & init()
151		end if
152
153		set customConfig = configSettings()
154		js = returnGlobalEvents()
155
156		extraConfig = (new JSON)( empty, customConfig, false )
157		if extraConfig<>"" then extraConfig = ", " & extraConfig
158		js = js & "CKEDITOR.replace('" & name & "'" & extraConfig & ");"
159
160		out = out & script(js)
161
162		if not(returnOutput) then
163			response.write out
164			out = ""
165		end if
166
167		editor = out
168
169		oInstanceConfig.RemoveAll
170		oInstanceEvents.RemoveAll
171	end function
172
173	''
174	 ' Replaces a &lt;textarea&gt; with a %CKEditor instance.
175	 '
176	 ' @param id (string) The id or name of textarea element.
177	 '
178	 ' Example 1: adding %CKEditor to &lt;textarea name="article"&gt;&lt;/textarea&gt; element:
179	 ' @code
180	 ' set editor = New CKEditor
181	 ' editor.replace "article"
182	 ' @endcode
183	 '
184	public function replaceInstance(id)
185		dim out, js, customConfig, extraConfig
186
187		out = ""
188		if not(initialized) then
189			out = out & init()
190		end if
191
192		set customConfig = configSettings()
193		js = returnGlobalEvents()
194
195		extraConfig = (new JSON)( empty, customConfig, false )
196		if extraConfig<>"" then extraConfig = ", " & extraConfig
197		js = js & "CKEDITOR.replace('" & id & "'" & extraConfig & ");"
198
199		out = out & script(js)
200
201		if not(returnOutput) then
202			response.write out
203			out = ""
204		end if
205
206		replaceInstance = out
207
208		oInstanceConfig.RemoveAll
209		oInstanceEvents.RemoveAll
210	end function
211
212	''
213	 ' Replace all &lt;textarea&gt; elements available in the document with editor instances.
214	 '
215	 ' @param className (string) If set, replace all textareas with class className in the page.
216	 '
217	 ' Example 1: replace all &lt;textarea&gt; elements in the page.
218	 ' @code
219	 ' editor = new CKEditor
220	 ' editor.replaceAll empty
221	 ' @endcode
222	 '
223	 ' Example 2: replace all &lt;textarea class="myClassName"&gt; elements in the page.
224	 ' @code
225	 ' editor = new CKEditor
226	 ' editor.replaceAll 'myClassName'
227	 ' @endcode
228	 '
229	function replaceAll(className)
230		dim out, js, customConfig
231
232		out = ""
233		if not(initialized) then
234			out = out & init()
235		end if
236
237		set customConfig = configSettings()
238		js = returnGlobalEvents()
239
240		if (customConfig.Count=0) then
241			if (isEmpty(className)) then
242				js = js & "CKEDITOR.replaceAll();"
243			else
244				js = js & "CKEDITOR.replaceAll('" & className & "');"
245			end if
246		else
247			js = js & "CKEDITOR.replaceAll( function(textarea, config) {\n"
248			if not(isEmpty(className)) then
249				js = js & "	var classRegex = new RegExp('(?:^| )' + '" & className & "' + '(?:$| )');\n"
250				js = js & "	if (!classRegex.test(textarea.className))\n"
251				js = js & "		return false;\n"
252			end if
253			js = js & "	CKEDITOR.tools.extend(config, " & (new JSON)( empty, customConfig, false ) & ", true);"
254			js = js & "} );"
255		end if
256
257		out = out & script(js)
258
259		if not(returnOutput) then
260			response.write out
261			out = ""
262		end if
263
264		replaceAll = out
265
266		oInstanceConfig.RemoveAll
267		oInstanceEvents.RemoveAll
268	end function
269
270
271	''
272	' A Dictionary that holds the %CKEditor configuration for all instances
273	' For the list of available options, see http://docs.cksource.com/ckeditor_api/symbols/CKEDITOR.config.html
274	'
275	' Example usage:
276	' @code
277	' editor.config("height") = 400
278	' // Use @@ at the beggining of a string to ouput it without surrounding quotes.
279	' editor.config("width") = "@@screen.width * 0.8"
280	' @endcode
281	Public Property Let Config( configKey, configValue )
282		oAllInstancesConfig.Add configKey, configValue
283	End Property
284
285	''
286	' Configuration options for the next instance
287	'
288	Public Property Let instanceConfig( configKey, configValue )
289		oInstanceConfig.Add configKey, configValue
290	End Property
291
292	''
293	 ' Adds event listener.
294	 ' Events are fired by %CKEditor in various situations.
295	 '
296	 ' @param eventName (string) Event name.
297	 ' @param javascriptCode (string) Javascript anonymous function or function name.
298	 '
299	 ' Example usage:
300	 ' @code
301	 ' editor.addEventHandler  "instanceReady", "function (ev) { " & _
302	 '    " alert('Loaded: ' + ev.editor.name); " & _
303	 ' "}"
304	 ' @endcode
305	 '
306	public sub addEventHandler(eventName, javascriptCode)
307		if not(oAllInstancesEvents.Exists( eventName ) ) then
308			oAllInstancesEvents.Add eventName, Array()
309		end if
310
311		dim listeners, size
312		listeners = oAllInstancesEvents( eventName )
313		size = ubound(listeners) + 1
314		redim preserve listeners(size)
315		listeners(size) = javascriptCode
316
317		oAllInstancesEvents( eventName ) = listeners
318'		'' Avoid duplicates. fixme...
319'		if (!in_array($javascriptCode, $this->_events[$event])) {
320'			$this->_events[$event][] = $javascriptCode;
321'		}
322	end sub
323
324	''
325	 ' Clear registered event handlers.
326	 ' Note: this function will have no effect on already created editor instances.
327	 '
328	 ' @param eventName (string) Event name, if set to 'empty' all event handlers will be removed.
329	 '
330	public sub clearEventHandlers( eventName )
331		if not(isEmpty( eventName )) then
332			oAllInstancesEvents.Remove eventName
333		else
334			oAllInstancesEvents.RemoveAll
335		end if
336	end sub
337
338
339	''
340	 ' Adds event listener only for the next instance.
341	 ' Events are fired by %CKEditor in various situations.
342	 '
343	 ' @param eventName (string) Event name.
344	 ' @param javascriptCode (string) Javascript anonymous function or function name.
345	 '
346	 ' Example usage:
347	 ' @code
348	 ' editor.addInstanceEventHandler  "instanceReady", "function (ev) { " & _
349	 '    " alert('Loaded: ' + ev.editor.name); " & _
350	 ' "}"
351	 ' @endcode
352	 '
353	public sub addInstanceEventHandler(eventName, javascriptCode)
354		if not(oInstanceEvents.Exists( eventName ) ) then
355			oInstanceEvents.Add eventName, Array()
356		end if
357
358		dim listeners, size
359		listeners = oInstanceEvents( eventName )
360		size = ubound(listeners) + 1
361		redim preserve listeners(size)
362		listeners(size) = javascriptCode
363
364		oInstanceEvents( eventName ) = listeners
365'		'' Avoid duplicates. fixme...
366'		if (!in_array($javascriptCode, $this->_events[$event])) {
367'			$this->_events[$event][] = $javascriptCode;
368'		}
369	end sub
370
371	''
372	 ' Clear registered event handlers.
373	 ' Note: this function will have no effect on already created editor instances.
374	 '
375	 ' @param eventName (string) Event name, if set to 'empty' all event handlers will be removed.
376	 '
377	public sub clearInstanceEventHandlers( eventName )
378		if not(isEmpty( eventName )) then
379			oInstanceEvents.Remove eventName
380		else
381			oInstanceEvents.RemoveAll
382		end if
383	end sub
384
385	''
386	 ' Adds global event listener.
387	 '
388	 ' @param event (string) Event name.
389	 ' @param javascriptCode (string) Javascript anonymous function or function name.
390	 '
391	 ' Example usage:
392	 ' @code
393	 ' editor.addGlobalEventHandler "dialogDefinition", "function (ev) { " & _
394	 '   "  alert('Loading dialog: ' + ev.data.name); " & _
395	 ' "}"
396	 ' @endcode
397	 '
398	public sub addGlobalEventHandler( eventName, javascriptCode)
399		if not(oGlobalEvents.Exists( eventName ) ) then
400			oGlobalEvents.Add eventName, Array()
401		end if
402
403		dim listeners, size
404		listeners = oGlobalEvents( eventName )
405		size = ubound(listeners) + 1
406		redim preserve listeners(size)
407		listeners(size) = javascriptCode
408
409		oGlobalEvents( eventName ) = listeners
410
411'		// Avoid duplicates.
412'		if (!in_array($javascriptCode, $this->_globalEvents[$event])) {
413'			$this->_globalEvents[$event][] = $javascriptCode;
414'		}
415	end sub
416
417	''
418	 ' Clear registered global event handlers.
419	 ' Note: this function will have no effect if the event handler has been already printed/returned.
420	 '
421	 ' @param eventName (string) Event name, if set to 'empty' all event handlers will be removed .
422	 '
423	public sub clearGlobalEventHandlers( eventName )
424		if not(isEmpty( eventName )) then
425			oGlobalEvents.Remove eventName
426		else
427			oGlobalEvents.RemoveAll
428		end if
429	end sub
430
431	''
432	 ' Prints javascript code.
433	 '
434	 ' @param string js
435	 '
436	private function script(js)
437		script = "<script type=""text/javascript"">" & _
438			"//<![CDATA[" & vbcrlf & _
439			js & vbcrlf & _
440			"//]]>" & _
441			"</script>" & vbcrlf
442	end function
443
444	''
445	 ' Returns the configuration array (global and instance specific settings are merged into one array).
446	 '
447	 ' @param instanceConfig (Dictionary) The specific configurations to apply to editor instance.
448	 ' @param instanceEvents (Dictionary) Event listeners for editor instance.
449	 '
450	private function configSettings()
451		dim mergedConfig, mergedEvents
452		set mergedConfig = cloneDictionary(oAllInstancesConfig)
453		set mergedEvents = cloneDictionary(oAllInstancesEvents)
454
455		if not(isEmpty(oInstanceConfig)) then
456			set mergedConfig = mergeDictionary(mergedConfig, oInstanceConfig)
457		end if
458
459		if not(isEmpty(oInstanceEvents)) then
460			for each eventName in oInstanceEvents
461				code = oInstanceEvents( eventName )
462
463				if not(mergedEvents.Exists( eventName)) then
464					mergedEvents.Add eventName, code
465				else
466
467					dim listeners, size
468					listeners = mergedEvents( eventName )
469					size = ubound(listeners)
470					if isArray( code ) then
471						addedCount = ubound(code)
472						redim preserve listeners( size + addedCount + 1 )
473						for i = 0 to addedCount
474							listeners(size + i + 1) = code (i)
475						next
476					else
477						size = size + 1
478						redim preserve listeners(size)
479						listeners(size) = code
480					end if
481
482					mergedEvents( eventName ) = listeners
483				end if
484			next
485
486		end if
487
488		dim i, eventName, handlers, configON, ub, code
489
490		if mergedEvents.Count>0 then
491			if mergedConfig.Exists( "on" ) then
492				set configON = mergedConfig.items( "on" )
493			else
494				set configON = CreateObject("Scripting.Dictionary")
495				mergedConfig.Add "on", configOn
496			end if
497
498			for each eventName in mergedEvents
499				handlers = mergedEvents( eventName )
500				code = ""
501
502				if isArray(handlers) then
503					uB = ubound(handlers)
504					if (uB = 0) then
505						code = handlers(0)
506					else
507						code = "function (ev) {"
508						for i=0 to uB
509							code = code & "(" & handlers(i) & ")(ev);"
510						next
511						code = code & "}"
512					end if
513				else
514					code = handlers
515				end if
516				' Using @@ at the beggining to signal JSON that we don't want this quoted.
517				configON.Add eventName, "@@" & code
518			next
519
520'			set mergedConfig.Item("on") = configOn
521		end if
522
523		set configSettings = mergedConfig
524	end function
525
526	 ''
527		' Returns a copy of a scripting.dictionary object
528		'
529	private function cloneDictionary( base )
530		dim newOne, tmpKey
531
532		Set newOne = CreateObject("Scripting.Dictionary")
533		for each tmpKey in base
534			newOne.Add tmpKey , base( tmpKey )
535		next
536
537		set cloneDictionary = newOne
538	end function
539
540	 ''
541		' Combines two scripting.dictionary objects
542		' The base object isn't modified, and extra gets all the properties in base
543		'
544	private function mergeDictionary(base, extra)
545		dim newOne, tmpKey
546
547		for each tmpKey in base
548			if not(extra.Exists( tmpKey )) then
549				extra.Add tmpKey, base( tmpKey )
550			end if
551		next
552
553		set mergeDictionary = extra
554	end function
555
556	''
557	 ' Return global event handlers.
558	 '
559	private function returnGlobalEvents()
560		dim out, eventName, handlers
561		dim handlersForEvent, handler, code, i
562		out = ""
563
564		if (isempty(CKEDITOR_returnedEvents)) then
565			set CKEDITOR_returnedEvents = CreateObject("Scripting.Dictionary")
566		end if
567
568		for each eventName in oGlobalEvents
569			handlers = oGlobalEvents( eventName )
570
571			if not(CKEDITOR_returnedEvents.Exists(eventName)) then
572				CKEDITOR_returnedEvents.Add eventName, CreateObject("Scripting.Dictionary")
573			end if
574
575				set handlersForEvent = CKEDITOR_returnedEvents.Item( eventName )
576
577				' handlersForEvent is another dictionary
578				' and handlers is an array
579
580				for i = 0 to ubound(handlers)
581					code = handlers( i )
582
583					' Return only new events
584					if not(handlersForEvent.Exists( code )) then
585						if (out <> "") then out = out & vbcrlf
586						out = out & "CKEDITOR.on('" &  eventName & "', " & code & ");"
587						handlersForEvent.Add code, code
588					end if
589				next
590		next
591
592		returnGlobalEvents = out
593	end function
594
595	''
596	 ' Initializes CKEditor (executed only once).
597	 '
598	private function init()
599		dim out, args, path, extraCode, file
600		out = ""
601
602		if (CKEDITOR_initComplete) then
603			init = ""
604			exit function
605		end if
606
607		if (initialized) then
608			CKEDITOR_initComplete = true
609			init = ""
610			exit function
611		end if
612
613		args = ""
614		path = ckeditorPath()
615
616		if (timestamp <> "") and (timestamp <> "%" & "TIMESTAMP%") then
617			args = "?t=" & timestamp
618		end if
619
620		' Skip relative paths...
621		if (instr(path, "..") <> 0) then
622			out = out & script("window.CKEDITOR_BASEPATH='" &  path  & "';")
623		end if
624
625		out = out & "<scr" & "ipt type=""text/javascript"" src=""" & path & ckeditorFileName() & args & """></scr" & "ipt>" & vbcrlf
626
627		extraCode = ""
628		if (timestamp <> mTimeStamp) then
629			extraCode = extraCode & "CKEDITOR.timestamp = '" & timestamp & "';"
630		end if
631		if (extraCode <> "") then
632			out = out & script(extraCode)
633		end if
634
635		CKEDITOR_initComplete = true
636		initialized = true
637
638		init = out
639	end function
640
641	private function ckeditorFileName()
642		ckeditorFileName = "ckeditor.js"
643	end function
644
645	''
646	 ' Return path to ckeditor.js.
647	 '
648	private function ckeditorPath()
649		if (basePath <> "") then
650			ckeditorPath = basePath
651		else
652			' In classic ASP we can't get the location of this included script
653			ckeditorPath = "/ckeditor/"
654		end if
655
656		' Try to check if that folder contains the CKEditor files:
657		' If it's a full URL avoid checking it as it might point to an external server.
658		if (instr(ckeditorPath, "://") <> 0) then exit function
659
660		dim filename, oFSO, exists
661		filename = server.mapPath(basePath & ckeditorFileName())
662		set oFSO = Server.CreateObject("Scripting.FileSystemObject")
663		exists = oFSO.FileExists(filename)
664		set oFSO = nothing
665
666		if not(exists) then
667			response.clear
668			response.write "<h1>CKEditor path validation failed</h1>"
669			response.write "<p>The path &quot;" & ckeditorPath & "&quot; doesn't include the CKEditor main file (" & ckeditorFileName() & ")</p>"
670			response.write "<p>Please, verify that you have set it correctly and/or adjust the 'basePath' property</p>"
671			response.write "<p>Checked for physical file: &quot;" & filename & "&quot;</p>"
672			response.end
673		end if
674	end function
675
676End Class
677
678
679
680' URL: http://www.webdevbros.net/2007/04/26/generate-json-from-asp-datatypes/
681'**************************************************************************************************************
682'' @CLASSTITLE:		JSON
683'' @CREATOR:		Michal Gabrukiewicz (gabru at grafix.at), Michael Rebec
684'' @CONTRIBUTORS:	- Cliff Pruitt (opensource at crayoncowboy.com)
685''					- Sylvain Lafontaine
686''					- Jef Housein
687''					- Jeremy Brown
688'' @CREATEDON:		2007-04-26 12:46
689'' @CDESCRIPTION:	Comes up with functionality for JSON (http://json.org) to use within ASP.
690''					Correct escaping of characters, generating JSON Grammer out of ASP datatypes and structures
691''					Some examples (all use the <em>toJSON()</em> method but as it is the class' default method it can be left out):
692''					<code>
693''					<%
694''					'simple number
695''					output = (new JSON)("myNum", 2, false)
696''					'generates {"myNum": 2}
697''
698''					'array with different datatypes
699''					output = (new JSON)("anArray", array(2, "x", null), true)
700''					'generates "anArray": [2, "x", null]
701''					'(note: the last parameter was true, thus no surrounding brackets in the result)
702''					% >
703''					</code>
704'' @REQUIRES:		-
705'' @OPTIONEXPLICIT:	yes
706'' @VERSION:		1.5.1
707
708'**************************************************************************************************************
709class JSON
710
711	'private members
712	private output, innerCall
713
714	'**********************************************************************************************************
715	'* constructor
716	'**********************************************************************************************************
717	public sub class_initialize()
718		newGeneration()
719	end sub
720
721	'******************************************************************************************
722	'' @SDESCRIPTION:	STATIC! takes a given string and makes it JSON valid
723	'' @DESCRIPTION:	all characters which needs to be escaped are beeing replaced by their
724	''					unicode representation according to the
725	''					RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627
726	'' @PARAM:			val [string]: value which should be escaped
727	'' @RETURN:			[string] JSON valid string
728	'******************************************************************************************
729	public function escape(val)
730		dim cDoubleQuote, cRevSolidus, cSolidus
731		cDoubleQuote = &h22
732		cRevSolidus = &h5C
733		cSolidus = &h2F
734		dim i, currentDigit
735		for i = 1 to (len(val))
736			currentDigit = mid(val, i, 1)
737			if ascw(currentDigit) > &h00 and ascw(currentDigit) < &h1F then
738				currentDigit = escapequence(currentDigit)
739			elseif ascw(currentDigit) >= &hC280 and ascw(currentDigit) <= &hC2BF then
740				currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC200), 2, 0), 2)
741			elseif ascw(currentDigit) >= &hC380 and ascw(currentDigit) <= &hC3BF then
742				currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC2C0), 2, 0), 2)
743			else
744				select case ascw(currentDigit)
745					case cDoubleQuote: currentDigit = escapequence(currentDigit)
746					case cRevSolidus: currentDigit = escapequence(currentDigit)
747					case cSolidus: currentDigit = escapequence(currentDigit)
748				end select
749			end if
750			escape = escape & currentDigit
751		next
752	end function
753
754	'******************************************************************************************************************
755	'' @SDESCRIPTION:	generates a representation of a name value pair in JSON grammer
756	'' @DESCRIPTION:	It generates a name value pair which is represented as <em>{"name": value}</em> in JSON.
757	''					the generation is fully recursive. Thus the value can also be a complex datatype (array in dictionary, etc.) e.g.
758	''					<code>
759	''					<%
760	''					set j = new JSON
761	''					j.toJSON "n", array(RS, dict, false), false
762	''					j.toJSON "n", array(array(), 2, true), false
763	''					% >
764	''					</code>
765	'' @PARAM:			name [string]: name of the value (accessible with javascript afterwards). leave empty to get just the value
766	'' @PARAM:			val [variant], [int], [float], [array], [object], [dictionary]: value which needs
767	''					to be generated. Conversation of the data types is as follows:<br>
768	''					- <strong>ASP datatype -> JavaScript datatype</strong>
769	''					- NOTHING, NULL -> null
770	''					- INT, DOUBLE -> number
771	''					- STRING -> string
772	''					- BOOLEAN -> bool
773	''					- ARRAY -> array
774	''					- DICTIONARY -> Represents it as name value pairs. Each key is accessible as property afterwards. json will look like <code>"name": {"key1": "some value", "key2": "other value"}</code>
775	''					- <em>multidimensional array</em> -> Generates a 1-dimensional array (flat) with all values of the multidimensional array
776	''					- <em>request</em> object -> every property and collection (cookies, form, querystring, etc) of the asp request object is exposed as an item of a dictionary. Property names are <strong>lowercase</strong>. e.g. <em>servervariables</em>.
777	''					- OBJECT -> name of the type (if unknown type) or all its properties (if class implements <em>reflect()</em> method)
778	''					Implement a <strong>reflect()</strong> function if you want your custom classes to be recognized. The function must return
779	''					a dictionary where the key holds the property name and the value its value. Example of a reflect function within a User class which has firstname and lastname properties
780	''					<code>
781	''					<%
782	''					function reflect()
783	''					.	set reflect = server.createObject("scripting.dictionary")
784	''					.	reflect.add "firstname", firstname
785	''					.	reflect.add "lastname", lastname
786	''					end function
787	''					% >
788	''					</code>
789	''					Example of how to generate a JSON representation of the asp request object and access the <em>HTTP_HOST</em> server variable in JavaScript:
790	''					<code>
791	''					<script>alert(<%= (new JSON)(empty, request, false) % >.servervariables.HTTP_HOST);</script>
792	''					</code>
793	'' @PARAM:			nested [bool]: indicates if the name value pair is already nested within another? if yes then the <em>{}</em> are left out.
794	'' @RETURN:			[string] returns a JSON representation of the given name value pair
795	'******************************************************************************************************************
796	public default function toJSON(name, val, nested)
797		if not nested and not isEmpty(name) then write("{")
798		if not isEmpty(name) then write("""" & escape(name) & """: ")
799		generateValue(val)
800		if not nested and not isEmpty(name) then write("}")
801		toJSON = output
802
803		if innerCall = 0 then newGeneration()
804	end function
805
806	'******************************************************************************************************************
807	'* generate
808	'******************************************************************************************************************
809	private function generateValue(val)
810		if isNull(val) then
811			write("null")
812		elseif isArray(val) then
813			generateArray(val)
814		elseif isObject(val) then
815			dim tName : tName = typename(val)
816			if val is nothing then
817				write("null")
818			elseif tName = "Dictionary" or tName = "IRequestDictionary" then
819				generateDictionary(val)
820			elseif tName = "IRequest" then
821				set req = server.createObject("scripting.dictionary")
822				req.add "clientcertificate", val.ClientCertificate
823				req.add "cookies", val.cookies
824				req.add "form", val.form
825				req.add "querystring", val.queryString
826				req.add "servervariables", val.serverVariables
827				req.add "totalbytes", val.totalBytes
828				generateDictionary(req)
829			elseif tName = "IStringList" then
830				if val.count = 1 then
831					toJSON empty, val(1), true
832				else
833					generateArray(val)
834				end if
835			else
836				generateObject(val)
837			end if
838		else
839			'bool
840			dim varTyp
841			varTyp = varType(val)
842			if varTyp = 11 then
843				if val then write("true") else write("false")
844			'int, long, byte
845			elseif varTyp = 2 or varTyp = 3 or varTyp = 17 or varTyp = 19 then
846				write(cLng(val))
847			'single, double, currency
848			elseif varTyp = 4 or varTyp = 5 or varTyp = 6 or varTyp = 14 then
849				write(replace(cDbl(val), ",", "."))
850			else
851				' Using @@ at the beggining to signal JSON that we don't want this quoted.
852				if left(val, 2) = "@@" then
853					write( mid( val, 3 ) )
854				else
855					write("""" & escape(val & "") & """")
856				end if
857			end if
858		end if
859		generateValue = output
860	end function
861
862	'******************************************************************************************************************
863	'* generateArray
864	'******************************************************************************************************************
865	private sub generateArray(val)
866		dim item, i
867		write("[")
868		i = 0
869		'the for each allows us to support also multi dimensional arrays
870		for each item in val
871			if i > 0 then write(",")
872			generateValue(item)
873			i = i + 1
874		next
875		write("]")
876	end sub
877
878	'******************************************************************************************************************
879	'* generateDictionary
880	'******************************************************************************************************************
881	private sub generateDictionary(val)
882		innerCall = innerCall + 1
883		if val.count = 0 then
884			toJSON empty, null, true
885			exit sub
886		end if
887		dim key, i
888		write("{")
889		i = 0
890		for each key in val
891			if i > 0 then write(",")
892			toJSON key, val(key), true
893			i = i + 1
894		next
895		write("}")
896		innerCall = innerCall - 1
897	end sub
898
899	'******************************************************************************************************************
900	'* generateObject
901	'******************************************************************************************************************
902	private sub generateObject(val)
903		dim props
904		on error resume next
905		set props = val.reflect()
906		if err = 0 then
907			on error goto 0
908			innerCall = innerCall + 1
909			toJSON empty, props, true
910			innerCall = innerCall - 1
911		else
912			on error goto 0
913			write("""" & escape(typename(val)) & """")
914		end if
915	end sub
916
917	'******************************************************************************************************************
918	'* newGeneration
919	'******************************************************************************************************************
920	private sub newGeneration()
921		output = empty
922		innerCall = 0
923	end sub
924
925	'******************************************************************************************
926	'* JsonEscapeSquence
927	'******************************************************************************************
928	private function escapequence(digit)
929		escapequence = "\u00" + right(padLeft(hex(ascw(digit)), 2, 0), 2)
930	end function
931
932	'******************************************************************************************
933	'* padLeft
934	'******************************************************************************************
935	private function padLeft(value, totalLength, paddingChar)
936		padLeft = right(clone(paddingChar, totalLength) & value, totalLength)
937	end function
938
939	'******************************************************************************************
940	'* clone
941	'******************************************************************************************
942	private function clone(byVal str, n)
943		dim i
944		for i = 1 to n : clone = clone & str : next
945	end function
946
947	'******************************************************************************************
948	'* write
949	'******************************************************************************************
950	private sub write(val)
951		output = output & val
952	end sub
953
954end class
955%>
956