setup.asp

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

<%
HtmlBottom
End Function

Sub error(Message)
if IsResponseTop<>1 then HtmlTop
if Left(Message,4)<>"<li>" then Message="<li>"&Message
%>
<table width="900" border="0" cellspacing="0" cellpadding="0" align="center">
  <tr>
    <td><div id="CommonBreadCrumbArea"><%ClubTree%> → 提示信息</div></td>
  </tr>
</table>

<table cellspacing="1" cellpadding="0" width=900 id=CommonListArea align="center">
	<tr id=CommonListTitle3>
		<td width="100%" colspan="2" align="center">提示信息</td>
	</tr>
	<tr id=CommonListCell>
		<td valign="top" align="Left" colspan="2" height="122">
		<table cellspacing="0" cellpadding="0" width=900 border="0" align="center">
<tr><td width="83%" valign="top"><b>操作不成功的可能原因或建议：</b><ul><%=Message%></ul></td><td width="17%"></td>
</tr>
		</table>
		</td>
	</tr>
	<tr align="center" id=CommonListCell>
		<td valign="center" colspan="2" height="30"><input onClick="history.back()" type="submit" value=" << 返 回 上 一 页 " /></td>
	</tr>
</table>
<%
HtmlBottom
End Sub
''''''''''''''''''''''''''''''''
Sub Alert(Message)
%>
	<script language="JavaScript">
	alert('<%=Message%>');
	history.back();
	</script>
	<script language="JavaScript">window.close();</script>
		
<%
	Response.End
End Sub
''''''''''''''''''''''''''''''''
Sub Log(Message)
	MessageXML=MessageXML&"<Message>"&Message&"</Message>"&vbCrlf
	MessageXML=MessageXML&"<REMOTE_ADDR>"&Server.HTMLEncode(Request.ServerVariables("REMOTE_ADDR"))&"</REMOTE_ADDR>"&vbCrlf
	MessageXML=MessageXML&"<Request_Method>"&Server.HTMLEncode(Request.ServerVariables("Request_method"))&"</Request_Method>"&vbCrlf
	MessageXML=MessageXML&"<Server_Name>"&Server.HTMLEncode(Request.ServerVariables("server_name"))&"</Server_Name>"&vbCrlf
	MessageXML=MessageXML&"<Script_Name>"&Server.HTMLEncode(Request.ServerVariables("script_name"))&"</Script_Name>"&vbCrlf
	MessageXML=MessageXML&"<Query_String>"&Server.HTMLEncode(Escape(Request.ServerVariables("Query_String")))&"</Query_String>"&vbCrlf
	MessageXML=MessageXML&"<Request_Form>"&Server.HTMLEncode(Escape(Request.Form))&"</Request_Form>"&vbCrlf
	MessageXML=MessageXML&"<All_Http>"&Server.HTMLEncode(Request.ServerVariables("All_Http"))&"</All_Http>"&vbCrlf

	Conn.Execute("insert into [Wo_EventLog] (UserName,ErrNumber,MessageXML) values ('"&CookieUserName&"','"&Err.Number&"','"&MessageXML&"')")
End Sub
''''''''''''''''''''''''''''''''
Sub ForumTree(selec)
	if selec=0 then
		set Rs1=Conn.Execute("select * from [Wo_Groups] where GroupID="&GroupID&"")
		if not Rs1.eof then
			ForumTreeList="<span id=TempGroup"&GroupID&"><a href=group.asp?GroupID="&Rs1("GroupID")&">"&Rs1("GroupName")&"</a></span> → "&ForumTreeList&""
		end if
	else
		Set Rs1=Conn.Execute("Select * From [Wo_Forums] where ForumID="&selec&"")
		if not rs1.eof then
			ForumTreeList="<span id=tempForum"&selec&"><a href=ShowForum.asp?ForumID="&Rs1("ForumID")&">"&Rs1("ForumName")&"</a></span> → "&ForumTreeList&""
			ForumTree Rs1("ParentID")
		end if
	end if
	Set Rs1 = Nothing
End Sub

