<%
	 

		Function SaveFile(Templetcontent,FileName)
			on error resume next 
 			Dim FileFSO,FileType
			 Set FileFSO = Server.CreateObject("ADODB.Stream")
				With FileFSO
				.Type = 2:.Mode = 3:.Open:
 				.Charset = "gb2312":.Position = FileFSO.Size
 				.WriteText  Templetcontent&vbcrlf & "<!-- Created Page at " & Now() & " ,By fycms.com 合肥安川网络-->" 
				.SaveToFile Server.MapPath(FileName),2
 				if err then err.clear: SaveFile = false else SaveFile = true
 				.Close
				End With
			Set FileType = nothing
			Set FileFSO = nothing
		End Function

		Sub echo(str)
			response.write str 
		End Sub 
		Sub die(str)
			  response.write str : Response.End
		End Sub 
  	    Public Function GetStrValue(ByVal strs, ByVal strlen,ns)
			If strs = "" Then GetStrValue = "":Exit Function
			If strlen=0 Then GetStrValue=strs:Exit Function
			Dim l, T, c, I, strTemp
			Dim str
			str=closeHTML(strs)
			l = Len(Str)
			T = 0
			strTemp = Str
			strlen = CLng(strlen)
			For I = 1 To l
				c = Abs(Asc(Mid(Str, I, 1)))
				If c > 255 Then
					T = T + 2
				Else
					T = T + 1
				End If
				If T >= strlen Then
					strTemp = Left(Str, I)
					Exit For
				End If
			Next
			If strTemp <> Str Then
				If ns="1" Then 
					strTemp = strTemp&"..."
				Else 
					strTemp = strTemp
				End If 
			End If 
			GetStrValue=Replace(strs,str,strTemp)
	    End Function

		Function Rep(ByVal ReContent,ByVal ReKey,ByVal ReStr)
			On Error Resume Next
			IF IsNull(ReContent) Or Len(ReContent)=0 Then ReContent=""
			IF IsNull(ReKey) Or Len(ReKey)=0 Then ReKey=""
			IF IsNull(ReStr) Or Len(ReStr)=0 Then ReStr=""
			Rep=Replace(ReContent,ReKey,ReStr,1,-1,1)
		End Function
 


		Function InStrRep(ByVal ReContent,ByVal ReKey,ByVal ReStr)
		     if isdebug=0 then On Error Resume Next
			If InStr(1,ReContent, ReKey,1) > 0  Then
 				InStrRep=rep(ReContent,ReKey,ReStr)
			Else 
  				InStrRep=ReContent
			End If 
		End Function
 







		Public Function delHtml(ContentStr)
			On Error Resume Next
			Dim TempLoseStr, regEx
			If Trim(ContentStr)="" Then Exit Function
			TempLoseStr = CStr(ContentStr)
			Set regEx = New RegExp
			regEx.Pattern = "<\/*[^<>]*>"
			regEx.IgnoreCase = True
			regEx.Global = True
			TempLoseStr = regEx.Replace(TempLoseStr, "")
			TempLoseStr=rep(TempLoseStr,"""","")
			TempLoseStr=rep(TempLoseStr,"]","")
			TempLoseStr=rep(TempLoseStr,"[","")
			delHtml = TempLoseStr
		End Function
		Function URLEncode(strs)
 			URLEncode=server.URLEncode(strs)
		End Function 
		Function URLDecode(enStr)
			On Error Resume Next
			Dim deStr,c,i,v:deStr=""
			For i=1 to len(enStr)
				c=Mid(enStr,i,1)
				If c="%" Then
					v=eval("&h"+Mid(enStr,i+1,2))
					If v<128 Then
						deStr=deStr&Chr(v)
						i=i+2
					Else
						If isvalidhex(Mid(enstr,i,3)) Then
							If isvalidhex(Mid(enstr,i+3,3)) Then	'这个判断检测是否双字节--不是
								v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
								deStr=deStr&Chr(v)
								i=i+5
							Else
								v=eval("&h"+Mid(enStr,i+1,2)+Cstr(Hex(Asc(Mid(enStr,i+3,1)))))	'--是
								deStr=deStr&Chr(v)
								i=i+3 
							End If
						Else 
							destr=destr&c
						End If
					End If
				Else
					If c="+" Then
						deStr=deStr&" "
					Else
						deStr=deStr&c
					End If
				End If
			Next
			URLDecode=deStr
		End Function

		'==================================================
		'函数名：ScriptHtml
		'作  用：过滤html标记
		'参  数：ConStr ------ 要过滤的字符串
		'==================================================
		Function ScriptHtml(ByVal Constr, TagName, FType)
 				Dim re
				Set re = New RegExp
				re.IgnoreCase = True
				re.Global = True
				Select Case FType
				Case 1
				   re.Pattern = "<" & TagName & "([^>])*>"
				   Constr = re.Replace(Constr, "")
				Case 2
				   re.Pattern = "<" & TagName & "([^>])*>.*?</" & TagName & "([^>])*>"
				   Constr = re.Replace(Constr, "")
				Case 3
				   re.Pattern = "<" & TagName & "([^>])*>"
				   Constr = re.Replace(Constr, "")
				   re.Pattern = "</" & TagName & "([^>])*>"
				   Constr = re.Replace(Constr, "")
				End Select
				ScriptHtml = Constr
				Set re = Nothing
		End Function
	
		Function isvalidhex(str)
			Dim c
			isvalidhex = True
			str = UCase(str)
			If Len(str) <> 3 Then isvalidhex = False: Exit Function
			If Left(str, 1) <> "%" Then isvalidhex = False: Exit Function
			c = Mid(str, 2, 1)
			If Not (((c >= "0") And (c <= "9")) Or ((c >= "A") And (c <= "Z"))) Then isvalidhex = False: Exit Function
			c = Mid(str, 3, 1)
			If Not (((c >= "0") And (c <= "9")) Or ((c >= "A") And (c <= "Z"))) Then isvalidhex = False: Exit Function
		End Function
 		Function closeHTML(strContent)
		  CloseHTML=strContent:Exit Function 
 		    Dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,Match
			Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			arrTags=array("strong","em","strike","b","u","i","font","span","a", "h1","h2","h3","h4","h5","h6","p","li","ol","ul","td","tr","tbody","table","blockquote","pre","cite","div")
			  For i=0 To ubound(arrTags)
				   OpenPos=0:ClosePos=0
				   re.Pattern="\<"+arrTags(i)+"( [^\<\>]+|)\>"
				   Set strMatchs=re.Execute(strContent)
				   For Each Match In strMatchs
					OpenPos=OpenPos+1
				   Next
				   re.Pattern="\</"+arrTags(i)+"\>"
				   Set strMatchs=re.Execute(strContent)
				   For Each Match In strMatchs
					ClosePos=ClosePos+1
				   Next
				   For j=1 To OpenPos-ClosePos
					  strContent=strContent+"</"+arrTags(i)+">"
				   Next
			  Next
			  CloseHTML=strContent
 		End Function 

		Function RemAsp(str)
			RemAsp=rep(str,"""","""""")
			RemAsp=rep(RemAsp,vbCrLf,"")
 		End Function 
		Function delAsp(str)
 			delAsp=rep(str,"<%","")
			delAsp=rep(delAsp,"%" & ">","")
  		End Function 

	
   		Public Function ChkNumeric(ByVal CheckID)
			If CheckID <> "" And IsNumeric(CheckID) Then
				CheckID = CDbl(CheckID)
				If CheckID < 0 Then CheckID = 0
			Else
				CheckID = 0
			End If
			ChkNumeric = CheckID
		End Function
		'过滤非法的SQL字符
		Public Function RSQL(strChar)
			If strChar = "" Or IsNull(strChar) Then RSQL = "":Exit Function
			Dim strBadChar, arrBadChar, tempChar, I
			strBadChar = "$,#,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
			arrBadChar = Split(strBadChar, ",")
			tempChar = strChar
			For I = 0 To UBound(arrBadChar)
				tempChar = Replace(tempChar, arrBadChar(I), "")
			Next
			RSQL = tempChar
		End Function
		Public Function GetIP() 
			Dim strIPAddr 
			If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" Or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
				strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
			ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
				strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
			ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
				strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
			Else 
				strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
			End If 
			getIP = Replace(Trim(Mid(strIPAddr, 1, 30)), "'", "")
			getIP = Replace(getIP,";","")
			getIP = Replace(getIP,"-","")
			getIP = Replace(getIP,"(","")
			getIP = Replace(getIP,")","")
			getIP = Replace(getIP,">","")
			getIP = Replace(getIP,"<","")
			getIP = Replace(getIP,"=","")
			getIP = Replace(getIP,"*","")
	   End Function
  	 
		Function  LoadTemplate(TempString) 
				on error resume next
				Dim  Str,A_W
				set A_W=server.CreateObject("adodb.Stream")
				A_W.Type=2:A_W.mode=3:A_W.charset="gb2312":A_W.open
				A_W.loadfromfile server.MapPath(fycms.ThisTheme&"/"&TempString)
				If Err.Number<>0 Then Err.Clear:LoadTemplate=fycms.ThisTheme&"/"&TempString&"模板没有找到 <br> by <a href=""http://www.fycms.com"" title=""aspcms"">fycms</a>":Exit Function
				Str=A_W.readtext
				A_W.Close
				Set  A_W=nothing
				LoadTemplate=Str
		End  Function
		Function  LTemplate(temppath) 
			on error resume next
			Dim  Str,A_W
			set A_W=server.CreateObject("adodb.Stream")
			A_W.Type=2 
			A_W.mode=3 
			A_W.charset="gb2312"
			A_W.open
			A_W.loadfromfile server.MapPath(temppath)
			If Err.Number<>0 Then Err.Clear:LTemplate="":Exit Function
			Str=A_W.readtext
			A_W.Close
			Set  A_W=nothing
			LTemplate=Str
		End  function
	 
	 


		Function variables(TemplateContent)
 			Dim vxml,s_isset,s_QQ,s_content,s_wangwang,s_footlinks,s_footlink,s_display
   			VXML=fycms.NoAppGetXMLFromFile(server.MapPath(fycms.actsys&"plus/service/service.xml"))
			If IsObject(VXML) And VXML.readyState=4 Then
				If VXML.parseError.errorCode <> 0 Then 
				Else 
					s_QQ=VXML.documentElement.selectSingleNode("QQ").text
					s_isset=VXML.documentElement.selectSingleNode("isset").text
					s_tel=VXML.documentElement.selectSingleNode("tel").text
					s_content=VXML.documentElement.selectSingleNode("content").text
					s_wangwang=VXML.documentElement.selectSingleNode("wangwang").text
					s_footlink=VXML.documentElement.selectSingleNode("footlink").Text
					s_display=VXML.documentElement.selectSingleNode("display").Text
				End If 
			Set VXML=Nothing
			End If 
  		End Function 








		Function CheckXSS(ByVal strCode)
			Dim Re
			Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern="<.[^>]*(style).>"
			strCode = re.Replace(strCode, "")
			re.Pattern="<(a.[^>]*|\/a|li|br|B|\/li|\/B|font.[^>]*|\/font)>"
			strCode=re.Replace(strCode,"[$1]")
			strCode=Replace(Replace(strCode, "<", "&lt;"), ">", "&gt;")
			re.Pattern="\[(a.[^\]]*|\/a|li|br|B|\/li|\/B|font.[^\]]*|\/font)\]"
			strCode=re.Replace(strCode,"<$1>")
			re.Pattern="<.[^>]*(on(load|click|dbclick|mouseover|mouseout|mousedown|mouseup|mousewheel|keydown|submit|change|focus)).>"
			strCode = re.Replace(strCode, "")
			Set Re=Nothing
			CheckXSS=strCode
	   End Function




		Function languagerlist(Modeid,str)
			Dim arr,li,languagc
			languagc=fycms.ACT_C(Modeid,17)
			If languagc<>"0" Then 
 				arr=Split(fycms.ACT_C(Modeid,17),chr(10))
			Else 
				arr=Split(LTemplate(fycms.actsys&"fy_inc/lan.txt"),vbCrLf)
			End If 
			
			For li=0 To ubound(arr)
				If checkarr(arr(li),str)<>"Lack of language pack" Then languagerlist=checkarr(arr(li),str):Exit For 
			Next 
			
		End Function 
	  
		 Function checkarr(arrstr,str)
				Dim arrs
				arrs=Split(arrstr,"=")
				If ubound(arrs)=1 Then 
					If Trim(arrs(0))=Str Then 
						checkarr=arrs(1) 
					Else 
						checkarr="Lack of language pack"  
					End If 
				Else 
						checkarr="Lack of language pack"  
				End If 
		 End Function 



		Function noSaveFile(Templetcontent,FileName)
 			on error resume next 
 			Dim FileFSO,FileType
			 Set FileFSO = Server.CreateObject("ADODB.Stream")
				With FileFSO
				.Type = 2:.Mode = 3:.Open:
 				.Charset = "gb2312":.Position = FileFSO.Size
 				.WriteText  Templetcontent
				.SaveToFile Server.MapPath(FileName),2
 				if err then err.clear: noSaveFile = false else noSaveFile = true
 				.Close
				End With
			Set FileType = nothing
			Set FileFSO = nothing
		End Function

		Function tojs(jscontent)
			If jscontent="" Then tojs="":Exit Function
			jscontent=Replace(jscontent,Chr(39), "\'")
			jscontent=Replace(jscontent,"""","\""")
			jscontent=Replace(jscontent,vbCrLf, "")
			'jscontent=Replace(jscontent,"'", "\'")
			jscontent=Replace(jscontent,"/", "\/")
 			
			tojs=jscontent
		End Function 

 		Function FileExists(fileName)
			On Error Resume Next
			Dim objFSO
			FileExists = False
			Set objFSO = CreateObject(fycms.FsoName)
			If objFSO.FileExists(fileName) Then
				FileExists = True
			End If
			Set objFSO = Nothing
			Err.Clear
		End Function
		
		Function getcontentxml(modeid,id,addtime)
			getcontentxml=LTemplate(fycms.ActSys&"data/"&ModeID&"/"&md5(addtime&id,32)&".txt")
 		End Function 

		Public Function Userface(userid)
			If ChkNumeric(userid)="0"  Then Userface=fycms.actsys&"user/images/nophoto.gif":Exit Function 
			Dim rs3
			Set rs3=fycms.actexe("select userid,myface  from User_fy where userid=" & userid & "")	
			If Not rs3.eof Then 
			If rs3("myface")<>"" Then 
				Userface=rs3("myface")
			Else 
				Userface=fycms.actsys&"user/images/nophoto.gif"
			End If 
			rs3.Close:Set rs3=Nothing
			End If 
		End Function 

 		Public Function UserLink(userid)
			If ChkNumeric(userid)="0"  Then UserLink="#":Exit Function 
			Dim rs3
			Set rs3=fycms.actexe("select top 1 userid,UmodeID from User_fy where userid=" & userid & "")	
			If Not rs3.eof Then 
				UserLink=fycms.actsys&"space/index.asp?c="&fycms.ACT_U(rs3("UmodeID"),5)&"&uid="&rs3("userid")
			rs3.Close:Set rs3=Nothing
			End If 
		End Function 


 		Public Function Userinfo(username)
		    username=rsql(username)
			Dim rs3
			Set rs3=fycms.actexe("select top 1 userid,UmodeID from User_fy where username='" & username & "'")	
			If Not rs3.eof Then 
				Userinfo=rs3("userid")
				rs3.Close:Set rs3=Nothing
			Else 
				Userinfo=0
			End If 
		End Function 





	    Function  rewriteurlstr(rewriteurl,ID)
		  Dim rs2,strs,i,sql,strs3,tempstrs
			Set rs2=fycms.actexe("Select id,entitle From plusget_fy Where cID="&ID)
		  If Not  rs2.eof Then 
		  sql=rs2.getrows(-1)
		  for i=0 to ubound(sql,2)
			tempstrs= server.URLEncode(rsql(fycms.s(sql(1,i))))
			If Trim(tempstrs)="" Then tempstrs="fycms.com"
			rewriteurl=rep(rewriteurl,"{"&sql(1,i)&"}",tempstrs)
		  Next
		End If 
		rewriteurlstr= rewriteurl
	   End  Function 
		Public Function UName(userid)
			If ChkNumeric(userid)="0"  Then UName="匿名":Exit Function 
			Dim rs3
			Set rs3=fycms.actexe("select [UserName] from User_fy where userid=" & userid & "")	
			If Not rs3.eof Then 
				UName=rs3("UserName")
			rs3.Close:Set rs3=Nothing
			End If 
		End Function 


		Function getlink(cid,id,f)
			Dim gModeID,rsk
 			gModeID=fycms.ACT_L(cid,10) 
			If gModeID=0 Then gModeID=1
			Set rsk=fycms.actexe("select * from "&fycms.ACT_C(gModeID,2)&" where id="&id)
			If Not rsk.eof Then 
				Select Case f
					Case "link"
						getlink=fycms.GetInfoUrl(gModeID,rsk("ClassID"),rsk("ID"),rsk("ActLink"),rsk("FileName"),rsk("infopurview"),rsk("readpoint"),rsk("pinyin"))
					Case Else 
						getlink=rsk(f)
 				End Select 
 			rsk.Close:Set rsk=Nothing
			End If 
 		End Function 
		
		
		Function getlinkM(gModeID,id,f)
			If gModeID=0 Then gModeID=1
			Dim rsm
			Set rsm=fycms.actexe("select * from "&fycms.ACT_C(gModeID,2)&" where id="&id)
			If Not rsm.eof Then 
				Select Case f
					Case "link"
						getlinkM=fycms.GetInfoUrl(gModeID,rsm("ClassID"),rsm("ID"),rsm("ActLink"),rsm("FileName"),rsm("infopurview"),rsm("readpoint"),rsm("pinyin"))
					Case Else 
						getlinkM=rsm(f)
 				End Select 
 			rsm.Close:Set rsm=Nothing
			End If 
 		End Function 

	Function IsNul(Str)
	  If Str="" Or IsNull(Str) Then IsNul=True Else IsNul=false
	End Function


	Function tag(tStr)
		Dim t,c
		t = Split(tStr, ","): tStr = ""
		For c = 0 To UBound(t)
			If Len(tStr) > 0 Then tStr = tStr & " " 
			tStr = tStr & " <a href='" &fycms.actsys & "plus/search/index.asp?keyword=" & Server.UrlEnCode(t(c)) & "'>" & t(c) & "</a>"
		Next
		tag=tStr
	End Function
	function tojpeg(byval picfile,byval cwidth,byval cheight)
		if not fycms.IsobjInstalled("Persits.Jpeg") or lcase(left(picfile,7)) = "http://" then tojpeg = picfile :exit function
		dim savefolder,savefile,ext,FSOjpg
 		ext=LCase(Mid(picfile,InStrRev (picfile, ".")+1))
		savefile= rep(picfile,"."&ext,"")&"_"& cwidth & "x" & cheight & ".jpg"
		Set FSOjpg = CreateObject(fycms.FsoName)
		if FSOjpg.fileexists(server.mappath(savefile)) then
			tojpeg = savefile
		else
			dim jpeg
			dim jwidth,jheight,nwidth,nheight
			dim x1,y1,x2,y2
			on error resume next
			set jpeg = server.createobject("Persits.Jpeg")
			jpeg.regkey = "48958-77556-02411"
			jpeg.open server.mappath(picfile)
			jwidth = jpeg.originalwidth
			jheight = jpeg.originalheight
			if (jwidth/jheight)>=(cwidth/cheight) then
				nwidth=cint((jwidth/jheight)*cheight):nheight=cheight
				jpeg.width=nwidth:jpeg.height=nheight
				x1=int((nwidth-cwidth)/2):y1=0:x2=x1+cwidth:y2=cheight
			else
				nwidth=cwidth:nheight=cint((jheight/jwidth)*cwidth)
				jpeg.width=nwidth:jpeg.height=nheight
				x1=0:y1=int((nheight-cheight)/2):x2=cwidth:y2=y1+cheight
			end if
			jpeg.crop x1,y1,x2,y2
			jpeg.sharpen 1,130
			jpeg.save server.mappath(savefile)
			set jpeg = nothing
			if err then
				tojpeg = picfile : err.clear
			else
				tojpeg = savefile
			end if
		end if
	End  Function
	

		Function GetserviceQQ(Content,st)
		  Dim TitleTypeArr,i,arrtitle,titles,arrvalue,servicestr
		 
		  TitleTypeArr=Split(Content, chr(10))
 		  For I = 0 To UBound(TitleTypeArr)
 			arrtitle=Split(TitleTypeArr(I),"-")
 			If  UBound(arrtitle)="1" Then 
 				titles=arrtitle(0)
				arrvalue=arrtitle(1)
			ElseIf  TitleTypeArr(I)<>"" Then 
			titles="客服"&I
			arrvalue=arrtitle(0)
		
			Else
				Exit for
			End If 
			If st=1 Then 
 			  servicestr=servicestr& "                 <li class=""icoTc"">" & vbCrLf
			  servicestr=servicestr& "					<a  target=""_blank"" rel=""nofollow"" href=""http://wpa.qq.com/msgrd?v=3&uin="&arrvalue&"&site=qq&menu=yes""><img border=""0"" src=""http://wpa.qq.com/pa?p=2:"&arrvalue&":52"" alt=""点击这里给我发消息"" title=""点击这里给我发消息""/>"&titles&"</a>" & vbCrLf
			  servicestr=servicestr& "                </li>" & vbCrLf
		    Else 
 			  servicestr=servicestr& "                 <li class=""icoTc"">" & vbCrLf
			  servicestr=servicestr& "					<a  target=""_blank""  rel=""nofollow"" href=""http://amos1.taobao.com/msg.ww?v=2&uid="&arrvalue&"&s=1""><img border=""0"" src=""http://amos1.taobao.com/online.ww?v=2&uid="&arrvalue&"&s=1"" alt=""点击这里给我发消息"" title=""点击这里给我发消息""/>"&titles&"</a>" & vbCrLf
			  servicestr=servicestr& "                </li>" & vbCrLf
 			End If 
 		  Next
			GetserviceQQ=servicestr
	   End Function 
 

	 Function Getservice()
			Dim vxml,s_isset,s_QQ,s_content,s_wangwang,s_footlinks,s_footlink,s_display,servicestr,s_tel
			Set VXML=fycms.NoAppGetXMLFromFile(server.MapPath(fycms.actsys&"plus/service/service.xml"))
			If IsObject(VXML) And VXML.readyState=4 Then
				If VXML.parseError.errorCode <> 0 Then 
				Else 
					s_QQ=VXML.documentElement.selectSingleNode("QQ").text
					s_isset=VXML.documentElement.selectSingleNode("isset").text
					s_tel=VXML.documentElement.selectSingleNode("tel").text
					s_content=VXML.documentElement.selectSingleNode("content").text
					s_wangwang=VXML.documentElement.selectSingleNode("wangwang").text
					s_footlink=VXML.documentElement.selectSingleNode("footlink").Text
					s_display=VXML.documentElement.selectSingleNode("display").Text
				End If 
			Set VXML=Nothing
			End If 
			
		  If s_isset="2" Then Getservice="":Exit Function 
		  servicestr=servicestr&"<link rel=""stylesheet"" type=""text/css"" href="""&fycms.actsys&"plus/service/images/pub.css"">"&vbcrlf
		  servicestr=servicestr&"<script type=""text/javascript"" src="""&fycms.actsys&"plus/service/js/service.js""></script>"&vbcrlf
		  servicestr=servicestr& "<div id=""floatTools"" class=""serviceright"">" & vbCrLf
		  servicestr=servicestr& "   <div class=""floatL"">" & vbCrLf
		  servicestr=servicestr& "       <a id=""aFloatTools_Show"" class=""btnOpen"" style=""display:none;"" href=""javascript:void(0);"" onclick=""javascript:$('#divFloatToolsView').animate({width: 'show', opacity: 'show'}, 'normal',function(){ $('#divFloatToolsView').show(); });$('#aFloatTools_Show').attr('style','display:none');$('#aFloatTools_Hide').attr('style','display:block');return false;"" title=""查看在线客服"">展开</a>" & vbCrLf
		  servicestr=servicestr& "        <a id=""aFloatTools_Hide"" class=""btnCtn"" href=""javascript:void(0);"" onclick=""javascript:$('#divFloatToolsView').animate({width: 'hide', opacity: 'hide'}, 'normal',function(){ $('#divFloatToolsView').hide(); });$('#aFloatTools_Show').attr('style','display:block');$('#aFloatTools_Hide').attr('style','display:none');return false;"" title=""关闭在线客服"">收缩</a>" & vbCrLf
		  servicestr=servicestr& "       " & vbCrLf
		  servicestr=servicestr& "   </div>" & vbCrLf
		  servicestr=servicestr& "   <div class=""floatR"" id=""divFloatToolsView"" >" & vbCrLf
		  servicestr=servicestr& "   	<div class=""tp""></div>" & vbCrLf
		  servicestr=servicestr& "       <div class=""cn"" >" & vbCrLf
		  servicestr=servicestr& "           <ul>" & vbCrLf
		  servicestr=servicestr& "               <li class=""top""><h3 class=""titZx"">QQ咨询</h3></li>" & vbCrLf
		  servicestr=servicestr&GetserviceQQ(s_QQ,1)
 		  servicestr=servicestr&GetserviceQQ(s_wangwang,2)
		  servicestr=servicestr& "             </ul>" & vbCrLf
		  servicestr=servicestr& "           " & vbCrLf
		  If Trim(s_tel)<>"" Then 
			  servicestr=servicestr& "            <ul>" & vbCrLf
			  servicestr=servicestr& "               <li><h3 class=""titDh"">电话咨询</h3></li>" & vbCrLf
			  servicestr=servicestr& "               <li>" & vbCrLf
			  servicestr=servicestr& "                   <span class=""icoTl"" title=""电话"&s_tel&""">"&s_tel&"</span>" & vbCrLf
			  servicestr=servicestr& "               </li>" & vbCrLf
		  End If 
		  If Trim(s_footlink)<>"" Then 
		  servicestr=servicestr& "               <li class=""bot""><h3 class=""titDc""><a href="""&s_footlink&""" target=""_blank"">联系我们</a></h3></li>" & vbCrLf
		  End If 
		  servicestr=servicestr& "           </ul>" & vbCrLf
		  servicestr=servicestr& "       </div>" & vbCrLf
		  servicestr=servicestr& "   </div>" & vbCrLf
		  servicestr=servicestr& "</div>" & vbCrLf
 		  If Trim(s_display)="2" Then 
			  servicestr=servicestr& "<script language=""javascript"" type=""text/javascript"">"
			  servicestr=servicestr& "	 $('#divFloatToolsView').animate({width: 'hide', opacity: 'hide'}, 'normal',function(){ $('#divFloatToolsView').hide();});$('#aFloatTools_Show').attr('style','display:block');$('#aFloatTools_Hide').attr('style','display:none');"
			  servicestr=servicestr& "	 </script>"
		  End If 
		   servicestr=servicestr&s_content
		  Getservice=servicestr
	 End Function 



%>