conn.asp

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

<%@ CodePage=936 Language="VBScript"%>
<%
Session.timeout=600
Response.Charset="gb2312"
Response.Buffer=True
IsSqlDataBase=0		'定义数据库类别，0为Access数据库，1为SQL数据库
If IsSqlDataBase=0 Then
'''''''''''''''''''''''''''''' Access数据库设置''''''''
	SqlDataBase	= "zbt0076f.asp"	'数据库路径
	SqlProvider	= "Microsoft.Jet.OLEDB.4.0"	'驱动程序[ Microsoft.Jet.OLEDB.4.0  Microsoft.ACE.OLEDB.12.0 ]
	Connstr="Provider="&SqlProvider&";Data Source="&Server.MapPath(SqlDataBase)
	SqlNowString="Now()"
	SqlChar="'"
	IsSqlVer="ACCESS"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
'''''''''''''''''''''''''''''' SQL数据库设置''''''''''
	SqlLocalName	="(local)"	'连接IP  [ 本地用 (local) 外地用IP ]
	SqlUserName	="sa"		'SQL窝友名
	SqlPassword	="1"		'SQL窝友密码
	SqlDataBase	="WoXP2007"	'数据库名
	SqlProvider	="SQLOLEDB"	'驱动程序 [ SQLOLEDB  SQLNCLI ]
	ConnStr="Provider="&SqlProvider&"; User ID="&SqlUserName&"; Password="&SqlPassword&"; Initial CataLog="&SqlDataBase&"; Data Source="&SqlLocalName&";"
	SqlNowString="GetDate()"
	IsSqlVer="MSSQL"
'''''''''''''''''''''''''''''''''''''''''''''''''''
END IF
On Error Resume Next
Set Conn=Server.CreateObject("ADODB.Connection")
Conn.open ConnStr
If Err Then
	Response.Write ""&IsSqlVer&"数据库连接出错，请联系QQ9494583<br><br>"&Err.Source&" ("&Err.Number&")"
	Set Conn = Nothing
	err.Clear
	Response.End
End If
On Error GoTo 0
set AutoTerminate=new AutoTerminate_Class
Set Rs = Server.CreateObject("ADODB.Recordset")

''''''''''''''''''''''''''''''''''''''''''''''''
ForumsBuild="1.0.0"
ForumsProgram="Netwolf's web server"&IsSqlVer&""

Set SiteSettings=Conn.Execute("select * from [Wo_SiteSettings]")
CreateUserAgreement = SiteSettings("CreateUserAgreement")
GenericBottom = SiteSettings("GenericBottom")
BestOnline = SiteSettings("BestOnline")
BestOnlineTime = SiteSettings("BestOnlineTime")
SiteSettingsXML=SiteSettings("SiteSettingsXML")
GenericHeader = SiteSettings("GenericHeader")
GenericTop = SiteSettings("GenericTop")
GGAD72860 = SiteSettings("GGAD72860")
set SiteSettings=Nothing

Set XMLDOM=Server.CreateObject("Microsoft.XMLDOM")
Set SiteConfigXMLDOM=Server.CreateObject("Microsoft.XMLDOM")
SiteConfigXMLDOM.loadxml("<Wo>"&SiteSettingsXML&"</Wo>")
''''''''''''''''''''''''''''''''''''
Function SelectSingleNode(str)
	str=XMLDOM.documentElement.SelectSingleNode(str).text
	SelectSingleNode=str
end Function

Function SiteConfig(str)
	TextStr=SiteConfigXMLDOM.documentElement.SelectSingleNode(str).text
	if IsNumeric(TextStr) then
		str=int(TextStr)	'转化为数字类型
		if Len(str)<>Len(TextStr) then	str=TextStr	'防止数字前面的 0 消失掉
	else
		str=TextStr
	End If
	SiteConfig=str
end Function
''''''''''''''''''''''''''''''''''''
Class AutoTerminate_Class
	Private Sub Class_Terminate
		If Err.Number<>995 and Err.Number<>0 then log(""&Err.Source&" ("&Err.Number&")&lt;br&gt;"&Err.Description&"")
		Conn.Close
		set Rs = Nothing
		set Rs1 = Nothing
		set Conn = Nothing
		Set XMLDOM = Nothing
		Set SiteConfigXMLDOM = Nothing
	End Sub