Sub ShowPage()
	PageUrl=ReplaceText(Request.QueryString,"PageIndex=([0-9]*)&","")
	if Request.Form<>empty then PageUrl=""&PageUrl&"&"&Request.Form&""
%>
	<script language="JavaScript">ShowPage(<%=TotalPage%>,<%=PageCount%>,"<%=PageUrl%>")</script>
<%
End Sub

Sub menu(selec)
	sql="Select * From [Wo_Menus] where ParentID="&selec&" order by SortNum"
	Set Rs1=Conn.Execute(sql)
	do while not rs1.eof
		if rs1("ParentID")=0 then 
%> | <a onMouseOver="showmenu(event,'<%menu(rs1("MenuID"))%>')" style="cursor:default"><%=rs1("name")%></a>
<%
		else
			response.write "<div class=menuitems><a href="&rs1("url")&">"&rs1("name")&"</a></div>"
		end if
		rs1.Movenext
	loop
	Set Rs1 = Nothing
End Sub

Sub ClubTree
	Set ClubTreeRs=Conn.Execute("Select * From [Wo_Groups] where SortOrder>0 order by SortOrder")
	do while not ClubTreeRs.eof
		ClubTreeList=ClubTreeList&"<div class=menuitems><a href=group.asp?GroupID="&ClubTreeRs("GroupID")&">"&ClubTreeRs("GroupName")&"</a></div>"
		ClubTreeRs.Movenext
	loop
	Set ClubTreeRs = Nothing
	response.write "<a href=group.asp>群组首页</a>"
End Sub
Sub GroupList(ParentID)
	sql="select * from [Wo_Groups] where SortOrder>0 order by SortOrder"
	Rs.open sql,conn,1
		do while not Rs.eof
			ForumsList=ForumsList&"<optgroup label='"&rs("GroupName")&"'>"
			ii=ii+1
			ForumList Rs("GroupID"),0,ParentID
			ii=ii-1
			ForumsList=ForumsList&"</optgroup>"
		Rs.movenext
		loop
	Rs.close
End Sub
Sub ForumList(GroupID,ParentID,Selected)
	Selected=int(Selected)
	sql="select * From [Wo_Forums] where GroupID="&GroupID&" and ParentID="&ParentID&" and SortOrder>0 and IsActive=1 order by SortOrder"
	Set Rs1=Conn.Execute(sql)
	do while not rs1.eof
		if Rs1("ForumID")=Selected then
		ForumsList=ForumsList&"<option value='"&rs1("ForumID")&"' selected>"&string(ii,"　")&"-&raquo; "&rs1("ForumName")&"</option>"
		else
		ForumsList=ForumsList&"<option value='"&rs1("ForumID")&"'>"&string(ii,"　")&"-&raquo; "&rs1("ForumName")&"</option>"
		end if
		ii=ii+1
		ForumList GroupID,rs1("ForumID"),Selected
		ii=ii-1
		rs1.Movenext
	loop
	Set Rs1 = Nothing
