ckeditor.asp

   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")
   7 dim CKEDITOR_initComplete
   8 dim 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
  21 Class 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.1"
  95                 timeStamp = "B5GJ5GG"
  96                 mTimeStamp = "B5GJ5GG"
  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
 676 End 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 '**************************************************************************************************************
 709 class 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
 954 end class
 955 %>