Context Navigation

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

Last change on this file since 7950 was 7950, checked in by patdenice, 14 years ago
Update CK Editor to 3.4.2.
File size: 30.1 KB

Rev	Line
[7950]	1	<%
	2	'
	3	' Copyright (c) 2003-2010, 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	' <script> 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 <textarea> 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.4.2"
	95	timeStamp = "AA4E4NT"
	96	mTimeStamp = "AA4E4NT"
	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 <textarea> 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 <textarea> with a %CKEditor instance.
	175	'
	176	' @param id (string) The id or name of textarea element.
	177	'
	178	' Example 1: adding %CKEditor to <textarea name="article"></textarea> 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 <textarea> 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 <textarea> elements in the page.
	218	' @code
	219	' editor = new CKEditor
	220	' editor.replaceAll empty
	221	' @endcode
	222	'
	223	' Example 2: replace all <textarea class="myClassName"> 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 "" & ckeditorPath & "" 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: "" & filename & ""</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	%>

Note: See TracBrowser for help on using the repository browser.

Download in other formats: