<!--#include file="conn.asp"-->
<!--#Include File="inc/Dv_ClsMain.asp"-->
<%
Dim DefaultAvatarBoy, DefaultAvatarGirl
Dim AvatarXMLDOM
Dim Temp_Plus_AvatarNews
'//*****************************************************************************//
''@ 设置外部调用限制
Const LockUrl = ""
''@ 说明：只允许调用网址,要以"HTTP://"开头,为空则不限制所有外部调用.(可允许多网址限制，要以","分隔。)
''@ 使用：例如只允许此两个网址调用: lockurl="http://www.artistsky.net/,http://www.artbbs.net/"
'//*****************************************************************************//
'//*****************************************************************************//
''@ 设置更新时间
Const UpdateTime = 300
'//*****************************************************************************//
'//*****************************************************************************//
''@ 设置临时文件名
Temp_Plus_AvatarNews = "Dv_Plus/Avatar/Plus_Avatar_TempNews.config"	'临时文件名可自行修改。该文件可以随时删除清理。
'//*****************************************************************************//

If CheckServer(Lockurl)=False then
	OutPut "数据被保护,禁止被其他站点调用!"
	Response.End	
End If
If Not IsObject(Application(Dvbbs.CacheName & "_Avatar")) Then
	OutPut "形象系统尚未初始化，不能进行形象调用！"
	Response.End	
End If
DefaultAvatarBoy = "||||||14.7|13.8|12.9||11.11||10.13|9.14||||8.18|||||||"
                                  ' 默认男性形象
DefaultAvatarGirl = "||||||7.7|6.8|5.9||4.11||3.13|2.14||||1.18|||||||"
                                  ' 默认女性形象
Set AvatarXMLDOM = Application(Dvbbs.CacheName & "_Avatar").CloneNode(True)

Dim NewsConfigFile
Dim XmlDoc,Node,NewsMainStr
Dim BbsUrl
Dim UserName, SpouseName

BbsUrl = Dvbbs.Get_ScriptNameUrl
NewsConfigFile = "Dv_Plus/Avatar/Plus_Avatar_NewsSetting.config"

UserName = Dvbbs.CheckStr(Trim(Request.QueryString("UserName")))
If UserName = "" Then
	OutPut "参数错误，调用已中止！"
	Response.End
End If
SpouseName = Dvbbs.CheckStr(Trim(Request.QueryString("SpouseName")))

Call LoadXml()
Call Page_Main()
Call CloseFile()

Sub Page_Main()
	Dim attributes
	If SpouseName = "" Then
		Set Node = XmlDoc.DocumentElement.selectSingleNode("Avatar[@UserName='" & UserName & "']")
		If (Node is nothing) Then
			Set Node = XmlDoc.createNode(1,"Avatar","")
			Set attributes = XmlDoc.createAttribute("UserName")
			attributes.text = UserName
			node.attributes.setNamedItem(attributes)
			Set attributes = XmlDoc.createAttribute("LastTime")
			attributes.text = DateAdd("s", -UpdateTime, Now())
			node.attributes.setNamedItem(attributes)
			XmlDoc.documentElement.appendChild(node)
		End If
	Else
		Set Node = XmlDoc.DocumentElement.selectSingleNode("Marriage[@UserName='" & UserName & "' and @SpouseName='" & SpouseName & "']")
		If (Node is nothing) Then
			Set Node = XmlDoc.createNode(1,"Marriage","")
			Set attributes = XmlDoc.createAttribute("UserName")
			attributes.text = UserName
			node.attributes.setNamedItem(attributes)
			Set attributes = XmlDoc.createAttribute("SpouseName")
			attributes.text = SpouseName
			node.attributes.setNamedItem(attributes)
			Set attributes = XmlDoc.createAttribute("LastTime")
			attributes.text = DateAdd("s", -UpdateTime, Now())
			node.attributes.setNamedItem(attributes)
			XmlDoc.documentElement.appendChild(node)
		End If
	End If
	Dim LastTime
	LastTime = Node.getAttribute("LastTime")
	If IsDate(LastTime) Then
		If Datediff("s",LastTime,now()) > Updatetime Then
			'更新
			Call UpNewsData()
			Call SaveData()
		Else
			Call LoadNewsData()
		End If
	Else
		Call UpNewsData()
	End If
	Call ShowData()
End Sub

Sub LoadXml()
	NewsConfigFile = Server.MapPath(NewsConfigFile)
	Temp_Plus_AvatarNews = Server.MapPath(Temp_Plus_AvatarNews)
	Set XmlDoc = Server.CreateObject("MSXML.DOMDocument")
	XmlDoc.Async = False
	If Not XmlDoc.load(NewsConfigFile) Then
		XmlDoc.loadxml "<?xml version=""1.0"" encoding=""gb2312""?><TempNewsData/>"
	End If
End Sub

Sub CloseFile()
	Set XmlDoc = Nothing
End Sub

Sub ShowData()
	If NewsMainStr <>"" Then
		OutPut NewsMainStr
	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_Plus_AvatarNews) Then
		TempXmlDoc.loadxml "<?xml version=""1.0"" encoding=""gb2312""?><TempNewsData/>"
	End If
	If SpouseName = "" Then
		Set TempXml_Nodes = TempXmlDoc.DocumentElement.selectSingleNode("Avatar[@UserName='"&Node.getAttribute("UserName")&"']")
	Else
		Set TempXml_Nodes = TempXmlDoc.DocumentElement.selectSingleNode("Marriage[@UserName='"&Node.getAttribute("UserName")&"' and @SpouseName='"&Node.getAttribute("SpouseName")&"']")
	End If
	If Not (TempXml_Nodes is nothing) Then
		TempXmlDoc.DocumentElement.RemoveChild(TempXml_Nodes)
	End If
	'创建调用数据
	If SpouseName = "" Then
		Set TempXml_Nodes = XmlDoc.createNode(1,"Avatar","")
	Else
		Set TempXml_Nodes = XmlDoc.createNode(1,"Marriage","")
	End If
	Set attributes = TempXmlDoc.createAttribute("UserName")
	attributes.text = Node.getAttribute("UserName")
	TempXml_Nodes.attributes.setNamedItem(attributes)
	If SpouseName <> "" Then
		Set attributes = TempXmlDoc.createAttribute("SpouseName")
		attributes.text = Node.getAttribute("SpouseName")
		TempXml_Nodes.attributes.setNamedItem(attributes)
	End If
	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_Plus_AvatarNews
	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_Plus_AvatarNews) Then
		Call UpNewsData()
		Call SaveData()
		Exit Sub
	End If
	If SpouseName = "" Then
		Set TempXml_Nodes = TempXmlDoc.DocumentElement.selectSingleNode("Avatar[@UserName='"&Node.getAttribute("UserName")&"']")
	Else
		Set TempXml_Nodes = TempXmlDoc.DocumentElement.selectSingleNode("Marriage[@UserName='"&Node.getAttribute("UserName")&"' and SpouseName='"&Node.getAttribute("SpouseName")&"']")
	End If
	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 OutPut(Strings)
	'Response.Write "document.write('"
	Response.Write Strings
	'Response.Write "');"
	Response.Write vbNewline
End Sub

Sub UpNewsData()
	If SpouseName = "" Then
		Call NewsType_90() '形象调用
	Else
		Call NewsType_91() '结婚调用
	End If
End Sub

'形象调用
Sub NewsType_90()
	Dim Skin_Main
	Dim Rs,i
	Dim UserAvaSetting, UserSex
	UserName = Trim(Dvbbs.CheckStr(Request.QueryString("UserName")))
	Set Rs = Dvbbs.Execute("Select Top 1 UserAvaSetting,UserSex From Dv_User Where UserName='" & UserName & "'")
	If Not Rs.eof Then
		UserAvaSetting = Replace(Rs(0), Chr(13), "")
		UserSex = Rs(1)
	Else
		OutPut "该用户不存在"
		Exit Sub
	End If
	Rs.close:Set Rs = Nothing
	Dim AvatarFlag
	AvatarFlag = True
	If IsNull(UserAvaSetting) Or UserAvaSetting = "" Then
		AvatarFlag = False
	ElseIf UBound(Split(UserAvaSetting, "|")) <> 24 Then
		AvatarFlag = False
	End If
	If Not AvatarFlag Then
		If UserSex = 1 Then
			UserAvaSetting = DefaultAvatarBoy
		Else
			UserAvaSetting = DefaultAvatarGirl
		End If
	End If
	Skin_Main = "DvbbsShowAvatar('{$UserAvaSetting}','1','1','0','{$AvatarWidth}','{$AvatarHeight}','{$InnerLeft1}','{$InnerTop1}','{$InnerWidth1}','{$InnerHeight1}','{$InnerLeft2}','{$InnerTop2}','{$InnerWidth2}','{$InnerHeight2}','','{$LocalPic}','{$PicPath}','0','0','{$AvatarTitle}','{$AvatarUserName}',0,'','{$ForumURL}');"
	Skin_Main=Replace(Skin_Main,"{$UserAvaSetting}",UserAvaSetting)
	If LCase(Trim(UserName)) = LCase(Trim(Dvbbs.MemberName)) Then
		Skin_Main=Replace(Skin_Main,"{$AvatarTitle}","您的虚拟形象")
		Skin_Main=Replace(Skin_Main,"{$AvatarUserName}","")
	Else
		Skin_Main=Replace(Skin_Main,"{$AvatarTitle}",UserName & "的虚拟形象")
		Skin_Main=Replace(Skin_Main,"{$AvatarUserName}",UserName)
	End If
	With AvatarXMLDOM.documentElement.selectSingleNode("AvatarInfo").Attributes
		Skin_Main=Replace(Skin_Main,"{$AvatarWidth}",.getNamedItem("AvatarWidth").Text)
		Skin_Main=Replace(Skin_Main,"{$AvatarHeight}",.getNamedItem("AvatarHeight").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerLeft1}",.getNamedItem("InnerLeft1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerTop1}",.getNamedItem("InnerTop1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerWidth1}",.getNamedItem("InnerWidth1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerHeight1}",.getNamedItem("InnerHeight1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerLeft2}",.getNamedItem("InnerLeft2").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerTop2}",.getNamedItem("InnerTop2").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerWidth2}",.getNamedItem("InnerWidth2").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerHeight2}",.getNamedItem("InnerHeight2").Text)
		Skin_Main=Replace(Skin_Main,"{$LocalPic}",.getNamedItem("LocalPic").Text)
		Skin_Main=Replace(Skin_Main,"{$PicPath}",.getNamedItem("PicPath").Text)
	End With
	Skin_Main=Replace(Skin_Main,"{$ForumURL}",BbsUrl)
	NewsMainStr = Skin_Main
