[ Index ]

PHP Cross Reference of vtigercrm-6.1.0

title

Body

[close]

/libraries/jquery/ckeditor/ -> ckeditor.asp (source)

   1  <%
   2   '
   3   ' Copyright (c) 2003-2012, 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.3"
  95          timeStamp = "C3HA5RM"
  96          mTimeStamp = "C3HA5RM"
  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  %>


Generated: Fri Nov 28 20:08:37 2014 Cross-referenced by PHPXref 0.7.1