编辑器/阅读器

开发平台：
C#

TransferFunctionGB.asp：源码内容
							<%
Dim Temp_Dv_ForumNews
'//*****************************************************************************//
''@ 设置外部调用限制
Const LockUrl = ""
''@ 说明：只允许调用网址,要以"HTTP://"开头,为空则不限制所有外部调用.(可允许多网址限制，要以","分隔。)
''@ 使用：例如只允许此两个网址调用: lockurl="http://www.artistsky.net/,http://www.artbbs.net/"
'//*****************************************************************************//
'//*****************************************************************************//
''@ 设置临时文件名
Temp_Dv_ForumNews = "Admin/temp.xml"	'临时文件名可自行修改。该文件可以随时删除清理。
'//*****************************************************************************//
If CheckServer(Lockurl)=False then
	OUTPUT "数据被保护,禁止被其他站点调用!"
	Response.End	
End If
Dim NewsConfigFile
Dim XmlDoc,Node,NewsMainStr
Dim GetName,Nexttime
GetName = Lcase(Request.QueryString("GetName"))
NewsConfigFile = "Admin/NewsSetting.xml"
If isempty(Application(SessionStr&"News"&GetName)) OR isempty(Application(SessionStr&"NewsTime"&GetName)) then
'缓存空
    Call LoadXml()
	Call Page_Main()
	Call CloseFile()
Else
'缓存BU空
  
	IF Datediff("s",Application(SessionStr&"NewsTime"&GetName),now())>0 then
  '时间已过（是）
	Call LoadXml()
	Call Page_Main()
	Call CloseFile()
  Else
  '时间未到（否）
   ' RESPONSE.END
     OutPut Application(SessionStr&"News"&GetName)
	 '&"~~~~~~~~~~"&Application(SessionStr&"NewsTime"&GetName)&NOW
  End If
End If
Sub OutPut(Strings)
	Response.Write "document.write('"
	Response.Write Strings
	Response.Write "');"
	Response.Write vbNewline
End Sub
'Response.Write "<br>页面执行时间 "&FormatNumber((Timer()-Startime)*1000,5)&" 毫秒"
Sub Page_Main()
	If GetName = "" Then
		OutPut "参数错误，调用已中止！"
		Exit Sub
	End If
	Set Node = XmlDoc.DocumentElement.selectSingleNode("NewsCode[@NewsName='"&GetName&"']")
	If (Node is nothing) Then
		OutPut "设置数据不存在，调用已中止！"
		Exit Sub
	End If
	Dim Updatetime,LastTime
	Updatetime = CheckNumeric(Node.getAttribute("Updatetime"))
	LastTime = Node.getAttribute("LastTime")
	If Updatetime>0 and IsDate(LastTime) Then
		NextTime=Dateadd("s",Updatetime,LastTime)
		Application.Lock
		Application(SessionStr&"NewsTime"&GetName)=NextTime
		Application.unLock
		If Datediff("s",LastTime,now()) > Updatetime Then
			'更新
			Call UpNewsData()
			Call SaveData()
			Application.Lock
			Application(SessionStr&"NewsTime"&GetName)=empty
			Application.unLock
		Else
			Call LoadNewsData()
		End If
	Else
		Call UpNewsData()
	End If
	Call ShowData()
End Sub
Sub LoadXml()
	NewsConfigFile = Server.MapPath(NewsConfigFile)
	Temp_Dv_ForumNews = Server.MapPath(Temp_Dv_ForumNews)
	Set XmlDoc = Server.CreateObject("MSXML.DOMDocument")
	XmlDoc.Async = False
	If Not XmlDoc.load(NewsConfigFile) Then
		XmlDoc.loadxml "<?xml version=""1.0"" encoding=""utf-8""?><NewscodeInfo/>"
	End If
End Sub
Sub CloseFile()
	Set XmlDoc = Nothing