End Sub

'结婚调用
Sub NewsType_91()
	Dim Skin_Main
	Dim Rs,i
	Dim UserAvaSetting, UserSex
	Dim SpouseAvaSetting, SpouseSex
	Set Rs = Dvbbs.Execute("Select Top 1 UserAvaSetting,UserSex From Dv_User Where UserName='" & UserName & "'")
	If Not Rs.eof Then
		UserAvaSetting = Replace(Rs(0), Chr(13), "")
		If InStr(UserAvaSetting, ",") > 0 Then UserAvaSetting = Split(UserAvaSetting, ",")(0)
		UserSex = Rs(1)
	Else
		OutPut "户主不存在"
		Exit Sub
	End If
	Rs.Close
	Set Rs = Dvbbs.Execute("Select Top 1 UserAvaSetting,UserSex From Dv_User Where UserName='" & SpouseName & "'")
	If Not Rs.eof Then
		SpouseAvaSetting = Replace(Rs(0), Chr(13), "")
		If InStr(SpouseAvaSetting, ",") > 0 Then SpouseAvaSetting = Split(SpouseAvaSetting, ",")(0)
		SpouseSex = Rs(1)
	Else
		OutPut "配偶不存在"
		Exit Sub
	End If
	Rs.Close
	Set Rs = Nothing
	Dim AvatarFlag
	AvatarFlag = True
	If IsNull(UserAvaSetting) Or UserAvaSetting = "" Then
		AvatarFlag = False
	ElseIf UBound(Split(UserAvaSetting, "|")) <> 24 Then
		AvatarFlag = False
	End If
	If Not AvatarFlag Then
		If UserSex = 1 Then
			UserAvaSetting = DefaultAvatarBoy
		Else
			UserAvaSetting = DefaultAvatarGirl
		End If
	End If
	AvatarFlag = True
	If IsNull(SpouseAvaSetting) Or SpouseAvaSetting = "" Then
		AvatarFlag = False
	ElseIf UBound(Split(SpouseAvaSetting, "|")) <> 24 Then
		AvatarFlag = False
	End If
	If Not AvatarFlag Then
		If SpouseSex = 1 Then
			SpouseAvaSetting = DefaultAvatarBoy
		Else
			SpouseAvaSetting = DefaultAvatarGirl
		End If
	End If
	Skin_Main = "DvbbsShowMarriageAvatar('{$UserName}','{$UserAvaSetting}','{$SpouseName}','{$SpouseAvaSetting}','{$AvatarWidth}','{$AvatarHeight}','{$InnerLeft1}','{$InnerTop1}','{$InnerWidth1}','{$InnerHeight1}','{$InnerLeft2}','{$InnerTop2}','{$InnerWidth2}','{$InnerHeight2}','','{$LocalPic}','{$PicPath}','0','0','','{$ForumURL}');"
	Skin_Main=Replace(Skin_Main,"{$UserAvaSetting}",UserAvaSetting)
	Skin_Main=Replace(Skin_Main,"{$UserName}",UserName)
	Skin_Main=Replace(Skin_Main,"{$SpouseAvaSetting}",SpouseAvaSetting)
	Skin_Main=Replace(Skin_Main,"{$SpouseName}",SpouseName)
	With AvatarXMLDOM.documentElement.selectSingleNode("AvatarInfo").Attributes
		Skin_Main=Replace(Skin_Main,"{$AvatarWidth}",.getNamedItem("AvatarWidth").Text)
		Skin_Main=Replace(Skin_Main,"{$AvatarHeight}",.getNamedItem("AvatarHeight").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerLeft1}",.getNamedItem("InnerLeft1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerTop1}",.getNamedItem("InnerTop1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerWidth1}",.getNamedItem("InnerWidth1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerHeight1}",.getNamedItem("InnerHeight1").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerLeft2}",.getNamedItem("InnerLeft2").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerTop2}",.getNamedItem("InnerTop2").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerWidth2}",.getNamedItem("InnerWidth2").Text)
		Skin_Main=Replace(Skin_Main,"{$InnerHeight2}",.getNamedItem("InnerHeight2").Text)
		Skin_Main=Replace(Skin_Main,"{$LocalPic}",.getNamedItem("LocalPic").Text)
		Skin_Main=Replace(Skin_Main,"{$PicPath}",.getNamedItem("PicPath").Text)
	End With
	Skin_Main=Replace(Skin_Main,"{$ForumURL}",BbsUrl)
	NewsMainStr = Skin_Main
End Sub

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
%>