source: extensions/FCKEditor/ckeditor/ckeditor.asp @ 19935

Last change on this file since 19935 was 9293, checked in by patdenice, 14 years ago

Update to CK Editor 3.5.2

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.5.2"
95                timeStamp = "B1GG4Z6"
96                mTimeStamp = "B1GG4Z6"
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.