rte_popup_link.asp

简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="RTE_configuration/RTE_setup.asp" -->
<%
'****************************************************************************************
'**  Copyright Notice    
'**
'**  Web Wiz Rich Text Editor(TM)
'**  http://www.richtexteditor.org
'**                                               
'**  Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved. 
'**  
'**  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'.
'**  
'**  IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE 
'**  THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'**  AND DERIVATIVE WORKS IMMEDIATELY.
'**  
'**  If you have not received a copy of the license with this work then a copy of the latest
'**  license contract can be found at:-
'**
'**  http://www.webwizguide.com/license
'**
'**  For more information about this software and for licensing information please contact
'**  'Web Wiz' at the address and website below:-
'**
'**  Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'**  http://www.webwizguide.com
'**
'**  Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************



'*************************** SOFTWARE AND CODE MODIFICATIONS **************************** 
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE  
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************



'Clean up
Call closeDatabase()



'Dimension veriables
Dim strLinkType
Dim strHyperlinkType
Dim strHyperlink
Dim strTitle
Dim strWindow
Dim strEmail
Dim strSubject



'If this a post back read in the form elements
If Request.Form("URL") <> "" OR Request.Form("email") <> "" AND Request.Form("postBack") Then
	
	'Get form elements
	strLinkType = Request.Form("selType")
	strHyperlinkType = Request.Form("linkChoice")
	strHyperlink = Request.Form("URL")
	strTitle = Request.Form("Title")
	strWindow = Request.Form("Window")
	strEmail = Request.Form("email")
	strSubject = Request.Form("subject")
	
	'If the http:// part is repeated in the URL then strip it:-
	strHyperlink = Replace(strHyperlink, strHyperlinkType, "", 1, -1, 1)
	
	'Escape characters that will course a crash
	strHyperlink = Replace(strHyperlink, "'", "\'", 1, -1, 1)
	strHyperlink = Replace(strHyperlink, """", "\""", 1, -1, 1)
	strTitle = Replace(strTitle, "'", "\'", 1, -1, 1)
	strTitle = Replace(strTitle, """", "\""", 1, -1, 1)
	strWindow = Replace(strWindow, "'", "\'", 1, -1, 1)
	strWindow = Replace(strWindow, """", "\""", 1, -1, 1)
	strEmail = Replace(strEmail, "'", "\'", 1, -1, 1)
	strEmail = Replace(strEmail, """", "\""", 1, -1, 1)
	strSubject = Replace(strSubject, "'", "\'", 1, -1, 1)
	strSubject = Replace(strSubject, """", "\""", 1, -1, 1)
	
	
	'If this is an email mailto then set the email type to mailto:
	If strLinkType = "email" Then 
		strHyperlinkType = "mailto:"
		strHyperlink = strEmail
	End If
End If

%>
<!-- #include file="includes/browser_page_encoding_inc.asp" -->
<title>Hyperlink Properties</title>

<%
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
Response.Write(vbCrLf & "<!--//" & _
vbCrLf & "/* *******************************************************" & _
vbCrLf & "Software: Web Wiz Rich Text Editor(TM) ver. " & strRTEversion & "" & _
vbCrLf & "Info: http://www.richtexteditor.org" & _
vbCrLf & "Copyright: (C)2001-2008 Web Wiz(TM). All rights reserved" & _
vbCrLf & "******************************************************* */" & _
vbCrLf & "//-->")
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******


'If this is Gecko or Opera based browser link to JS code for Gecko
If RTEenabled = "Gecko" OR RTEenabled = "opera" Then Response.Write(vbCrLf & "<script language=""JavaScript"" src=""RTE_javascript_gecko.asp"" type=""text/javascript""></script>")
	
%>
<script language="JavaScript">
<%

'If this a post back write javascript
If Request.Form("URL") <> "" OR Request.Form("email") <> "" AND Request.Form("postBack") Then
		
	
	'*********************************************
	'***  	JavaScript for Mozilla & IE	 *****
	'*********************************************
	
	Response.Write(vbCrLf & "editor = window.opener.document.getElementById('WebWizRTE');")
	
	'Mozilla and Opera use different methods than IE to get the selected text (if any)
	If RTEenabled = "Gecko" OR RTEenabled = "opera" Then 
		Response.Write(vbCrLf & vbCrLf & "var selectedRange = editor.contentWindow.window.getSelection();")
	Else	
		Response.Write(vbCrLf & vbCrLf & "var selectedRange = editor.contentWindow.document.selection.createRange();")
	End If	
	


	'If there is a selected area, turn it into a hyperlink
	Response.Write(vbCrLf & vbCrLf & "if (selectedRange != null && selectedRange")
	If RTEenabled = "winIE" Then Response.Write(".text")
	Response.Write(" != ''){")

	'Create hyperlink
	Response.Write(vbCrLf & "	editor.contentWindow.window.document.execCommand('CreateLink', false, '" & strHyperlinkType & strHyperlink & "')")
		
	'Set attributes if required
	If (strLinkType = "link" AND (strTitle <> "" OR strWindow <> "")) OR (strLinkType = "email" AND strSubject <> "") Then
		
		'Set hyperlink attributes
		Response.Write(vbCrLf & vbCrLf & "	var hyperlink = editor.contentWindow.window.document.getElementsByTagName('a');" & _
			       vbCrLf & "	for (var i=0; i < hyperlink.length; i++){" & _
			       vbCrLf & "		if (hyperlink[i].getAttribute('href').search('" & strHyperlinkType & strHyperlink & "') != -1){")
		
		'Set title, window, subject if required	       
		If strLinkType = "link" AND strTitle <> "" Then Response.Write(vbCrLf & "			hyperlink[i].setAttribute('title','" & strTitle & "');")
		If strLinkType = "link" AND strWindow <> "" Then Response.Write(vbCrLf & "			hyperlink[i].setAttribute('target','" & strWindow & "');")
		If strLinkType = "email" AND strSubject <> "" Then Response.Write(vbCrLf & "			hyperlink[i].setAttribute('subject','" & strSubject & "');")
			       
		Response.Write(vbCrLf & "		}" & _
			       vbCrLf & "	}")
	End If
	
	
	
	'Else no selected area so use the hyperlink text as the displayed text
	Response.Write(vbCrLf & "}else{")
	
	'Tell that we are maiing a hyperlink 'a'
	Response.Write(vbCrLf & vbCrLf & "	hyperlink = editor.contentWindow.document.createElement('a');")
	
	Response.Write(vbCrLf & vbCrLf & "	hyperlink.setAttribute('href', '" & strHyperlinkType & strHyperlink & "');")
	If strLinkType = "link" AND strTitle <> "" Then Response.Write(vbCrLf & "	hyperlink.setAttribute('title', '" & strTitle & "');")
	If strLinkType = "link" AND strWindow <> "" Then Response.Write(vbCrLf & "	hyperlink.setAttribute('target', '" & strWindow & "');")
	If strLinkType = "email" AND strSubject <> "" Then Response.Write(vbCrLf & "	hyperlink.setAttribute('subject', '" & strSubject & "');")
	
	'Use the text eentered for the link to be a child of the a tag so that it is the screen display
	Response.Write(vbCrLf & "	hyperlink.appendChild(editor.contentWindow.document.createTextNode('" & strHyperlinkType & strHyperlink & "'));")
	
	'If this is Mozilla or Opera then we need to call insertElementPosition to find where to place the image
     	If RTEenabled = "Gecko" OR RTEenabled = "opera" Then
		
	Response.Write(vbCrLf & vbCrLf & "	try{" & _
				vbCrLf & "		insertElementPosition(editor.contentWindow, hyperlink);" & _
				vbCrLf & "	}catch(exception){" & _
				vbCrLf & "		alert('" & strTxtErrorInsertingObject & "');" & _