⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 bbsxp_class.asp

📁 论坛建站的源代码
💻 ASP
📖 第 1 页 / 共 2 页
字号:
🔍
12 
<!-- #include file="Utility/HashPassword_Class.asp" -->
<%
Function Execute(Command)
	SqlQueryNum = SqlQueryNum + 1
	'Response.Write "（"&SqlQueryNum&"）"&Command&"<p>"
	Set Execute = Conn.Execute(Command)
End Function


''''''''''''''''''''''''''''''''''''
Class AutoTerminate_Class
	Private Sub Class_Terminate

		if Err.Number<>0 then
		'955 = 未知的运行时错误
		'-2147217864 = 乐观并发检查失败。该行在此游标之外进行了修改。
			If Err.Number<>995 and Err.Number<>-2147217864 then log(""&Err.Source&" ("&Err.Number&")&lt;br&gt;"&Err.Description&"")
		end if

		Conn.Close
		Set Rs = Nothing
		Set Conn = Nothing
		Set SiteConfigXMLDOM = Nothing
	End Sub
End Class

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



''''''''''''''''''''''''''''''''''''
Function HTMLEncode(fString)
	fString=Trim(fString)
	fString=Replace(fString,CHR(9),"")
	fString=Replace(fString,CHR(13),"")
	fString=Replace(fString,CHR(22),"")
	fString=Replace(fString,CHR(38),"&#38;")	'“&”
	fString=Replace(fString,CHR(32),"&#32;")	'“ ”
	fString=Replace(fString,CHR(34),"&quot;")	'“"”
	fString=Replace(fString,CHR(37),"&#37;")	'“%”
	fString=Replace(fString,CHR(39),"&#39;")	'“'”
	fString=Replace(fString,CHR(42),"&#42;")	'“*”
	fString=Replace(fString,CHR(43),"&#43;")	'“+”
	fString=Replace(fString,CHR(44),"&#44;")	'“,”
	fString=Replace(fString,CHR(45)&CHR(45),"&#45;&#45;")	'“--”
	fString=Replace(fString,CHR(92),"&#92;")	'“\”
	'fString=Replace(fString,CHR(95),"&#95;")	'“_”
	fString=Replace(fString,CHR(40),"&#40;")	'“(”
	fString=Replace(fString,CHR(41),"&#41;")	'“)”
	fString=Replace(fString,CHR(60),"&#60;")	'“<”
	fString=Replace(fString,CHR(62),"&#62;")	'“>”
	fString=Replace(fString,CHR(123),"&#123;")	'“{”
	fString=Replace(fString,CHR(125),"&#125;")	'“}”
	fString=Replace(fString,CHR(59),"&#59;")	'“;”
	fString=Replace(fString,CHR(10),"<br>")
	fString=ReplaceText(fString,"([&#])([a-z0-9]*)&#59;","$1$2;")

	if SiteConfig("BannedText")<>"" then fString=ReplaceText(fString,"("&SiteConfig("BannedText")&")",string(len("&$1&"),"*"))

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

	HTMLEncode=fString
End Function
''''''''''''''''''''''''''''''''''''
Function BodyEncode(fString)
	fString=Trim(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 fString=ReplaceText(fString,"("&SiteConfig("BannedText")&")",string(len("&$1&"),"*"))
	BodyEncode=fString
End Function
''''''''''''''''''''''''''''''''''''
Function BBCode(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|ed2k)\]ed2k:\/\/\|file\|([^\\\/:*?<>""|]+[\.]?[^\\\/:*?<>""|]+)\|(\d+)\|([0-9a-zA-Z]{32})((\|[^[]*)?)\|\/\[\/(url|ed2k)\]",""&vbCrlf&_
	"<br /><table align=""center"" cellspacing=""1"" cellpadding=""5"" width=""100%"" class=""CommonListArea"">"&vbCrlf&_
	"<tr align=center class=""CommonListHeader""><td>文件名</td><td width=""100"">大小</td></tr>"&vbCrlf&_
	"<tr class=""CommonListCell""><td><a href=""ed2k://|file|$2|$3|$4$5|/"" target=_blank>$2</a> (<a href=""http://www.ed2000.com/ed2kstats/?hash=$4"" target=""_blank"">查源</a>)</td><td align=center><script language=""javascript"">document.write(gen_size($3, 3, 1));</script></td></tr>"&vbCrlf&_
	"<tr class=""CommonListCell""><td colspan=""2""><input type=""button"" value=""下载该资源"" onClick=""download('ed2k://|file|$2|$3|$4$5|/')"" /> <input type=""button"" value=""复制ED2K链接"" onClick=""copyToClipboard('ed2k://|file|$2|$3|$4$5|/')"" /> <span style=""float:right;margin-top:-17px;""><a href=""http://www.ed2000.com/download/"" target=""_blank"">推荐使用eMule进行下载</a></span></td></tr>"&vbCrlf&_
	"</table><br />")

	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>")

	BBCode=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''''''''''''