End Sub
Sub ShowData()
	If NewsMainStr <>"" Then
		OutPut NewsMainStr
		Application.Lock
		Application(SessionStr&"News"&GetName)=NewsMainStr
		Application.UnLock
	End If
End Sub
Sub SaveData()
	If NewsMainStr = "" Then Exit Sub
	Node.Attributes.getNamedItem("LastTime").Text = Now()
	XmlDoc.save NewsConfigFile
	Dim TempXmlDoc,TempXml_Nodes,attributes,ChildNode,createCDATASection
	Set TempXmlDoc = Server.CreateObject("MSXML.DOMDocument")
	TempXmlDoc.Async = False
	If Not TempXmlDoc.load(Temp_Dv_ForumNews) Then
		TempXmlDoc.loadxml "<?xml version=""1.0"" encoding=""utf-8""?><TempNewsData/>"
	End If
	Set TempXml_Nodes = TempXmlDoc.DocumentElement.selectSingleNode("NewsData[@NewsName='"&Node.getAttribute("NewsName")&"']")
	If Not (TempXml_Nodes is nothing) Then
		TempXmlDoc.DocumentElement.RemoveChild(TempXml_Nodes)
	End If
	'创建调用数据
	Set TempXml_Nodes = XmlDoc.createNode(1,"NewsData","")
	Set attributes = TempXmlDoc.createAttribute("NewsName")
	attributes.text = Node.getAttribute("NewsName")
	TempXml_Nodes.attributes.setNamedItem(attributes)
	Set ChildNode = TempXmlDoc.createNode(1,"Temp_Data","")
	Set createCDATASection=TempXmlDoc.createCDATASection(NewsMainStr)
	ChildNode.appendChild(createCDATASection)
	TempXml_Nodes.appendChild(ChildNode)
	TempXmlDoc.documentElement.appendChild(TempXml_Nodes)
	TempXmlDoc.save Temp_Dv_ForumNews
	Set TempXmlDoc = Nothing
End Sub
Sub LoadNewsData()
	Dim TempXmlDoc,TempXml_Nodes
	Set TempXmlDoc = Server.CreateObject("MSXML.DOMDocument")
	TempXmlDoc.Async = False
	If Not TempXmlDoc.load(Temp_Dv_ForumNews) Then
		Call UpNewsData()
		Call SaveData()
		Exit Sub
	End If
	Set TempXml_Nodes = TempXmlDoc.DocumentElement.selectSingleNode("NewsData[@NewsName='"&Node.getAttribute("NewsName")&"']")
	If Not (TempXml_Nodes is nothing) Then
		NewsMainStr = TempXml_Nodes.selectSingleNode("Temp_Data").text
	Else
		Call UpNewsData()
		Call SaveData()
	End If
	Set TempXmlDoc = Nothing
End Sub
Sub UpNewsData()
    Call NewsType_1() '帖子调用
	NewsMainStr = Fixjs(NewsMainStr)
