source: trunk/admin/inc/ckeditor/ckeditor.asp@ 345

Last change on this file since 345 was 239, checked in by luc, 9 years ago

Admin: correzione visulaizzazione immissione dati spoglio per Chrome e Safari - Aggiornamento dell'editor da FCKeditor a CKeditor , accessibili anche a Chrome e Safari.
  • Property svn:executable set to *
File size: 30.1 KB
Line 
1<%
2 '
3 ' Copyright (c) 2003-2011, 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.6.2"
95 timeStamp = "B8DJ5M3"
96 mTimeStamp = "B8DJ5M3"
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%>
Note: See TracBrowser for help on using the repository browser.