End Class
''''''''''''''''''''''''''''''''''''
function HTMLEncode(fString)
	fString=Trim(fString)
	fString=Replace(fString,CHR(38),"&#38;")	'“&”
	fString=replace(fString,"<","&lt;")
	fString=replace(fString,">","&gt;")
	fString=Replace(fString,"\","&#92;")
	fString=Replace(fString,"--","&#45;&#45;")
	fString=Replace(fString,CHR(9),"&#9;")
	fString=Replace(fString,CHR(10),"<br>")
	fString=Replace(fString,CHR(13),"")
	fString=Replace(fString,CHR(22),"&#22;")
	fString=Replace(fString,CHR(32),"&#32;")
	fString=Replace(fString,CHR(39),"&#39;")	'“'”
	fString=Replace(fString,CHR(59),"&#59;")	'“;”
	fString=ReplaceText(fString,"([&#])([a-z0-9]*)&#59;","$1$2;")

	if IsSqlDataBase=0 then '过滤片假名(日文字符)[\u30A0-\u30FF] by wodig
		fString=escape(fString)
		fString=ReplaceText(fString,"%u30([A-F][0-F])","&#x30$1;")
		fString=unescape(fString)
	end if

	if SiteConfig("BannedText")<>"" then
		filtrate=split(SiteConfig("BannedText"),"|")
		for i = 0 to ubound(filtrate)
			fString=ReplaceText(fString,""&filtrate(i)&"",string(len(filtrate(i)),"*"))
		next
	end if

	HTMLEncode=fString
end function
''''''''''''''''''''''''''''''''''''
function BodyEncode(fString)
	fString=Replace(fString,vbCrlf, "")
	fString=Replace(fString,"\","&#92;")
	fString=Replace(fString,"'","&#39;")
	fString=Replace(fString,"<A href=","<A target=_blank href=") '点链接打开新窗口
	if SiteConfig("BannedHtmlLabel")<>"" then fString=ReplaceText(fString,"<(\/|)("&SiteConfig("BannedHtmlLabel")&")", "&lt;$1$2")
	if SiteConfig("BannedHtmlEvent")<>"" then fString=ReplaceText(fString,"<(.[^>]*)("&SiteConfig("BannedHtmlEvent")&")", "&lt;$1$2")
	if SiteConfig("BannedText")<>"" then
		filtrate=split(SiteConfig("BannedText"),"|")
		for i = 0 to ubound(filtrate)
			fString=ReplaceText(fString,""&filtrate(i)&"",string(len(filtrate(i)),"*"))
		next
	end if
	BodyEncode=fString
end function
''''''''''''''''''''''''''''''''''''
Function YbbEncode(str)
	str=ReplaceText(str,"\[(\/|)(b|i|u|strike|center|marquee)\]","<$1$2>")
	str=ReplaceText(str,"\[COLOR=([^[]*)\]","<FONT COLOR=$1>")
	str=ReplaceText(str,"\[FONT=([^[]*)\]","<FONT face=$1>")
	str=ReplaceText(str,"\[SIZE=([0-9]*)\]","<FONT size=$1>")
	str=ReplaceText(str,"\[\/(SIZE|FONT|COLOR)\]","</FONT>")
	str=ReplaceText(str,"\[URL\]([^[]*)","<A TARGET=_blank HREF=$1>$1")
	str=ReplaceText(str,"\[URL=([^[]*)\]","<A TARGET=_blank HREF=$1>")
	str=ReplaceText(str,"\[\/URL\]","</A>")
	str=ReplaceText(str,"\[EMAIL\](\S+\@[^[]*)(\[\/EMAIL\])","<a href=mailto:$1>$1</a>")
	str=ReplaceText(str,"\[IMG\]([^"&CHR(34)&"[]*)(\[\/IMG\])","<img border=0 src=$1>")
	str=ReplaceText(str,"\[quote\]","<blockquote>")
	str=ReplaceText(str,"\[quote user="&CHR(34)&"([^[]*)"&CHR(34)&"\]","<blockquote><img border=0 src=images/icon-quote.gif> <b>$1:</b><br>")
	str=ReplaceText(str,"\[\/quote\]","</blockquote>")
	YbbEncode=str
End Function

''''''''''''''''''''''''''''''''''''
Function RequestInt(fString)

	RequestInt=Request(fString)

	if IsNumeric(RequestInt) then
		RequestInt=int(RequestInt)
	else
		RequestInt=0
	end if

End Function

''''''''''替换模块START''''''''''''
Function ReplaceText(fString,patrn,replStr)
	Set regEx = New RegExp  	' 建立正则表达式。
		regEx.Pattern = patrn   ' 设置模式。
		regEx.IgnoreCase = True ' 设置是否区分大小写。
		regEx.Global = True     ' 设置全局可用性。 
		ReplaceText = regEx.Replace(""&fString&"",""&replStr&"") ' 作替换。
	Set regEx=nothing
End Function
''''''''''替换模块END''''''''''''
Function ResponseCookies(Key,Value,Expires)

	Response.Cookies(Key) = ""&Value&""
	Response.Cookies(Key).Path = DomainPath
	if int(Expires)>0 then Response.Cookies(Key).Expires = date+Expires

End Function
'''''''''''''''''''''''''''''''''''''''''''
Function RequestCookies(CookieName)

	RequestCookies=Request.Cookies(CookieName)

end Function
'''''''''''''''''''''''''''''''''''''''''''
Function CleanCookies()

	For Each objCookie In Request.Cookies
		ResponseCookies objCookie,"",0
	Next

End Function

'''''''''''''''''''''''''''''''''''''''''''
if IsNumeric(RequestCookies("UserID")) then
	sql="select * from [Wo_Users] where UserID="&RequestCookies("UserID")&""
	Set Rs=Conn.Execute(sql)
	if Rs.eof then
		CleanCookies()
	elseif RequestCookies("Userpass") <> Rs("Userpass") then
		CleanCookies()
	else
		CookieUserID=Rs("UserID")
		CookieUserName=Rs("UserName")
		CookieEmail=Rs("UserEmail")
		NewMessage=Rs("NewMessage")
		UserRoleID=Rs("UserRoleID")
		UserAccountStatus=Rs("UserAccountStatus")
		if UserRoleID=1 or UserRoleID=2 then BestRole=1
	end if
	Rs.Close
end if
'''''''''''''''''''''''''''''''''''''''''''
DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))

SiteURL="http://"&Request.ServerVariables("server_name")&DomainPath

ReturnUrl=Request.ServerVariables("http_referer")

if RequestCookies("skin")=empty then ResponseCookies "skin",SiteConfig("DefaultSiteStyle"),"0"

dim GroupsList,ForumsList,ForumTreeList,TotalPage,PageCount,RankName,RankIconUrl,IsResponseTop


%>