--- /dev/null
+<%\r
+ '\r
+ ' Copyright (c) 2003-2011, CKSource - Frederico Knabben. All rights reserved.\r
+ ' For licensing, see LICENSE.html or http://ckeditor.com/license\r
+\r
+' Shared variable for all instances ("static")\r
+dim CKEDITOR_initComplete\r
+dim CKEDITOR_returnedEvents\r
+\r
+ ''\r
+ ' \brief CKEditor class that can be used to create editor\r
+ ' instances in ASP pages on server side.\r
+ ' @see http://ckeditor.com\r
+ '\r
+ ' Sample usage:\r
+ ' @code\r
+ ' editor = new CKEditor\r
+ ' editor.editor "editor1", "<p>Initial value.</p>", empty, empty\r
+ ' @endcode\r
+\r
+Class CKEditor\r
+\r
+ ''\r
+ ' The version of %CKEditor.\r
+ private version\r
+\r
+ ''\r
+ ' A constant string unique for each release of %CKEditor.\r
+ private mTimeStamp\r
+\r
+ ''\r
+ ' URL to the %CKEditor installation directory (absolute or relative to document root).\r
+ ' If not set, CKEditor will try to guess it's path.\r
+ '\r
+ ' Example usage:\r
+ ' @code\r
+ ' editor.basePath = "/ckeditor/"\r
+ ' @endcode\r
+ Public basePath\r
+\r
+ ''\r
+ ' A boolean variable indicating whether CKEditor has been initialized.\r
+ ' Set it to true only if you have already included\r
+ ' <script> tag loading ckeditor.js in your website.\r
+ Public initialized\r
+\r
+ ''\r
+ ' Boolean variable indicating whether created code should be printed out or returned by a function.\r
+ '\r
+ ' Example 1: get the code creating %CKEditor instance and print it on a page with the "echo" function.\r
+ ' @code\r
+ ' editor = new CKEditor\r
+ ' editor.returnOutput = true\r
+ ' code = editor.editor("editor1", "<p>Initial value.</p>", empty, empty)\r
+ ' response.write "<p>Editor 1:</p>"\r
+ ' response.write code\r
+ ' @endcode\r
+ Public returnOutput\r
+\r
+ ''\r
+ ' A Dictionary with textarea attributes.\r
+ '\r
+ ' When %CKEditor is created with the editor() method, a HTML <textarea> element is created,\r
+ ' it will be displayed to anyone with JavaScript disabled or with incompatible browser.\r
+ public textareaAttributes\r
+\r
+ ''\r
+ ' A string indicating the creation date of %CKEditor.\r
+ ' Do not change it unless you want to force browsers to not use previously cached version of %CKEditor.\r
+ public timestamp\r
+\r
+ ''\r
+ ' A dictionary that holds the instance configuration.\r
+ private oInstanceConfig\r
+\r
+ ''\r
+ ' A dictionary that holds the configuration for all the instances.\r
+ private oAllInstancesConfig\r
+\r
+ ''\r
+ ' A dictionary that holds event listeners for the instance.\r
+ private oInstanceEvents\r
+\r
+ ''\r
+ ' A dictionary that holds event listeners for all the instances.\r
+ private oAllInstancesEvents\r
+\r
+ ''\r
+ ' A Dictionary that holds global event listeners (CKEDITOR object)\r
+ private oGlobalEvents\r
+\r
+\r
+ Private Sub Class_Initialize()\r
+ version = "3.6.1"\r
+ timeStamp = "B5GJ5GG"\r
+ mTimeStamp = "B5GJ5GG"\r
+\r
+ Set oInstanceConfig = CreateObject("Scripting.Dictionary")\r
+ Set oAllInstancesConfig = CreateObject("Scripting.Dictionary")\r
+\r
+ Set oInstanceEvents = CreateObject("Scripting.Dictionary")\r
+ Set oAllInstancesEvents = CreateObject("Scripting.Dictionary")\r
+ Set oGlobalEvents = CreateObject("Scripting.Dictionary")\r
+\r
+ Set textareaAttributes = CreateObject("Scripting.Dictionary")\r
+ textareaAttributes.Add "rows", 8\r
+ textareaAttributes.Add "cols", 60\r
+ End Sub\r
+\r
+ ''\r
+ ' Creates a %CKEditor instance.\r
+ ' In incompatible browsers %CKEditor will downgrade to plain HTML <textarea> element.\r
+ '\r
+ ' @param name (string) Name of the %CKEditor instance (this will be also the "name" attribute of textarea element).\r
+ ' @param value (string) Initial value.\r
+ '\r
+ ' Example usage:\r
+ ' @code\r
+ ' set editor = New CKEditor\r
+ ' editor.editor "field1", "<p>Initial value.</p>"\r
+ ' @endcode\r
+ '\r
+ ' Advanced example:\r
+ ' @code\r
+ ' set editor = new CKEditor\r
+ ' set config = CreateObject("Scripting.Dictionary")\r
+ ' config.Add "toolbar", Array( _\r
+ ' Array( "Source", "-", "Bold", "Italic", "Underline", "Strike" ), _\r
+ ' Array( "Image", "Link", "Unlink", "Anchor" ) _\r
+ ' )\r
+ ' set events = CreateObject("Scripting.Dictionary")\r
+ ' events.Add "instanceReady", "function (evt) { alert('Loaded second editor: ' + evt.editor.name );}"\r
+\r
+ ' editor.editor "field1", "<p>Initial value.</p>", config, events\r
+ ' @endcode\r
+ '\r
+ public function editor(name, value)\r
+ dim attr, out, js, customConfig, extraConfig\r
+ dim attribute\r
+\r
+ attr = ""\r
+\r
+ for each attribute in textareaAttributes\r
+ attr = attr & " " & attribute & "=""" & replace( textareaAttributes( attribute ), """", """ ) & """"\r
+ next\r
+\r
+ out = "<textarea name=""" & name & """" & attr & ">" & Server.HtmlEncode(value) & "</textarea>" & vbcrlf\r
+\r
+ if not(initialized) then\r
+ out = out & init()\r
+ end if\r
+\r
+ set customConfig = configSettings()\r
+ js = returnGlobalEvents()\r
+\r
+ extraConfig = (new JSON)( empty, customConfig, false )\r
+ if extraConfig<>"" then extraConfig = ", " & extraConfig\r
+ js = js & "CKEDITOR.replace('" & name & "'" & extraConfig & ");"\r
+\r
+ out = out & script(js)\r
+\r
+ if not(returnOutput) then\r
+ response.write out\r
+ out = ""\r
+ end if\r
+\r
+ editor = out\r
+\r
+ oInstanceConfig.RemoveAll\r
+ oInstanceEvents.RemoveAll\r
+ end function\r
+\r
+ ''\r
+ ' Replaces a <textarea> with a %CKEditor instance.\r
+ '\r
+ ' @param id (string) The id or name of textarea element.\r
+ '\r
+ ' Example 1: adding %CKEditor to <textarea name="article"></textarea> element:\r
+ ' @code\r
+ ' set editor = New CKEditor\r
+ ' editor.replace "article"\r
+ ' @endcode\r
+ '\r
+ public function replaceInstance(id)\r
+ dim out, js, customConfig, extraConfig\r
+\r
+ out = ""\r
+ if not(initialized) then\r
+ out = out & init()\r
+ end if\r
+\r
+ set customConfig = configSettings()\r
+ js = returnGlobalEvents()\r
+\r
+ extraConfig = (new JSON)( empty, customConfig, false )\r
+ if extraConfig<>"" then extraConfig = ", " & extraConfig\r
+ js = js & "CKEDITOR.replace('" & id & "'" & extraConfig & ");"\r
+\r
+ out = out & script(js)\r
+\r
+ if not(returnOutput) then\r
+ response.write out\r
+ out = ""\r
+ end if\r
+\r
+ replaceInstance = out\r
+\r
+ oInstanceConfig.RemoveAll\r
+ oInstanceEvents.RemoveAll\r
+ end function\r
+\r
+ ''\r
+ ' Replace all <textarea> elements available in the document with editor instances.\r
+ '\r
+ ' @param className (string) If set, replace all textareas with class className in the page.\r
+ '\r
+ ' Example 1: replace all <textarea> elements in the page.\r
+ ' @code\r
+ ' editor = new CKEditor\r
+ ' editor.replaceAll empty\r
+ ' @endcode\r
+ '\r
+ ' Example 2: replace all <textarea class="myClassName"> elements in the page.\r
+ ' @code\r
+ ' editor = new CKEditor\r
+ ' editor.replaceAll 'myClassName'\r
+ ' @endcode\r
+ '\r
+ function replaceAll(className)\r
+ dim out, js, customConfig\r
+\r
+ out = ""\r
+ if not(initialized) then\r
+ out = out & init()\r
+ end if\r
+\r
+ set customConfig = configSettings()\r
+ js = returnGlobalEvents()\r
+\r
+ if (customConfig.Count=0) then\r
+ if (isEmpty(className)) then\r
+ js = js & "CKEDITOR.replaceAll();"\r
+ else\r
+ js = js & "CKEDITOR.replaceAll('" & className & "');"\r
+ end if\r
+ else\r
+ js = js & "CKEDITOR.replaceAll( function(textarea, config) {\n"\r
+ if not(isEmpty(className)) then\r
+ js = js & " var classRegex = new RegExp('(?:^| )' + '" & className & "' + '(?:$| )');\n"\r
+ js = js & " if (!classRegex.test(textarea.className))\n"\r
+ js = js & " return false;\n"\r
+ end if\r
+ js = js & " CKEDITOR.tools.extend(config, " & (new JSON)( empty, customConfig, false ) & ", true);"\r
+ js = js & "} );"\r
+ end if\r
+\r
+ out = out & script(js)\r
+\r
+ if not(returnOutput) then\r
+ response.write out\r
+ out = ""\r
+ end if\r
+\r
+ replaceAll = out\r
+\r
+ oInstanceConfig.RemoveAll\r
+ oInstanceEvents.RemoveAll\r
+ end function\r
+\r
+\r
+ ''\r
+ ' A Dictionary that holds the %CKEditor configuration for all instances\r
+ ' For the list of available options, see http://docs.cksource.com/ckeditor_api/symbols/CKEDITOR.config.html\r
+ '\r
+ ' Example usage:\r
+ ' @code\r
+ ' editor.config("height") = 400\r
+ ' // Use @@ at the beggining of a string to ouput it without surrounding quotes.\r
+ ' editor.config("width") = "@@screen.width * 0.8"\r
+ ' @endcode\r
+ Public Property Let Config( configKey, configValue )\r
+ oAllInstancesConfig.Add configKey, configValue\r
+ End Property\r
+\r
+ ''\r
+ ' Configuration options for the next instance\r
+ '\r
+ Public Property Let instanceConfig( configKey, configValue )\r
+ oInstanceConfig.Add configKey, configValue\r
+ End Property\r
+\r
+ ''\r
+ ' Adds event listener.\r
+ ' Events are fired by %CKEditor in various situations.\r
+ '\r
+ ' @param eventName (string) Event name.\r
+ ' @param javascriptCode (string) Javascript anonymous function or function name.\r
+ '\r
+ ' Example usage:\r
+ ' @code\r
+ ' editor.addEventHandler "instanceReady", "function (ev) { " & _\r
+ ' " alert('Loaded: ' + ev.editor.name); " & _\r
+ ' "}"\r
+ ' @endcode\r
+ '\r
+ public sub addEventHandler(eventName, javascriptCode)\r
+ if not(oAllInstancesEvents.Exists( eventName ) ) then\r
+ oAllInstancesEvents.Add eventName, Array()\r
+ end if\r
+\r
+ dim listeners, size\r
+ listeners = oAllInstancesEvents( eventName )\r
+ size = ubound(listeners) + 1\r
+ redim preserve listeners(size)\r
+ listeners(size) = javascriptCode\r
+\r
+ oAllInstancesEvents( eventName ) = listeners\r
+' '' Avoid duplicates. fixme...\r
+' if (!in_array($javascriptCode, $this->_events[$event])) {\r
+' $this->_events[$event][] = $javascriptCode;\r
+' }\r
+ end sub\r
+\r
+ ''\r
+ ' Clear registered event handlers.\r
+ ' Note: this function will have no effect on already created editor instances.\r
+ '\r
+ ' @param eventName (string) Event name, if set to 'empty' all event handlers will be removed.\r
+ '\r
+ public sub clearEventHandlers( eventName )\r
+ if not(isEmpty( eventName )) then\r
+ oAllInstancesEvents.Remove eventName\r
+ else\r
+ oAllInstancesEvents.RemoveAll\r
+ end if\r
+ end sub\r
+\r
+\r
+ ''\r
+ ' Adds event listener only for the next instance.\r
+ ' Events are fired by %CKEditor in various situations.\r
+ '\r
+ ' @param eventName (string) Event name.\r
+ ' @param javascriptCode (string) Javascript anonymous function or function name.\r
+ '\r
+ ' Example usage:\r
+ ' @code\r
+ ' editor.addInstanceEventHandler "instanceReady", "function (ev) { " & _\r
+ ' " alert('Loaded: ' + ev.editor.name); " & _\r
+ ' "}"\r
+ ' @endcode\r
+ '\r
+ public sub addInstanceEventHandler(eventName, javascriptCode)\r
+ if not(oInstanceEvents.Exists( eventName ) ) then\r
+ oInstanceEvents.Add eventName, Array()\r
+ end if\r
+\r
+ dim listeners, size\r
+ listeners = oInstanceEvents( eventName )\r
+ size = ubound(listeners) + 1\r
+ redim preserve listeners(size)\r
+ listeners(size) = javascriptCode\r
+\r
+ oInstanceEvents( eventName ) = listeners\r
+' '' Avoid duplicates. fixme...\r
+' if (!in_array($javascriptCode, $this->_events[$event])) {\r
+' $this->_events[$event][] = $javascriptCode;\r
+' }\r
+ end sub\r
+\r
+ ''\r
+ ' Clear registered event handlers.\r
+ ' Note: this function will have no effect on already created editor instances.\r
+ '\r
+ ' @param eventName (string) Event name, if set to 'empty' all event handlers will be removed.\r
+ '\r
+ public sub clearInstanceEventHandlers( eventName )\r
+ if not(isEmpty( eventName )) then\r
+ oInstanceEvents.Remove eventName\r
+ else\r
+ oInstanceEvents.RemoveAll\r
+ end if\r
+ end sub\r
+\r
+ ''\r
+ ' Adds global event listener.\r
+ '\r
+ ' @param event (string) Event name.\r
+ ' @param javascriptCode (string) Javascript anonymous function or function name.\r
+ '\r
+ ' Example usage:\r
+ ' @code\r
+ ' editor.addGlobalEventHandler "dialogDefinition", "function (ev) { " & _\r
+ ' " alert('Loading dialog: ' + ev.data.name); " & _\r
+ ' "}"\r
+ ' @endcode\r
+ '\r
+ public sub addGlobalEventHandler( eventName, javascriptCode)\r
+ if not(oGlobalEvents.Exists( eventName ) ) then\r
+ oGlobalEvents.Add eventName, Array()\r
+ end if\r
+\r
+ dim listeners, size\r
+ listeners = oGlobalEvents( eventName )\r
+ size = ubound(listeners) + 1\r
+ redim preserve listeners(size)\r
+ listeners(size) = javascriptCode\r
+\r
+ oGlobalEvents( eventName ) = listeners\r
+\r
+' // Avoid duplicates.\r
+' if (!in_array($javascriptCode, $this->_globalEvents[$event])) {\r
+' $this->_globalEvents[$event][] = $javascriptCode;\r
+' }\r
+ end sub\r
+\r
+ ''\r
+ ' Clear registered global event handlers.\r
+ ' Note: this function will have no effect if the event handler has been already printed/returned.\r
+ '\r
+ ' @param eventName (string) Event name, if set to 'empty' all event handlers will be removed .\r
+ '\r
+ public sub clearGlobalEventHandlers( eventName )\r
+ if not(isEmpty( eventName )) then\r
+ oGlobalEvents.Remove eventName\r
+ else\r
+ oGlobalEvents.RemoveAll\r
+ end if\r
+ end sub\r
+\r
+ ''\r
+ ' Prints javascript code.\r
+ '\r
+ ' @param string js\r
+ '\r
+ private function script(js)\r
+ script = "<script type=""text/javascript"">" & _\r
+ "//<![CDATA[" & vbcrlf & _\r
+ js & vbcrlf & _\r
+ "//]]>" & _\r
+ "</script>" & vbcrlf\r
+ end function\r
+\r
+ ''\r
+ ' Returns the configuration array (global and instance specific settings are merged into one array).\r
+ '\r
+ ' @param instanceConfig (Dictionary) The specific configurations to apply to editor instance.\r
+ ' @param instanceEvents (Dictionary) Event listeners for editor instance.\r
+ '\r
+ private function configSettings()\r
+ dim mergedConfig, mergedEvents\r
+ set mergedConfig = cloneDictionary(oAllInstancesConfig)\r
+ set mergedEvents = cloneDictionary(oAllInstancesEvents)\r
+\r
+ if not(isEmpty(oInstanceConfig)) then\r
+ set mergedConfig = mergeDictionary(mergedConfig, oInstanceConfig)\r
+ end if\r
+\r
+ if not(isEmpty(oInstanceEvents)) then\r
+ for each eventName in oInstanceEvents\r
+ code = oInstanceEvents( eventName )\r
+\r
+ if not(mergedEvents.Exists( eventName)) then\r
+ mergedEvents.Add eventName, code\r
+ else\r
+\r
+ dim listeners, size\r
+ listeners = mergedEvents( eventName )\r
+ size = ubound(listeners)\r
+ if isArray( code ) then\r
+ addedCount = ubound(code)\r
+ redim preserve listeners( size + addedCount + 1 )\r
+ for i = 0 to addedCount\r
+ listeners(size + i + 1) = code (i)\r
+ next\r
+ else\r
+ size = size + 1\r
+ redim preserve listeners(size)\r
+ listeners(size) = code\r
+ end if\r
+\r
+ mergedEvents( eventName ) = listeners\r
+ end if\r
+ next\r
+\r
+ end if\r
+\r
+ dim i, eventName, handlers, configON, ub, code\r
+\r
+ if mergedEvents.Count>0 then\r
+ if mergedConfig.Exists( "on" ) then\r
+ set configON = mergedConfig.items( "on" )\r
+ else\r
+ set configON = CreateObject("Scripting.Dictionary")\r
+ mergedConfig.Add "on", configOn\r
+ end if\r
+\r
+ for each eventName in mergedEvents\r
+ handlers = mergedEvents( eventName )\r
+ code = ""\r
+\r
+ if isArray(handlers) then\r
+ uB = ubound(handlers)\r
+ if (uB = 0) then\r
+ code = handlers(0)\r
+ else\r
+ code = "function (ev) {"\r
+ for i=0 to uB\r
+ code = code & "(" & handlers(i) & ")(ev);"\r
+ next\r
+ code = code & "}"\r
+ end if\r
+ else\r
+ code = handlers\r
+ end if\r
+ ' Using @@ at the beggining to signal JSON that we don't want this quoted.\r
+ configON.Add eventName, "@@" & code\r
+ next\r
+\r
+' set mergedConfig.Item("on") = configOn\r
+ end if\r
+\r
+ set configSettings = mergedConfig\r
+ end function\r
+\r
+ ''\r
+ ' Returns a copy of a scripting.dictionary object\r
+ '\r
+ private function cloneDictionary( base )\r
+ dim newOne, tmpKey\r
+\r
+ Set newOne = CreateObject("Scripting.Dictionary")\r
+ for each tmpKey in base\r
+ newOne.Add tmpKey , base( tmpKey )\r
+ next\r
+\r
+ set cloneDictionary = newOne\r
+ end function\r
+\r
+ ''\r
+ ' Combines two scripting.dictionary objects\r
+ ' The base object isn't modified, and extra gets all the properties in base\r
+ '\r
+ private function mergeDictionary(base, extra)\r
+ dim newOne, tmpKey\r
+\r
+ for each tmpKey in base\r
+ if not(extra.Exists( tmpKey )) then\r
+ extra.Add tmpKey, base( tmpKey )\r
+ end if\r
+ next\r
+\r
+ set mergeDictionary = extra\r
+ end function\r
+\r
+ ''\r
+ ' Return global event handlers.\r
+ '\r
+ private function returnGlobalEvents()\r
+ dim out, eventName, handlers\r
+ dim handlersForEvent, handler, code, i\r
+ out = ""\r
+\r
+ if (isempty(CKEDITOR_returnedEvents)) then\r
+ set CKEDITOR_returnedEvents = CreateObject("Scripting.Dictionary")\r
+ end if\r
+\r
+ for each eventName in oGlobalEvents\r
+ handlers = oGlobalEvents( eventName )\r
+\r
+ if not(CKEDITOR_returnedEvents.Exists(eventName)) then\r
+ CKEDITOR_returnedEvents.Add eventName, CreateObject("Scripting.Dictionary")\r
+ end if\r
+\r
+ set handlersForEvent = CKEDITOR_returnedEvents.Item( eventName )\r
+\r
+ ' handlersForEvent is another dictionary\r
+ ' and handlers is an array\r
+\r
+ for i = 0 to ubound(handlers)\r
+ code = handlers( i )\r
+\r
+ ' Return only new events\r
+ if not(handlersForEvent.Exists( code )) then\r
+ if (out <> "") then out = out & vbcrlf\r
+ out = out & "CKEDITOR.on('" & eventName & "', " & code & ");"\r
+ handlersForEvent.Add code, code\r
+ end if\r
+ next\r
+ next\r
+\r
+ returnGlobalEvents = out\r
+ end function\r
+\r
+ ''\r
+ ' Initializes CKEditor (executed only once).\r
+ '\r
+ private function init()\r
+ dim out, args, path, extraCode, file\r
+ out = ""\r
+\r
+ if (CKEDITOR_initComplete) then\r
+ init = ""\r
+ exit function\r
+ end if\r
+\r
+ if (initialized) then\r
+ CKEDITOR_initComplete = true\r
+ init = ""\r
+ exit function\r
+ end if\r
+\r
+ args = ""\r
+ path = ckeditorPath()\r
+\r
+ if (timestamp <> "") and (timestamp <> "%" & "TIMESTAMP%") then\r
+ args = "?t=" & timestamp\r
+ end if\r
+\r
+ ' Skip relative paths...\r
+ if (instr(path, "..") <> 0) then\r
+ out = out & script("window.CKEDITOR_BASEPATH='" & path & "';")\r
+ end if\r
+\r
+ out = out & "<scr" & "ipt type=""text/javascript"" src=""" & path & ckeditorFileName() & args & """></scr" & "ipt>" & vbcrlf\r
+\r
+ extraCode = ""\r
+ if (timestamp <> mTimeStamp) then\r
+ extraCode = extraCode & "CKEDITOR.timestamp = '" & timestamp & "';"\r
+ end if\r
+ if (extraCode <> "") then\r
+ out = out & script(extraCode)\r
+ end if\r
+\r
+ CKEDITOR_initComplete = true\r
+ initialized = true\r
+\r
+ init = out\r
+ end function\r
+\r
+ private function ckeditorFileName()\r
+ ckeditorFileName = "ckeditor.js"\r
+ end function\r
+\r
+ ''\r
+ ' Return path to ckeditor.js.\r
+ '\r
+ private function ckeditorPath()\r
+ if (basePath <> "") then\r
+ ckeditorPath = basePath\r
+ else\r
+ ' In classic ASP we can't get the location of this included script\r
+ ckeditorPath = "/ckeditor/"\r
+ end if\r
+\r
+ ' Try to check if that folder contains the CKEditor files:\r
+ ' If it's a full URL avoid checking it as it might point to an external server.\r
+ if (instr(ckeditorPath, "://") <> 0) then exit function\r
+\r
+ dim filename, oFSO, exists\r
+ filename = server.mapPath(basePath & ckeditorFileName())\r
+ set oFSO = Server.CreateObject("Scripting.FileSystemObject")\r
+ exists = oFSO.FileExists(filename)\r
+ set oFSO = nothing\r
+\r
+ if not(exists) then\r
+ response.clear\r
+ response.write "<h1>CKEditor path validation failed</h1>"\r
+ response.write "<p>The path "" & ckeditorPath & "" doesn't include the CKEditor main file (" & ckeditorFileName() & ")</p>"\r
+ response.write "<p>Please, verify that you have set it correctly and/or adjust the 'basePath' property</p>"\r
+ response.write "<p>Checked for physical file: "" & filename & ""</p>"\r
+ response.end\r
+ end if\r
+ end function\r
+\r
+End Class\r
+\r
+\r
+\r
+' URL: http://www.webdevbros.net/2007/04/26/generate-json-from-asp-datatypes/\r
+'**************************************************************************************************************\r
+'' @CLASSTITLE: JSON\r
+'' @CREATOR: Michal Gabrukiewicz (gabru at grafix.at), Michael Rebec\r
+'' @CONTRIBUTORS: - Cliff Pruitt (opensource at crayoncowboy.com)\r
+'' - Sylvain Lafontaine\r
+'' - Jef Housein\r
+'' - Jeremy Brown\r
+'' @CREATEDON: 2007-04-26 12:46\r
+'' @CDESCRIPTION: Comes up with functionality for JSON (http://json.org) to use within ASP.\r
+'' Correct escaping of characters, generating JSON Grammer out of ASP datatypes and structures\r
+'' Some examples (all use the <em>toJSON()</em> method but as it is the class' default method it can be left out):\r
+'' <code>\r
+'' <%\r
+'' 'simple number\r
+'' output = (new JSON)("myNum", 2, false)\r
+'' 'generates {"myNum": 2}\r
+''\r
+'' 'array with different datatypes\r
+'' output = (new JSON)("anArray", array(2, "x", null), true)\r
+'' 'generates "anArray": [2, "x", null]\r
+'' '(note: the last parameter was true, thus no surrounding brackets in the result)\r
+'' % >\r
+'' </code>\r
+'' @REQUIRES: -\r
+'' @OPTIONEXPLICIT: yes\r
+'' @VERSION: 1.5.1\r
+\r
+'**************************************************************************************************************\r
+class JSON\r
+\r
+ 'private members\r
+ private output, innerCall\r
+\r
+ '**********************************************************************************************************\r
+ '* constructor\r
+ '**********************************************************************************************************\r
+ public sub class_initialize()\r
+ newGeneration()\r
+ end sub\r
+\r
+ '******************************************************************************************\r
+ '' @SDESCRIPTION: STATIC! takes a given string and makes it JSON valid\r
+ '' @DESCRIPTION: all characters which needs to be escaped are beeing replaced by their\r
+ '' unicode representation according to the\r
+ '' RFC4627#2.5 - http://www.ietf.org/rfc/rfc4627.txt?number=4627\r
+ '' @PARAM: val [string]: value which should be escaped\r
+ '' @RETURN: [string] JSON valid string\r
+ '******************************************************************************************\r
+ public function escape(val)\r
+ dim cDoubleQuote, cRevSolidus, cSolidus\r
+ cDoubleQuote = &h22\r
+ cRevSolidus = &h5C\r
+ cSolidus = &h2F\r
+ dim i, currentDigit\r
+ for i = 1 to (len(val))\r
+ currentDigit = mid(val, i, 1)\r
+ if ascw(currentDigit) > &h00 and ascw(currentDigit) < &h1F then\r
+ currentDigit = escapequence(currentDigit)\r
+ elseif ascw(currentDigit) >= &hC280 and ascw(currentDigit) <= &hC2BF then\r
+ currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC200), 2, 0), 2)\r
+ elseif ascw(currentDigit) >= &hC380 and ascw(currentDigit) <= &hC3BF then\r
+ currentDigit = "\u00" + right(padLeft(hex(ascw(currentDigit) - &hC2C0), 2, 0), 2)\r
+ else\r
+ select case ascw(currentDigit)\r
+ case cDoubleQuote: currentDigit = escapequence(currentDigit)\r
+ case cRevSolidus: currentDigit = escapequence(currentDigit)\r
+ case cSolidus: currentDigit = escapequence(currentDigit)\r
+ end select\r
+ end if\r
+ escape = escape & currentDigit\r
+ next\r
+ end function\r
+\r
+ '******************************************************************************************************************\r
+ '' @SDESCRIPTION: generates a representation of a name value pair in JSON grammer\r
+ '' @DESCRIPTION: It generates a name value pair which is represented as <em>{"name": value}</em> in JSON.\r
+ '' the generation is fully recursive. Thus the value can also be a complex datatype (array in dictionary, etc.) e.g.\r
+ '' <code>\r
+ '' <%\r
+ '' set j = new JSON\r
+ '' j.toJSON "n", array(RS, dict, false), false\r
+ '' j.toJSON "n", array(array(), 2, true), false\r
+ '' % >\r
+ '' </code>\r
+ '' @PARAM: name [string]: name of the value (accessible with javascript afterwards). leave empty to get just the value\r
+ '' @PARAM: val [variant], [int], [float], [array], [object], [dictionary]: value which needs\r
+ '' to be generated. Conversation of the data types is as follows:<br>\r
+ '' - <strong>ASP datatype -> JavaScript datatype</strong>\r
+ '' - NOTHING, NULL -> null\r
+ '' - INT, DOUBLE -> number\r
+ '' - STRING -> string\r
+ '' - BOOLEAN -> bool\r
+ '' - ARRAY -> array\r
+ '' - 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>\r
+ '' - <em>multidimensional array</em> -> Generates a 1-dimensional array (flat) with all values of the multidimensional array\r
+ '' - <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>.\r
+ '' - OBJECT -> name of the type (if unknown type) or all its properties (if class implements <em>reflect()</em> method)\r
+ '' Implement a <strong>reflect()</strong> function if you want your custom classes to be recognized. The function must return\r
+ '' 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\r
+ '' <code>\r
+ '' <%\r
+ '' function reflect()\r
+ '' . set reflect = server.createObject("scripting.dictionary")\r
+ '' . reflect.add "firstname", firstname\r
+ '' . reflect.add "lastname", lastname\r
+ '' end function\r
+ '' % >\r
+ '' </code>\r
+ '' Example of how to generate a JSON representation of the asp request object and access the <em>HTTP_HOST</em> server variable in JavaScript:\r
+ '' <code>\r
+ '' <script>alert(<%= (new JSON)(empty, request, false) % >.servervariables.HTTP_HOST);</script>\r
+ '' </code>\r
+ '' @PARAM: nested [bool]: indicates if the name value pair is already nested within another? if yes then the <em>{}</em> are left out.\r
+ '' @RETURN: [string] returns a JSON representation of the given name value pair\r
+ '******************************************************************************************************************\r
+ public default function toJSON(name, val, nested)\r
+ if not nested and not isEmpty(name) then write("{")\r
+ if not isEmpty(name) then write("""" & escape(name) & """: ")\r
+ generateValue(val)\r
+ if not nested and not isEmpty(name) then write("}")\r
+ toJSON = output\r
+\r
+ if innerCall = 0 then newGeneration()\r
+ end function\r
+\r
+ '******************************************************************************************************************\r
+ '* generate\r
+ '******************************************************************************************************************\r
+ private function generateValue(val)\r
+ if isNull(val) then\r
+ write("null")\r
+ elseif isArray(val) then\r
+ generateArray(val)\r
+ elseif isObject(val) then\r
+ dim tName : tName = typename(val)\r
+ if val is nothing then\r
+ write("null")\r
+ elseif tName = "Dictionary" or tName = "IRequestDictionary" then\r
+ generateDictionary(val)\r
+ elseif tName = "IRequest" then\r
+ set req = server.createObject("scripting.dictionary")\r
+ req.add "clientcertificate", val.ClientCertificate\r
+ req.add "cookies", val.cookies\r
+ req.add "form", val.form\r
+ req.add "querystring", val.queryString\r
+ req.add "servervariables", val.serverVariables\r
+ req.add "totalbytes", val.totalBytes\r
+ generateDictionary(req)\r
+ elseif tName = "IStringList" then\r
+ if val.count = 1 then\r
+ toJSON empty, val(1), true\r
+ else\r
+ generateArray(val)\r
+ end if\r
+ else\r
+ generateObject(val)\r
+ end if\r
+ else\r
+ 'bool\r
+ dim varTyp\r
+ varTyp = varType(val)\r
+ if varTyp = 11 then\r
+ if val then write("true") else write("false")\r
+ 'int, long, byte\r
+ elseif varTyp = 2 or varTyp = 3 or varTyp = 17 or varTyp = 19 then\r
+ write(cLng(val))\r
+ 'single, double, currency\r
+ elseif varTyp = 4 or varTyp = 5 or varTyp = 6 or varTyp = 14 then\r
+ write(replace(cDbl(val), ",", "."))\r
+ else\r
+ ' Using @@ at the beggining to signal JSON that we don't want this quoted.\r
+ if left(val, 2) = "@@" then\r
+ write( mid( val, 3 ) )\r
+ else\r
+ write("""" & escape(val & "") & """")\r
+ end if\r
+ end if\r
+ end if\r
+ generateValue = output\r
+ end function\r
+\r
+ '******************************************************************************************************************\r
+ '* generateArray\r
+ '******************************************************************************************************************\r
+ private sub generateArray(val)\r
+ dim item, i\r
+ write("[")\r
+ i = 0\r
+ 'the for each allows us to support also multi dimensional arrays\r
+ for each item in val\r
+ if i > 0 then write(",")\r
+ generateValue(item)\r
+ i = i + 1\r
+ next\r
+ write("]")\r
+ end sub\r
+\r
+ '******************************************************************************************************************\r
+ '* generateDictionary\r
+ '******************************************************************************************************************\r
+ private sub generateDictionary(val)\r
+ innerCall = innerCall + 1\r
+ if val.count = 0 then\r
+ toJSON empty, null, true\r
+ exit sub\r
+ end if\r
+ dim key, i\r
+ write("{")\r
+ i = 0\r
+ for each key in val\r
+ if i > 0 then write(",")\r
+ toJSON key, val(key), true\r
+ i = i + 1\r
+ next\r
+ write("}")\r
+ innerCall = innerCall - 1\r
+ end sub\r
+\r
+ '******************************************************************************************************************\r
+ '* generateObject\r
+ '******************************************************************************************************************\r
+ private sub generateObject(val)\r
+ dim props\r
+ on error resume next\r
+ set props = val.reflect()\r
+ if err = 0 then\r
+ on error goto 0\r
+ innerCall = innerCall + 1\r
+ toJSON empty, props, true\r
+ innerCall = innerCall - 1\r
+ else\r
+ on error goto 0\r
+ write("""" & escape(typename(val)) & """")\r
+ end if\r
+ end sub\r
+\r
+ '******************************************************************************************************************\r
+ '* newGeneration\r
+ '******************************************************************************************************************\r
+ private sub newGeneration()\r
+ output = empty\r
+ innerCall = 0\r
+ end sub\r
+\r
+ '******************************************************************************************\r
+ '* JsonEscapeSquence\r
+ '******************************************************************************************\r
+ private function escapequence(digit)\r
+ escapequence = "\u00" + right(padLeft(hex(ascw(digit)), 2, 0), 2)\r
+ end function\r
+\r
+ '******************************************************************************************\r
+ '* padLeft\r
+ '******************************************************************************************\r
+ private function padLeft(value, totalLength, paddingChar)\r
+ padLeft = right(clone(paddingChar, totalLength) & value, totalLength)\r
+ end function\r
+\r
+ '******************************************************************************************\r
+ '* clone\r
+ '******************************************************************************************\r
+ private function clone(byVal str, n)\r
+ dim i\r
+ for i = 1 to n : clone = clone & str : next\r
+ end function\r
+\r
+ '******************************************************************************************\r
+ '* write\r
+ '******************************************************************************************\r
+ private sub write(val)\r
+ output = output & val\r
+ end sub\r
+\r
+end class\r
+%>\r