End Sub
%>
<%
Sub ShowThread()
	if Rs("ThreadTop")=2 then
		IconImage="topic-announce.gif alt='公告主题'"
	elseif Rs("ThreadTop")=1 then
		IconImage="topic-pinned.gif alt='置顶主题'"
	elseif Rs("IsGood")=1 then
		IconImage="topic-popular.gif alt='精华主题'"
	elseif Rs("IsLocked")=1 then
		IconImage="topic-locked.gif alt='主题锁定'"
	elseif Rs("IsVote")=1 then
		IconImage="topic-poll.gif alt='投票主题'"
	elseif DateDiff("d",Rs("PostTime"),Now()) <= SiteConfig("PopularPostThresholdDays")   and  (  Rs("TotalReplies")=>SiteConfig("PopularPostThresholdPosts") or  Rs("TotalViews")=>SiteConfig("PopularPostThresholdViews") ) then
		IconImage="topic-hot.gif alt='热门主题'"
	else
		IconImage="topic.gif alt='普通主题'"
	end if
	
	if Rs("TotalReplies")=0 then
		replies="-"
	else
		replies=Rs("TotalReplies")
	end if
	
	if Rs("Category")<>"" then
		CategoryHtml="[<a href=ShowForum.asp?ForumID="&Rs("ForumID")&"&Category="&Rs("Category")&">"&Rs("Category")&"</a>] "
	else
		CategoryHtml=""
	end if
	if Rs("ThreadEmoticonID")>0 then
		ThreadEmoticonID="<img src=images/Emotions/emotion-"&Rs("ThreadEmoticonID")&".gif> "
	else
		ThreadEmoticonID=""
	end if
	
	
	if int(DateDiff("d",Rs("PostTime"),Now())) < 2 then
		NewHtml=" <img title='一天内新发表的主题' src=images/new.gif align=absmiddle>"
	else
		NewHtml=""
	end if
	if Request("checkbox")=1 then checkboxHtml="<input type=checkbox value="&Rs("ThreadID")&" name=ThreadID> "
	if Rs("TotalRatings")>0 then StarHtml="<a style=CURSOR:pointer onclick="&CHR(34)&"OpenWindow('PostRating.asp?ThreadID="&Rs("ThreadID")&"')"&CHR(34)&" ><img border=0 src=Images/Star/"&cint(Rs("RatingSum")/Rs("TotalRatings"))&".gif align=middle></a>"
	if Rs("TotalReplies")=>SiteConfig("PostsPerPage") then
		MaxPostPage=fix(Rs("TotalReplies")/SiteConfig("PostsPerPage"))+1 '共多少页
		ShowPostPage="( <img src=images/multiPage.gif> "
		For PostPage = 1 To MaxPostPage
			if PostPage<11 or MaxPostPage=PostPage then ShowPostPage=""&ShowPostPage&"<a href=ShowPost.asp?PageIndex="&PostPage&"&ThreadID="&Rs("ThreadID")&"><b>"&PostPage&"</b></a> "
		Next
		ShowPostPage=""&ShowPostPage&")"
	else
		ShowPostPage=""
	end if
	digcount=Rs("DIgCount")
%>
	<tr id=CommonListCell onMouseOver =this.style.backgroundColor='#F4FBFF' onMouseOut =this.style.backgroundColor='#FFFFFF' height="30">
		<td>

				<table width="98%" align="center" cellspacing="0" cellpadding="0">
					<tr>
<td background="images/digbg2.gif" class="bg" width="51" height="25" align="center">
<%=digcount%>℃</td>
<td width="30" align="center"><a target="wh" href="ShowPost.asp?ThreadID=<%=Rs("ThreadID")%>"><img src=images/<%=IconImage%> border=0 ></a></td>
<td width="50%"><%=checkboxHtml%><%=ThreadEmoticonID%><%=CategoryHtml%><a href="ShowPost.asp?ThreadID=<%=Rs("ThreadID")%>"><%=Rs("Topic")%></a><%=ShowPostPage%><%=NewHtml%></td><td><a href="Profile.asp?UserName=<%=Rs("PostAuthor")%>"><%=Rs("PostAuthor")%></a></td>
<td><font color=red><%=replies%>/<%=Rs("TotalViews")%></font></td>
<td><%=Rs("lastname")%>@<%=Rs("lasttime")%></td>
</tr></table></td></tr>
<%
End Sub

Sub AddCategory
%>
<title>添加类别</title>
<body style="background-color:#FFFFFF;"><br>
<form name=form1 onSubmit="return ChangeCategory()">
输入类别名称，然后单击“添加”。类别名称会显示在列表的底部。<br><br>
<input size="30" name="CategoryName" onKeyUp="ValidateTextboxAdd(this, 'CategoryName1')" onpropertychange="ValidateTextboxAdd(this, 'CategoryName1')" >  <input type="submit" value=" 添加 " id='CategoryName1' disabled>
</form>
<%
Response.End
End Sub






