function.asp

秘密网源代码 传闻拉了 100W风投

<!--#include file = "Img.asp"-->
<%
Dim WoDig
Set WoDig = New Woddig_Class	
Class Woddig_Class
	'截取定义长度的字符。。。。
	Public Function get_StrLen(str,len2)
		if str = "" or isNull(str) or len2 = 0 then
			get_StrLen = ""
		else
			if len(str) < len2 then
				get_strLen = str
			else
				get_strLen = left(str,len2) & "。。。 "
			end if
		end if
	End Function

	'专门用来去除内容中的文本害码。。。
	Public Function DecodeFilter(html, filter)
		html=LCase(html)
		filter=split(filter,",")
		For Each i In filter
			Select Case i
				Case "SCRIPT"		' 去除所有客户端脚本javascipt,vbscript,jscript,js,vbs,event,...
					html = exeRE("(javascript|jscript|vbscript|vbs):", "#", html)
					html = exeRE("</?script[^>]*>", "", html)
					html = exeRE("on(mouse|exit|error|click|key)", "", html)
				Case "TABLE":		' 去除表格<table><tr><td><th>
					html = exeRE("</?table[^>]*>", "", html)
					html = exeRE("</?tr[^>]*>", "", html)
					html = exeRE("</?th[^>]*>", "", html)
					html = exeRE("</?td[^>]*>", "", html)
					html = exeRE("</?tbody[^>]*>", "", html)
				Case "CLASS"		' 去除样式类class=""
					html = exeRE("(<[^>]+) class=[^ |^>]*([^>]*>)", "$1 $2", html) 
				Case "STYLE"		' 去除样式style=""
					html = exeRE("(<[^>]+) style=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) style='[^']*'([^>]*>)", "$1 $2", html)
				Case "IMG"		' 去除样式style=""
					html = exeRE("</?img[^>]*>", "", html)
				Case "XML"		' 去除XML<?xml>
					html = exeRE("<\\?xml[^>]*>", "", html)
				Case "NAMESPACE"	' 去除命名空间<o:p></o:p>
					html = exeRE("<\/?[a-z]+:[^>]*>", "", html)
				Case "FONT"		' 去除字体<font></font>
					html = exeRE("</?font[^>]*>", "", html)
					html = exeRE("</?a[^>]*>", "", html)
					html = exeRE("</?span[^>]*>", "", html)
					html = exeRE("</?br[^>]*>", "", html)
				Case "MARQUEE"		' 去除字幕<marquee></marquee>
					html = exeRE("</?marquee[^>]*>", "", html)
				Case "OBJECT"		' 去除对象<object><param><embed></object>
					html = exeRE("</?object[^>]*>", "", html)
					html = exeRE("</?param[^>]*>", "", html)
					'html = exeRE("</?embed[^>]*>", "", html)
				Case "EMBED"
				   html =  exeRE("</?embed[^>]*>", "", html)
				Case "DIV"		' 去除对象<object><param><embed></object>
					html = exeRE("</?div([^>])*>", "$1", html)
					html = exeRE("</?p([^>])*>", "$1", html)
				Case "ONLOAD"		' 去除样式style=""
					html = exeRE("(<[^>]+) onload=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) onload='[^']*'([^>]*>)", "$1 $2", html)
				Case "ONCLICK"		' 去除样式style=""
					html = exeRE("(<[^>]+) onclick=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) onclick='[^']*'([^>]*>)", "$1 $2", html)
				Case "ONDBCLICK"		' 去除样式style=""
					html = exeRE("(<[^>]+) ondbclick=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) ondbclick='[^']*'([^>]*>)", "$1 $2", html)
					
			End Select
		Next
		'html = Replace(html,"<table","<")
		'html = Replace(html,"<tr","<")
		'html = Replace(html,"<td","<")
		DecodeFilter = html
	End Function
  '用于将介绍信息中的链接转成在新窗口打开 
  Function ChangeURLTarget(inputhtml,targetname)
    inputhtml=exeRE("(<[^>]+)(href='[^']*')([^>]*>.+?</a>)","<a $2"&chr(13)&"target="""&targetname&"""$3",inputhtml)
    inputhtml=exeRE("(<[^>]+)(href=""[^""]*"")([^>]*>.+?</a>)","<a $2"&chr(13)&"target="""&targetname&"""$3",inputhtml)
    inputhtml=exeRE("(<[^>]+)(href=[\S]+?)([\s][^>]*>.+?</a>)","<a $2"&chr(13)&"target="""&targetname&"""$3",inputhtml)
    ChangeURLTarget=inputhtml
  End Function
  

	'正则替换。。。
	Public Function exeRE(re, rp, content)
		Set oReg = New RegExp
		oReg.IgnoreCase =True
		oReg.Global=True	
		oReg.Pattern=re
		r = oReg.Replace(content,rp)
		Set oReg = Nothing	
		exeRE = r
	End Function

	'取得回复状态。。。
	Public Function Get_RevertState()
		Response.Write("<div align='center'><span class='hot2'>"&Conn.execute("Select Count(UserID) From Wo_Users")(0)&"</span> "&Web_UserCName&"提供了<span class='hot2'>"&Conn.Execute("Select Count(Re_ID) From Wo_SrcRevert")(0)&"</span> 个网站评论!</div>")
	End Function

	'取得RSS
	Public Sub Get_Rss
	  Response.Write("<table width='96%' height='21'  border='0' align='center' cellpadding='0' cellspacing='0'>"&vbcr)
        Response.Write("<tr>"&vbcr)
          Response.Write("<td height='30' class='mn'> <div align='right'><span class='green'>用RSS阅读全站&nbsp;<script type=""text/javascript"">document.write('<a href=""'+getRssUrl()+'"" target=""wh""><img src=""Images/rss.gif"" width=""35"" height=""12"" border=""0"" /></a>')</script></span></div></td>"&vbcr)
        Response.Write("</tr>"&vbcr)
      Response.Write("</table>"&vbcr)
	End Sub
	
	'取得GMail状态。。。
	Public Function Get_GmailState()
		Response.Write("<span class='hot2'>"&Conn.execute("Select Count(User_ID) From Wo_User")(0)&"</span> "&Web_UserCName&"提供了<span class='hot2'>"&Conn.Execute("Select Count(Gmail_ID) From Wo_SrcGmail")(0)&"</span> 个八卦!")
	End Function

	'取得全网址。。。
	Public Function GetUrl2() 
		Dim strTemp 
		If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
			strTemp = "http://" 
		Else 
			strTemp = "https://" 
		End If 
		strTemp = strTemp & Request.ServerVariables("SERVER_NAME")		
		If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT") 
		strTemp = strTemp & Request.ServerVariables("URL")
		if Request.QueryString<> "" then
			strTemp = strTemp & "?" & Request.QueryString
		end if		
		GetUrl2 = strTemp
	End Function 
	
	'显示标签。。。
	Public Function Get_TagsList(num,rowCount,num2,type1,type2)
		Set Rs_tags = Server.CreateObject("adodb.recordset")
		if type2 = "SYS" then
			Sql = "SELECT Wo_srctags.srctag_tagid, Count(Wo_SrcTags.SrcTag_id) AS Tag_Count,(select tag_name from Wo_tags where tag_id=Wo_srctags.srctag_tagid) as tag_name FROM Wo_SrcTags where Wo_srctags.srctag_ttype=true GROUP BY Wo_srctags.srctag_tagid Order By Count(Wo_SrcTags.SrcTag_id) Desc"
		else
			Sql = "SELECT Wo_srctags.srctag_name, Count(Wo_SrcTags.SrcTag_id) AS Tag_Count FROM Wo_SrcTags where Wo_srctags.srctag_ttype=false and Wo_srctags.srctag_name<>'' GROUP BY Wo_srctags.srctag_name Order By Count(Wo_SrcTags.SrcTag_id) Desc"
		end if
		Rs_tags.open Sql,conn,1,2
		tagsList_I = 0
		While not Rs_tags.Eof and tagsList_I < num
			tagsList_I = tagsList_I + 1
			if type2 = "SYS" then
				Response.Write("&nbsp;&nbsp;*&nbsp;<a href='jiuoo.asp?Tags_ID="&Rs_tags("srctag_tagid")&"'>" & Server.HTMLEncode(Rs_tags("tag_name")) &"("&Rs_tags("Tag_Count")&")</a>")
				if cint(rowCount) <> 0 then	'固定标签才有换行显示
					if tagsList_I mod rowCount = 0 then Response.Write("<br>")
				end if
			else
				Response.Write("&nbsp;*&nbsp;<a href='jiuoo.asp?Tags_Name="&trim(Rs_tags("srctag_Name"))&"'>" & Server.HTMLEncode(Rs_tags("srctag_Name"))&"("&Rs_tags("Tag_Count")&")</a>")
			end if		
			Rs_tags.MoveNext
		Wend
		Rs_tags.close
		Set Rs_tags = nothing
	End Function
	
	'添加自定义标签
	Public Function Add_NewTags(Src_ID,Tags_str)
		Sql_SrcTags = "Insert into Wo_SrcTags(SrcTag_SrcID,SrcTag_Name,SrcTag_TType,SrcTag_IP)Values("&Src_ID&",'"&Tags_str&"',false,'"&Request.ServerVariables("REMOTE_ADDR")&"')"
		conn.execute(Sql_SrcTags)
	End Function

	'取得网址带http://。。。
	Public Function Get_UrlStr(url)
		src_Url = lcase(url)
		  if  left(src_Url,7) = "http://" then
			src_Url = right(src_Url,len(src_Url) - 7)	'去掉 http://
		  end if
		  Src_Url_Arr = split(src_Url,"/")
		  src_Url = Src_Url_Arr(0)	'去掉 第一个 / 以后的
		  src_Url = "http://" & src_Url	'再重新装上 http://

		Get_UrlStr = src_Url
	End Function
	
	'取得文章条数和窝友个数的标题。。。
	Public Function Get_SrcRecordCount
		Temp_Str = "有<span class='postfonthuo'>"& Conn.Execute("SELECT count(UserID) FROM Wo_Users")(0) &"</span>个窝友，"
		Temp_Str = Temp_Str & "发布了<span class='postfonthuo'>"& Conn.Execute("SELECT count(Src_ID) FROM Wo_Source WHERE Src_IsOver=true")(0) &"</span>篇文章，"
		Temp_Str = Temp_Str & "分享了<span class='postfonthuo'>"&Conn.Execute("SELECT Count(Re_ID) FROM Wo_SrcRevert")(0)&"</span>条评论！"
		Get_SrcRecordCount = Temp_Str
	End Function

	'取得文章标签。。。
	Public Function Get_SrcTags(Src_ID)
		Set Rs_Tags2 = Server.CreateObject("Adodb.recordset")
		Sql_Tag2 = "Select SrcTag_ID,SrcTag_Name from Wo_SrcTags Where SrcTag_SrcID="&Src_ID&" and srctag_ttype=false"
		Rs_Tags2.open Sql_Tag2,conn
		while not Rs_Tags2.eof
			Src_Tags_2 = Src_Tags_2 & "<a href='jiuoo.asp?tags_Name=" & Rs_Tags2("SrcTag_Name") & "'>" & Rs_Tags2("SrcTag_Name") &"</a>&nbsp;"
			Rs_Tags2.MoveNext
		wend
		Rs_Tags2.Close
		Sql_Tag2 = "Select Wo_SrcTags.SrcTag_ID,Wo_Tags.tag_ID,Wo_Tags.tag_Name from Wo_SrcTags inner join Wo_Tags on Wo_SrcTags.SrcTag_TagID=Wo_Tags.tag_ID Where Wo_SrcTags.SrcTag_SrcID="&Src_ID&" and srctag_ttype=true"	
		Rs_Tags2.open Sql_Tag2,conn
		while not Rs_Tags2.eof
			Src_Tags_2 = Src_Tags_2 & "<a href='jiuoo.asp?tags_ID=" & Rs_Tags2("tag_ID") & "'>" & Rs_Tags2("tag_Name") &"</a>&nbsp;"
			Rs_Tags2.MoveNext
		wend
		Rs_Tags2.Close
		Set Rs_Tags2 = nothing
		if Src_Tags_2 <> "" then
			Get_SrcTags = Src_Tags_2
		else
			Get_SrcTags = "无标签"
		end if
	End Function

	'是否已顶。。
	Public Function Is_Hit(Src_ID,UserID)
		Temp_HitStr = ""
		if Web_DigLogin=1 then
		if CookieUserID = "" then
			Temp_HitStr = "<a href='javascript:Hit("&Src_ID&","&UserID&")' onMouseOver='window.status=""请登陆后再顶！"";return true;'>顶一下</a>"
		else
		Set Temp2  = conn.execute("Select Hit_ID,Hit_Time From Wo_SrcHit Where Hit_SrcID="&Src_ID&" and Hit_UserID="&CookieUserID)
        If not Temp2.eof then 
         if DateDiff("d",FormatDateTime(Temp2("Hit_Time"),2),FormatDateTime(Now,2))>=1 then
			Is_Hit=false
			else
         	Is_Hit=true
		  end if
          Temp2.close
          set Temp2=nothing
         end if
		 end if
		 else
		 Set Temp2  = conn.execute("Select Hit_ID,Hit_Time From Wo_SrcHit Where Hit_SrcID="&Src_ID&" and Hit_IP='"&Request.ServerVariables("REMOTE_ADDR")&"'")
        If not Temp2.eof then 
         if DateDiff("d",FormatDateTime(Temp2("Hit_Time"),2),FormatDateTime(Now,2))>=1 then
			Is_Hit=false
			else
         	Is_Hit=true
		  end if
          Temp2.close
          set Temp2=nothing
         end if
		 end if

			If Is_Hit=true  then
			Temp_HitStr = "已顶"
			else
				Temp_HitStr = "<a href='javascript:Hit("&Src_ID&","&UserID&")' onMouseOver='window.status=""我顶！"";return true;'>顶一下</a>"
			end if
		Is_Hit = Temp_HitStr
	End Function
	
	'是否已埋。。
	Public Function Is_Hit3(Src_ID,UserID)
		Temp_HitStr3 = ""
		if Web_DigLogin=1 then
		if CookieUserID = "" then
			Temp_HitStr3 = "<a href='javascript:Hit3("&Src_ID&","&UserID&")' onMouseOver='window.status=""请登陆后再埋！"";return true;'>踩下去</a>"