'''''''''''''''''''Cookies Process Start''''''''''''''''''''
Function ResponseCookies(Key,Value,Expires)
	Response.Cookies(Key) = ""&Value&""
	if ""&SiteConfig("CookieDomain")&""<>"" then Response.Cookies(Key).Domain = SiteConfig("CookieDomain")
	Response.Cookies(Key).Path = SiteConfig("CookiePath")
	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
	ResponseCookies "Themes",SiteConfig("DefaultSiteStyle"),365
End Function
'''''''''''''''''''Cookies Process End''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''
'写入Application
Function ResponseApplication(Key,Value)
	Application(SiteConfig("CacheName")&"_"&Key) = Value
End Function

'读取Application
Function RequestApplication(Key)
	RequestApplication=Application(SiteConfig("CacheName")&"_"&Key)
End Function

'删除Application
Function RemoveApplication(Key)
	Application.Contents.Remove(SiteConfig("CacheName")&"_"&Key)
End Function

'追加Application
Function AddApplication(Key,Value)
	Application(SiteConfig("CacheName")&"_"&Key) = Application(SiteConfig("CacheName")&"_"&Key)&Value&"<br>"
End Function

'更新缓存
Function UpdateApplication(Key,SQL)
	Application.Lock
		ResponseApplication Key,FetchEmploymentStatusList(SQL)
	Application.Unlock
End Function

'''''''''''''''''''''''''''''''''''''''''''
Function FetchEmploymentStatusList(SQL)
	Set Rs2=Execute(SQL)
	if Rs2.Eof then
		Rs2.Close
		Set Rs2 = Nothing
		Exit Function
	End if
  	FetchEmploymentStatusList = Rs2.GetRows()
	Rs2.Close
	Set Rs2 = Nothing
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	On Error GoTo 0
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function DelFile(DelFilePath)
	On Error Resume Next
	DelFile = False
	Set MyFileObject=Server.CreateOBject("Scripting.FileSystemObject")
	MyFileObject.DeleteFile""&Server.MapPath(""&DelFilePath&"")&""
	Set MyFileObject = Nothing
	If 0 = Err or 53 = Err Then
		DelFile = True
	else
		Alert("出错讯息："&Err.Description&"\n"&DelFilePath&" 无法删除！")
	end if
	On Error GoTo 0
End Function

Function DelAttachments(SqlString)
	Set Rs2=Server.CreateObject("Adodb.Recordset")
	Rs2.open SqlString,Conn,1,3
		do while not Rs2.eof
			if ""&Rs2("FilePath")&""<>"" then IsDelFile=DelFile(""&Rs2("FilePath")&"")
			if ""&Rs2("FilePath")&""="" or (""&Rs2("FilePath")&""<>"" and IsDelFile=True) then
				Rs2.Delete()
				Rs2.Update()
			end if
			Rs2.movenext
		loop
	Rs2.Close
	set Rs2=nothing
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function CheckSize(ByteSize)
	if ByteSize=>1073741824 then
		ByteSize=formatnumber(ByteSize/1073741824)&" GB"
	elseif ByteSize=>1048576 then
		ByteSize=formatnumber(ByteSize/1048576)&" MB"
	elseif ByteSize=>1024 then
		ByteSize=formatnumber(ByteSize/1024)&" KB"
	else
		ByteSize=ByteSize&" 字节"
	end if
	CheckSize=ByteSize
End Function
'''''''''''''''''''''''''''''''''''''''''''