Sub UpdateStatistics(DaysUsers,DaysTopics,DaysPosts)

	sql="select * from [Wo_Statistics] where DateDiff("&SqlChar&"d"&SqlChar&",DateCreated,"&SqlNowString&")=0"
	Rs.open sql,conn,1,3
	if Rs.eof then
		Rs.Addnew
		
		TotalUsers=Conn.execute("Select count(UserID) from [Wo_Users]")(0)
		TotalTopics=Conn.execute("Select count(ThreadID) from [Wo_Threads] where IsDel=0")(0)
		TotalPosts=Conn.execute("Select sum(TotalReplies) as TotalPosts from [Wo_Threads] where IsDel=0")(0)
		
		
		if IsNull(TotalPosts) then
		TotalPosts=0
		else
		NewestUserName=Conn.execute("Select Top 1 UserName from [Wo_Users] order by UserID desc")(0)
		end if

		Rs("TotalUsers")=TotalUsers
		Rs("TotalTopics")=TotalTopics
		Rs("TotalPosts")=TotalPosts
		Rs("NewestUserName")=NewestUserName
		
		Conn.execute("update [Wo_Forums] set TodayPosts=0")
		Rs("DaysUsers")=Rs("DaysUsers")+int(DaysUsers)
		Rs("DaysTopics")=Rs("DaysTopics")+int(DaysTopics)
		Rs("DaysPosts")=Rs("DaysPosts")+int(DaysPosts)
		Rs("DateCreated")=date()
	else
		Rs("TotalUsers")=Rs("TotalUsers")+DaysUsers
		Rs("TotalTopics")=Rs("TotalTopics")+DaysTopics
		Rs("TotalPosts")=Rs("TotalPosts")+DaysPosts
		Rs("DaysUsers")=Rs("DaysUsers")+DaysUsers
		Rs("DaysTopics")=Rs("DaysTopics")+DaysTopics
		Rs("DaysPosts")=Rs("DaysPosts")+DaysPosts
	end if
	Rs.update
	Rs.close
End Sub



Sub UpForumMostRecent(ForumID)
		sql="select top 1 * from [Wo_Threads] where ForumID="&ForumID&" and IsApproved=1 and IsDel=0 order by LastTime DESC"
		Set Rs2=Conn.Execute(sql)
		if Rs2.Eof then Exit sub
		MostRecentThreadID=Rs2("ThreadID")
		MostRecentPostSubject=ReplaceText(Rs2("Topic"),"<[^>]*>","")
		MostRecentPostAuthor=Rs2("LastName")
		MostRecentPostDate=Rs2("LastTime")
		Set Rs2 = Nothing
		MostRecentPostDate=""&FormatDateTime(MostRecentPostDate,2)&" "&FormatDateTime(MostRecentPostDate,4)&":"&second(MostRecentPostDate)&""

		Conn.execute("update [Wo_Forums] set MostRecentThreadID="&MostRecentThreadID&",MostRecentPostSubject='"&MostRecentPostSubject&"',MostRecentPostAuthor='"&MostRecentPostAuthor&"',MostRecentPostDate='"&MostRecentPostDate&"' where ForumID="&ForumID&"")
End Sub
Sub SendMail()

if MailSubject="" or MailBody="" or MailAddRecipient="" then Exit Sub

on error resume next
if SiteConfig("SelectMailMode")="JMail.Message" then
	Set JMail=Server.CreateObject("JMail.Message")
		JMail.Charset="gb2312"
		JMail.ContentType = "text/html"
		'JMail.ContentType = "text/plain"
		JMail.From = SiteConfig("SmtpServerMail")
		JMail.AddRecipient MailAddRecipient
		JMail.Subject = MailSubject
		JMail.Body = MailBody
		JMail.MailServerUserName = SiteConfig("SmtpServerUserName")
		JMail.MailServerPassword = SiteConfig("SmtpServerPassword")
		JMail.Send SiteConfig("SmtpServer")
	Set JMail=nothing
elseif SiteConfig("SelectMailMode")="CDO.Message" then
	Set CDO=Server.CreateObject("CDO.Message")
		CDO.From = SiteConfig("SmtpServerMail")
		CDO.To = MailAddRecipient
		CDO.Subject = MailSubject
		CDO.HtmlBody = MailBody
		'CDO.TextBody = MailBody
		CDO.HTMLBodyPart.Charset="gb2312"
		CDO.Send
	Set CDO=Nothing
end if

If Err Then Response.Write ""&Mailaddress&"邮件发送失败！错误原因：" & Err.Description & "<br>"
On Error GoTo 0

End Sub
%>