End Sub
'条目调用
Sub NewsType_1()
	Dim Skin_Main
	Dim SQL,Rs,i
	set conn=connectdb()
	SET Rs = conn.Execute(Node.selectSingleNode("Search").text)
	If Not Rs.eof Then
		SQL=Rs.GetRows(-1)
	Else
		OutPut "暂未有新条目！"
		closedb(conn)
		Exit Sub
	End If
	Rs.close:Set Rs = Nothing
    closedb(conn)
	Dim Topic,Topic2,Description2,Topiclen,Descriptionlen
	Topiclen = Node.getAttribute("Topiclen")
	Descriptionlen = Node.getAttribute("Descriptionlen")
	If Not Isnumeric(Topiclen) or Topiclen = "" Then
		Topiclen = 20
	Else
		Topiclen = Cint(Topiclen)
	End If
	If Not Isnumeric(Descriptionlen) or Descriptionlen = "" Then
		Descriptionlen = 1000
	Else
		Descriptionlen = Cint(Descriptionlen)
	End If
	
	'Call TiaoShi(SQL)
	'调试专用
	For i=0 To Ubound(SQL,2)
		Skin_Main = Node.selectSingleNode("Skin_Main").text
		Topic2=RegExpHtml(SQL(0,i),"[NoJavaScriptAndHtml]")
		Description2=RegExpHtml(SQL(4,i),"[NoJavaScriptAndHtml]")
		If Len(Topic2)>Topiclen then
			Topic = Left(Topic2,Topiclen)&"..."
		Else
            Topic=Topic2
		End if
		If Len(Description2)>Descriptionlen then
			Description = Left(Description2,Topiclen)&"..."
			Else
			Description=Description2
		End if
		
	    Skin_Main = Replace(Skin_Main,"{$WholeTopic}",SQL(0,i))
		Skin_Main = Replace(Skin_Main,"{$Topic}",Topic)
		Skin_Main = Replace(Skin_Main,"{$Topic2}",Topic2)
		Skin_Main = Replace(Skin_Main,"{$UserName}",SQL(1,i))
		Skin_Main = Replace(Skin_Main,"{$link}",SQL(2,i))
		Skin_Main = Replace(Skin_Main,"{$PostTime}",SQL(3,i))
		Skin_Main = Replace(Skin_Main,"{$site}",SQL(5,i))
		Skin_Main = Replace(Skin_Main,"{$CateName}",SQL(23,i))
		Skin_Main = Replace(Skin_Main,"{$WholeDescription}",SQL(4,i))
		Skin_Main = Replace(Skin_Main,"{$Description}",Description)
		Skin_Main = Replace(Skin_Main,"{$Description2}",Description2)
		Skin_Main = Replace(Skin_Main,"{$XmlUrl}",SQL(9,i))
		Skin_Main = Replace(Skin_Main,"{$SiteTitle}",SQL(12,i))
		Skin_Main = Replace(Skin_Main,"{$LastUpdateTime}",SQL(10,i))
		Skin_Main = Replace(Skin_Main,"{$SiteDescription}",SQL(16,i))
		NewsMainStr = NewsMainStr & Skin_Main
	Next
	NewsMainStr = Node.selectSingleNode("Skin_Head").text & NewsMainStr & Node.selectSingleNode("Skin_Footer").text
    NewsMainStr = Replace(NewsMainStr,CHR(39),"&#39;")
End Sub
Function Fixjs(Strings)
	Dim Str
	Str = Strings
	str = Replace(str, CHR(39), "'")
	str = Replace(str, CHR(13), "")
	str = Replace(str, CHR(10), "")
	str = Replace(str, "]]>","]]&gt;")
	Fixjs = str
End Function
Function FormatTime(Strings,val)
	If IsDate(Strings) and val<>"" Then
		Strings = FormatdateTime(Strings,val)
	End If
	FormatTime = Strings
End Function
Function CheckServer(str)
	Dim i,servername
	If str="" Then
		CheckServer = True
		Exit Function
	Else
		CheckServer = False
	End If
	str=split(Cstr(str),",")
	servername=Request.ServerVariables("HTTP_REFERER")
	For i=0 to Ubound(str)
	If Right(str(i),1)="/" Then str(i)=left(Trim(str(i)),Len(str(i))-1)
		If Lcase(left(servername,Len(str(i))))=Lcase(str(i)) then
			checkserver = True
			Exit For
		Else
			checkserver = False
		End if
	Next
End Function
Function CheckNumeric(Byval CHECK_ID)
		If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
			CHECK_ID = cCur(CHECK_ID) _
		Else _
			CHECK_ID = 0
		CheckNumeric = CHECK_ID
End Function
Function TiaoShi(SQL)
	For i=0 To Ubound(SQL,2) '遍历记录行
	For j=0 To Ubound(SQL,1) '遍历记录列
	Response.Write "得到第"&i+1&"行，第"&j+1&"列的记录数据(i="&i&")(j="&j&")"&SQL(j,i)&"<br>" '得到第i+1行，第j+1列的记录数据
	Next
	Next
	Response.end
End Function
%>

						