Function UpUserRank()
	Set Rs1=Execute("select top 1 RankName from ["&TablePrefix&"Ranks] where (RoleID="&Rs("UserRoleID")&" or RoleID=0) and PostingCountMin<="&Rs("TotalPosts")&" order by RoleID Desc,PostingCountMin Desc")
	if Not Rs1.Eof Then UpUserRank=Rs1("RankName")
	Rs1.close
	Set Rs1=nothing
End Function



Function ShowRole(value)
	select case value
		case "1"
			ShowRole="管理员"
		case "2"
			ShowRole="超级版主"
		case "3"
			ShowRole="注册用户"
		case else
			ShowRole=Execute("Select Name From ["&TablePrefix&"Roles] where RoleID="&value&"")(0)
	end select
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function ShowUserAccountStatus(value)
	select case value
		case "0"
			ShowUserAccountStatus="正等待审核"
		case "1"
			ShowUserAccountStatus="已通过审核"
		case "2"
			ShowUserAccountStatus="已禁用"
		case "3"
			ShowUserAccountStatus="未通过审核"
		case else
			ShowUserAccountStatus="未知状态"
	end select
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function ShowUserSex(value)
if SiteConfig("AllowGender")=1 then
	select case value
		case 0
			ShowUserSex=""
		case 1
			ShowUserSex="<img src=images/Sex_1.gif title='男'>"
		case 2
			ShowUserSex="<img src=images/Sex_2.gif title='女'>"
	end select
end if
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function Zodiac(birthday)
	if IsDate(birthday) then
		birthyear=year(birthday)
		ZodiacList=array("猴(Monkey)","鸡(Rooster)","狗(Dog)","猪(Boar)","鼠(Rat)","牛(Ox)","虎(Tiger)","兔(Rabbit)","龙(Dragon)","蛇(Snake)","马(Horse)","羊(Goat)")
		Zodiac=ZodiacList(birthyear mod 12)
	end if
End Function
'''''''''''''''''''''''''''''''''''''''''''
Function Horoscope(birthday)
	if IsDate(birthday) then
		HoroscopeMon=month(birthday)
		HoroscopeDay=day(birthday)
		if Len(HoroscopeMon)<2 then HoroscopeMon="0"&HoroscopeMon
		if Len(HoroscopeDay)<2 then HoroscopeDay="0"&HoroscopeDay
		MyHoroscope=HoroscopeMon&HoroscopeDay
		if MyHoroscope < 0120 then
			Horoscope="<img src=images/Horoscope/Capricorn.gif title='魔羯座 Capricorn'>"
		elseif MyHoroscope < 0219 then
			Horoscope="<img src=images/Horoscope/Aquarius.gif title='水瓶座 Aquarius'>"
		elseif MyHoroscope < 0321 then
			Horoscope="<img src=images/Horoscope/Pisces.gif title='双鱼座 Pisces'>"
		elseif MyHoroscope < 0420 then
			Horoscope="<img src=images/Horoscope/Aries.gif title='白羊座 Aries'>"
		elseif MyHoroscope < 0521 then
			Horoscope="<img src=images/Horoscope/Taurus.gif title='金牛座 Taurus'>"
		elseif MyHoroscope < 0622 then
			Horoscope="<img src=images/Horoscope/Gemini.gif title='双子座 Gemini'>"
		elseif MyHoroscope < 0723 then
			Horoscope="<img src=images/Horoscope/Cancer.gif title='巨蟹座 Cancer'>"
		elseif MyHoroscope < 0823 then
			Horoscope="<img src=images/Horoscope/Leo.gif title='狮子座 Leo'>"
		elseif MyHoroscope < 0923 then
			Horoscope="<img src=images/Horoscope/Virgo.gif title='处女座 Virgo'>"
		elseif MyHoroscope < 1024 then
			Horoscope="<img src=images/Horoscope/Libra.gif title='天秤座 Libra'>"
		elseif MyHoroscope < 1122 then
			Horoscope="<img src=images/Horoscope/Scorpio.gif title='天蝎座 Scorpio'>"
		elseif MyHoroscope < 1222 then
			Horoscope="<img src=images/Horoscope/Sagittarius.gif title='射手座 Sagittarius'>"
		elseif MyHoroscope > 1221 then
			Horoscope="<img src=images/Horoscope/Capricorn.gif title='魔羯座 Capricorn'>"
		end if
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -