www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\ask\inc\cls_askmain.asp

    <object runat="server" id="oStream" progid="ADODB.Stream"></object>
<%
'=====================================================================
' 软件名称：新云问吧管理系统 v1.0.0
' 文件名称：cls_main.asp
' 更新日期：2007-10-16
' 官方网站：新云网络(www.newasp.net www.newasp.cn) QQ：94022511
'=====================================================================
' Copyright 2003-2008 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
Const EnabledSession = True
Const showSQLCommand = 0
Const IsDeBug = 1
Const guestxml="<?xml version=""1.0"" encoding=""gb2312""?><xml><userinfo statuserid=""0"" userid=""0"" username=""客人"" usertitle=""客人"" userclass=""-1"" classid=""0"" accesstime="""" activetime="""" statusstr="""" fromsite="""" enternum=""0"" points=""0"" experience=""0""/></xml>"

Class AskingMain_Cls
	Private LocalCacheName, Reloadtime,Buildtime
	Public sqlQueryNum, CacheName, Asked_sn, UserTrueIP, IsCache,FoundErr
	Public AskSetting,mainsetting,ScriptName,ScriptFolder,UserSession,Stats,Referer,URL
	Public UserID,UserName,PassWord,Randomcode,UserSex,UserPoint,UserClass,UserTitle,classid,CacheData
	Public InstallDir,Asked_Setting,Point_Setting,Posts_Setting,Badwords,LockIPlist,NowUseTable,MaxUserNum,MaxPendNum,MaxDoneNum,MaxVoteNum,MaxshareNum,MaxCommentNum,AskedOnline
	Public AskedName,AskedUrl,AskedEmail,Copyright,TemplatePath,AskedSkinUrl,ClassType,ExpiredDays
	Public DocNodes,XsltDom,ScriptPath,AskRegExp,Page_Admin
	Public Browsers,versions ,platform,IsSearch,IsSpider
	Private cBadwords,actforip,m_strBadword

	Private Sub Class_Initialize()
		On Error Resume Next
		If Err Then
			Response.charset="GB2312"
			Response.Write Err.Description
			Response.End
		End If
		Buildtime = 60
		Reloadtime = 600
		SqlQueryNum = 0
		'--缓存名称
		CacheName = "NewAspAsked"
		Asked_sn = "NewAspAsked"
		Asked_sn = Asked_sn & "_" & Request.servervariables("SERVER_NAME")
		TemplatePath = MyAppPath & "template/default/"
		AskedSkinUrl = MyAppPath & "skin/default/"
		classid = ChkNumeric(Request("classid"))
		IsCache = False
		FoundErr = False
		ExpiredDays = 15
		UserTrueIP = getIP
		UserClass = -1
		UserName = CheckBadstr(Request.Cookies(Asked_sn)("UserName"))
		UserTitle = CheckBadstr(Request.Cookies(Asked_sn)("UserTitle"))
		PassWord = Checkstr(Request.Cookies(Asked_sn)("PassWord"))
		Randomcode = Checkstr(Request.Cookies(Asked_sn)("Randomcode"))
		UserSex = ChkNumeric(Request.Cookies(Asked_sn)("UserSex"))
		UserID = ChkNumeric(Request.Cookies(Asked_sn)("UserID"))
		Dim Tmpstr
		Tmpstr = Request.ServerVariables("PATH_INFO")
		Tmpstr = Split(Tmpstr,"/")
		ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
		ScriptFolder = Lcase(Tmpstr(UBound(Tmpstr)-1)) & "/"
		Page_Admin=False
		If InStr(ScriptName,"showerr")>0 Or InStr(ScriptName,"login")>0 Or InStr(ScriptName,"admin_")>0  Then Page_Admin=True
	End Sub

	Private Sub Class_Terminate()
		'--Termination of Class
	End Sub
	Sub CloseConn()
		'NewAsp.ActiveOnline()
		If EnabledSession Then
			If Not UserSession Is Nothing  Then Session(CacheName & "UserID")= UserSession.xml
		End If
		Set UserSession=Nothing
		If IsObject(Conn) Then Conn.Close : Set Conn = Nothing
		Set AskRegExp = Nothing
		Asked_Setting = Null
		Point_Setting = Null
		CacheData = Null
		Set NewAsp = Nothing
	End Sub
	'===================服务器缓存部分函数开始===================
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
	End Property
	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then
			Application.Lock
			Application(CacheName & "_" & LocalCacheName &"_-time")=Now()
			Application(CacheName & "_" & LocalCacheName) = vNewValue
			Application.unLock
		End If
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then
				Value=Application(CacheName & "_" & LocalCacheName)
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=False
		If IsDate(Application(CacheName & "_" & LocalCacheName &"_-time")) Then
			If DateDiff("s",CDate(Application(CacheName & "_" & LocalCacheName &"_-time")),Now()) > (60*Reloadtime) Then ObjIsEmpty=True
		Else
			ObjIsEmpty=True
		End If
		If ObjIsEmpty Then RemoveCache()
	End Function
	Public Sub RemoveCache()
		Application.Lock
		Application.Contents.Remove(CacheName & "_" & LocalCacheName)
		Application.Contents.Remove(CacheName & "_" & LocalCacheName &"_-time")
		Application.unLock
	End Sub
	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove (CacheName & "_" & MyCaheName &"_-time")
		Application.Contents.Remove (CacheName & "_" & MyCaheName)
		Application.UnLock
	End Sub
	Public Function IsTimeBuild()
		IsTimeBuild=False
		If IsDate(Application(CacheName & "_buildtime")) Then
			If DateDiff("s",CDate(Application(CacheName & "_buildtime")),Now()) > (60*buildtime) Then IsTimeBuild=True
		Else
			IsTimeBuild=True
		End If
		If IsTimeBuild Then Application(CacheName & "_buildtime")=Now()
	End Function

	'===================服务器缓存部分函数结束===================
	Public Function CreateAXObject(str)
		Set CreateAXObject = Server.CreateObject(str)
	End Function
	Public Function CreateXMLDoc(str)
		Set CreateXmlDoc = CreateAXObject(str)
		CreateXMLDoc.Async = False
	End Function
	Public Function ReadTextFile(fileName)
		On Error Resume Next
		oStream.charset="GB2312"
		oStream.Type = 2
		oStream.Mode = 3
		oStream.open()
		oStream.LoadFromFile(ChkMapPath(fileName))
		ReadTextFile=oStream.ReadText
		oStream.close()
		If Err.Number <> 0 Then Err.Clear
	End Function
	Public Function writeTextFile(fileName,Text)
		oStream.charset="GB2312"
		'oStream.Type = 2
		oStream.Mode = 3
		oStream.open()
		oStream.WriteText(Text)
		oStream.SaveToFile ChkMapPath(fileName),2
		oStream.close()
	End Function
	Public Function ChkBoolean(ByVal Values)
		If TypeName(Values) = "Boolean" Or IsNumeric(Values) Or LCase(Values) = "false" Or LCase(Values) = "true" Then
			ChkBoolean = CBool(Values)
		Else
			ChkBoolean = False
		End If
	End Function
	Public Function CheckNumeric(ByVal CHECK_ID)
		If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
			If CHECK_ID > 922337203685477 Then CHECK_ID = 0
			If CHECK_ID < -922337203685477 Then CHECK_ID = 0
			CHECK_ID = CCur(CHECK_ID)
		Else
			CHECK_ID = 0
		End If
		CheckNumeric = CHECK_ID
	End Function
	Public Function ChkNumeric(ByVal CHECK_ID)
		If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
			If CHECK_ID < 0 Then CHECK_ID = 0
			If CHECK_ID > 2147483647 Then CHECK_ID = 0
			CHECK_ID = CLng(CHECK_ID)
		Else
			CHECK_ID = 0
		End If
		ChkNumeric = CHECK_ID
	End Function
	Public Function CheckStr(ByVal str)
		If IsNull(str) Then
			CheckStr = ""
			Exit Function
		End If
		str = Replace(str, Chr(0), "")
		CheckStr = Replace(str, "'", "''")
	End Function
	'-- 去掉HTML标记
	Public Function RemoveHtml(ByVal str)
		On Error Resume Next
		Dim re:Set re=new RegExp
		re.IgnoreCase=True
		re.Global=True
		re.Pattern="<(.[^>]*)>"
		str=re.Replace(str, "")
		Set re=Nothing
		RemoveHtml=str
	End Function
	Public Function CheckBadstr(str)
		If IsNull(str) Then
			CheckBadstr = vbNullString
			Exit Function
		End If
		str = Replace(str, Chr(0), vbNullString) : str = Replace(str, Chr(34), vbNullString)
		str = Replace(str, Chr(9), vbNullString) : str = Replace(str, Chr(250), vbNullString)
		str = Replace(str, "'", "''") : str = Replace(str, "--", "－－")
		str = Replace(str, "<", "&gt;") : str = Replace(str, ">", "&lt;")
		CheckBadstr = Trim(str)
	End Function
	Public Function RequestForm(ByVal strRequest,Byval strLen)
		Dim m_strRequest
		If Request.Form <> "" Then
			m_strRequest = Trim(Request.Form(strRequest))
		Else
			m_strRequest = strRequest
		End If
		If Len(m_strRequest) = 0 Then
			RequestForm = ""
			Exit Function
		End If
		m_strRequest = Replace(m_strRequest, Chr(0), "")
		m_strRequest = Replace(m_strRequest, "'", "&#39;")
		m_strRequest = Replace(m_strRequest, Chr(34), "&quot;")
		m_strRequest = Replace(m_strRequest, ">", "&gt;")
		m_strRequest = Replace(m_strRequest, "<", "&lt;")
		m_strRequest = Replace(m_strRequest, "&#62;", "&gt;")
		m_strRequest = Replace(m_strRequest, "&#60;", "&lt;")
		m_strRequest = Replace(m_strRequest, "--", "－－")
		m_strRequest = Replace(m_strRequest, "∨", "&or;")
		m_strRequest = Replace(m_strRequest, "≡", "&equiv;")
		If Len(m_strRequest) > 0 And strLen > 0 Then
			RequestForm = Left(m_strRequest,strLen)
		Else
			RequestForm = m_strRequest
		End If
	End Function
	Public Function RewriteHtmlURL(strURL)
		Dim str:str=Trim(strURL)
		If IsURLRewrite = True Then
			Dim re
			Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern = "\{\$InstallDir\}"
			str = re.Replace(str,InstallDir)
			re.Pattern = "showlist\.asp\?classid=(\d+)(&|&amp;)topicmode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"showlist-$1-$3-$5")
			re.Pattern = "showlist\.asp\?classid=(\d+)(&|&amp;)topicmode=(\d+)"
			str = re.Replace(str,"showlist-$1-$3-1")
			re.Pattern = "showlist\.asp\?classid=(\d+)"
			str = re.Replace(str,"showlist-$1-0-1")
			re.Pattern = "question\.asp\?topicid=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"question-$1-$3")
			re.Pattern = "question\.asp\?topicid=(\d+)"
			str = re.Replace(str,"question-$1-1")
			re.Pattern = "share\.asp\?topicid=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"share-$1-$3")
			re.Pattern = "share\.asp\?topicid=(\d+)"
			str = re.Replace(str,"share-$1-1")
			re.Pattern = "topasking\.asp\?mode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"topasking-$1-$3")
			re.Pattern = "topasking\.asp\?mode=(\d+)"
			str = re.Replace(str,"topasking-$1-1")
			re.Pattern = "topasking\.asp"
			str = re.Replace(str,"topasking-0-1")
			re.Pattern = "topshare\.asp\?mode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"topshare-$1-$3")
			re.Pattern = "topshare\.asp\?mode=(\d+)"
			str = re.Replace(str,"topshare-$1-1")
			re.Pattern = "topshare\.asp"
			str = re.Replace(str,"topshare-0-1")
			Set Re=Nothing
		End If
		RewriteHtmlURL = str
	End Function

	Public Function ArchiveHtml(Text)
		Dim str:str=Text
		Dim iCustom,CustomTemp
		Set iCustom = New CustomTemplate_Cls
		str = iCustom.appendTemplate(str)
		Set iCustom=Nothing
		If IsURLRewrite = True Then
			Dim re,Matches,Match
			Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern = "\{\$InstallDir\}"
			str = re.Replace(str,InstallDir)
			re.Pattern = "<a(.[^>]*)showlist\.asp\?classid=(\d+)(&|&amp;)topicmode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1showlist-$2-$4-$6")
			re.Pattern = "<a(.[^>]*)showlist\.asp\?classid=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1showlistlist-$2-$4-1")
			re.Pattern = "<a(.[^>]*)showlist\.asp\?classid=(\d+)"
			str = re.Replace(str,"<a$1showlist-$2-0-1")
			re.Pattern = "<a(.[^>]*)question\.asp\?topicid=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1question-$2-$4")
			re.Pattern = "<a(.[^>]*)question\.asp\?topicid=(\d+)"
			str = re.Replace(str,"<a$1question-$2-1")
			re.Pattern = "<a(.[^>]*)share\.asp\?topicid=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1share-$2-$4")
			re.Pattern = "<a(.[^>]*)share\.asp\?topicid=(\d+)"
			str = re.Replace(str,"<a$1share-$2-1")
			re.Pattern = "<a(.[^>]*)topasking\.asp\?mode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1topasking-$2-$4")
			re.Pattern = "<a(.[^>]*)topasking\.asp\?mode=(\d+)"
			str = re.Replace(str,"<a$1topasking-$2-1")
			re.Pattern = "<a(.[^>]*)topasking\.asp"
			str = re.Replace(str,"<a$1topasking-0-1")

			re.Pattern = "<a(.[^>]*)topshare\.asp\?mode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1topshare-$2-$4")
			re.Pattern = "<a(.[^>]*)topshare\.asp\?mode=(\d+)"
			str = re.Replace(str,"<a$1topshare-$2-1")
			re.Pattern = "<a(.[^>]*)topshare\.asp"
			str = re.Replace(str,"<a$1topshare-0-1")

			re.Pattern = "<a(.[^>]*)usertopic\.asp\?userid=(\d+)(&|&amp;)topicmode=(\d+)(&|&amp;)page=(\d+)"
			str = re.Replace(str,"<a$1usertopic-$2-$4-$6")
			re.Pattern = "<a(.[^>]*)usertopic\.asp\?userid=(\d+)(&|&amp;)topicmode=(\d+)"
			str = re.Replace(str,"<a$1usertopic-$2-$4-1")
			re.Pattern = "<a(.[^>]*)usertopic\.asp\?userid=(\d+)"
			str = re.Replace(str,"<a$1usertopic-$2-0-1")
			Set Re=Nothing
		End If
		str = Replace(str, "{$installdir}", InstallDir)
		ArchiveHtml = Replace(Replace(str, "{$LoadTime}", PageLoadTime), "&amp;", "&")
	End Function
	Public Function PageLoadTime()
		Dim Endtime
		Endtime = Timer()
		PageLoadTime = "页面执行时间 " & FormatNumber((Endtime - startime), 5, -1) & " 秒, "&SqlQueryNum&" 次数据查询"
		'PageLoadTime = "页面执行时间：" & FormatNumber((Endtime - startime)*1000, 5, -1) & " 毫秒"
	End Function
	Private 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)
			actforip = 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)
			actforip = Request.ServerVariables("REMOTE_ADDR")
		Else
			strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
			actforip = Request.ServerVariables("REMOTE_ADDR")
		End If
		getIP = Replace(Trim(Mid(strIPAddr, 1, 30)), "'", "")
	End Function
	Public Property Get Version()
		Version = "<a href=""http://ask.newasp.net"" target=""_blank""><u>新云问吧管理系统 V1.0.0.1012</u></a>"
	End Property
	Public Function Execute(strCommand)
		If Not IsObject(Conn) Then ConnectionDatabase
		If IsDeBug = 0 Then
			On Error Resume Next
			Set Execute = Conn.Execute(strCommand)
			If Err Then
				err.Clear
				Set Conn = Nothing
				If ShowSQLCommand=1 Then
					Response.Write strCommand & "<br />"
				End If
				Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
				Response.End
			End If
		Else
			Set Execute = Conn.Execute(strCommand)
		End If
		SqlQueryNum = SqlQueryNum+1
	End Function
	'-- xmlroot跟节点名称 row记录行节点名称
	Public Function RecordsetToxml(Recordset,row,xmlroot)
		Dim i,node,rs,j,DataArray
		If xmlroot="" Then xmlroot="xml"
		If row="" Then row="row"
		Set RecordsetToxml = CreateXMLDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		RecordsetToxml.appendChild(RecordsetToxml.createElement(xmlroot))
		If Not Recordset.EOF Then
			DataArray=Recordset.GetRows(-1)
			For i=0 To UBound(DataArray,2)
				Set Node=RecordsetToxml.createNode(1,row,"")
				j=0
				For Each rs in Recordset.Fields
						 node.attributes.setNamedItem(RecordsetToxml.createNode(2,LCase(rs.name),"")).text= DataArray(j,i)& ""
						 j=j+1
				Next
				RecordsetToxml.documentElement.appendChild(Node)
			Next
		End If
		DataArray=Null
	End Function
	Public Function ArrayToxml(DataArray,Recordset,row,xmlroot)
		Dim i,node,rs,j
		If xmlroot="" Then xmlroot="xml"
		Set ArrayToxml = CreateXMLDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		ArrayToxml.appendChild(ArrayToxml.createElement(xmlroot))
		If row="" Then row="row"
		For i=0 To UBound(DataArray,2)
			Set Node=ArrayToxml.createNode(1,row,"")
			j=0
			For Each rs in Recordset.Fields
					 node.attributes.setNamedItem(ArrayToxml.createNode(2,LCase(rs.name),"")).text= DataArray(j,i)& ""
					 j=j+1
			Next
			ArrayToxml.documentElement.appendChild(Node)
		Next
	End Function
	Public Function LoadTemplate(ByVal Page_Fields)
		Dim Page_File,Cache_File,TempHtmlCode
		Cache_File = MyAppPath & "template/CacheFile/" & Page_Fields & ".html"
		Name = Page_Fields
		If ObjIsEmpty() Or IsCache=False Then
			Page_File = TemplatePath & Page_Fields & ".html"
			TempHtmlCode = ReadTextFile(Page_File)
			TempHtmlCode = GetHtmlCustom(TempHtmlCode)
			Dim Parentlist,Node,ParentMenu
			If IsObject(Application(CacheName&"_parentmenu")) Then
				Set Parentlist = Application(CacheName&"_parentmenu")
				If Not Parentlist Is Nothing Then
					Dim classid,ClassName,Childs,i
					Childs = Parentlist.documentElement.SelectNodes("row").Length
					i = 0
					For Each Node in Parentlist.documentElement.SelectNodes("row")
						i = i + 1
						ClassName = Node.selectSingleNode("@classname").text
						classid = Node.selectSingleNode("@classid").text
						ParentMenu = ParentMenu & "<a href=""" & InstallDir & "showlist.asp?classid=" & classid & """"
						If i = Childs Then
							ParentMenu = ParentMenu & " class=""last"">"
						Else
							ParentMenu = ParentMenu & ">"
						End If
						ParentMenu = ParentMenu & ClassName
						ParentMenu = ParentMenu & "</a>" & vbCrLf
					Next
				End If
				Set Parentlist = Nothing
			End If
			TempHtmlCode = Replace(TempHtmlCode, "{$ParentMenu}", ParentMenu)
			TempHtmlCode = Replace(TempHtmlCode, "{$InstallDir}", InstallDir)
			TempHtmlCode = Replace(TempHtmlCode, "$InstallDir$", InstallDir)
			TempHtmlCode = Replace(TempHtmlCode, "{$Version}", Version)
			TempHtmlCode = Replace(TempHtmlCode, "{$MaxUserNum}", MaxUserNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$MaxPendNum}", MaxPendNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$MaxDoneNum}", MaxDoneNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$MaxVoteNum}", MaxVoteNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$MaxshareNum}", MaxshareNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$MaxCommentNum}", MaxCommentNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$AskedOnline}", AskedOnline)
			TempHtmlCode = Replace(TempHtmlCode, "{$AskedTotal}", MaxPendNum+MaxDoneNum+MaxVoteNum+MaxshareNum)
			TempHtmlCode = Replace(TempHtmlCode, "{$AskedName}", AskedName)
			TempHtmlCode = Replace(TempHtmlCode, "{$AskedUrl}", AskedUrl)
			TempHtmlCode = Replace(TempHtmlCode, "{$AskedEmail}", AskedEmail)
			TempHtmlCode = Replace(TempHtmlCode, "{$Asked_sn}", Asked_sn)
			TempHtmlCode = Replace(TempHtmlCode, "{$IndexName}", Asked_Setting(2))
			TempHtmlCode = Replace(TempHtmlCode, "{$HomePage}", Asked_Setting(3))
			TempHtmlCode = Replace(TempHtmlCode, "{$HomeUrl}", Asked_Setting(4))
			TempHtmlCode = Replace(TempHtmlCode, "{$Copyright}", Asked_Setting(6))
			If IsCache Then
				writeTextFile Cache_File,TempHtmlCode
				value = "NoData"
			Else
				value = ""
			End If
		End If

		If IsCache Then
			TempHtmlCode = ReadTextFile(Cache_File)
		Else
			TempHtmlCode = TempHtmlCode
		End If
		LoadTemplate = TempHtmlCode
	End Function
	Public Function GetHtmlCustom(ByVal strContent)
		Dim Page_File,strMatchs,strMatch,tmpstr,strCustom
		If InStr(Lcase(strContent),"<html:custom") > 0 Then
			AskRegExp.Pattern="<html:custom(.[^>]*)name=(""|')([A-Za-z0-9_\-\s\u4E00-\u9FA5]+)(""|')(.[^>]*)>"
			Set strMatchs=AskRegExp.Execute(strContent)
			For Each strMatch in strMatchs
				tmpstr=Trim(strMatch.SubMatches(2))
				Page_File = TemplatePath & "html/" & tmpstr & ".html"
				strCustom = ReadTextFile(Page_File)
				strContent = Replace(strContent,strMatch.Value,strCustom)
			Next
			Set strMatchs = Nothing
		End If
		AskRegExp.Pattern="<!--#(.[^>]*)(#-->" & vbCrLf & "|#-->)"
		strContent=AskRegExp.Replace(strContent, "")
		GetHtmlCustom = strContent
	End Function

	Public Sub GetAsked_Setting()
		Name = "Date"
		If ObjIsEmpty() Then
			Value = Date
		ElseIf CStr(Value) <> CStr(Date) Then
			Call LoadSetup()
			Name = "Date"
			Value = Date()
		End If
		Name = "setup"
		If ObjIsEmpty Then LoadSetup()
		CacheData = value
		Dim strBadword
		InstallDir = Trim(CacheData(1,0))
		Asked_Setting = Split(CacheData(2,0),"|||")
		Point_Setting = Split(CacheData(3,0),"|||")
		Posts_Setting = Split(CacheData(4,0),"|||")
		strBadword = Split(CacheData(16,0) & "$$$","$$$")
		badwords = strBadword(0)
		cBadwords = strBadword(1)
		strBadword = Null
		NowUseTable = Trim(CacheData(5,0))
		MaxUserNum = CLng(CacheData(6,0))
		MaxPendNum = CLng(CacheData(7,0))
		MaxDoneNum = CLng(CacheData(8,0))
		MaxVoteNum = CLng(CacheData(9,0))
		MaxshareNum = CLng(CacheData(10,0))
		MaxCommentNum = CLng(CacheData(11,0))
		AskedOnline = CLng(CacheData(12,0))
		AskedName = Trim(Asked_Setting(0))
		AskedUrl = Trim(Asked_Setting(1))
		AskedEmail = Trim(Asked_Setting(5))
		TemplatePath = MyAppPath & Trim(CacheData(14,0))
		AskedSkinUrl = InstallDir & Trim(CacheData(15,0))
		Set AskRegExp = New RegExp
		AskRegExp.IgnoreCase = True
		AskRegExp.Global = True
		If Not IsObject(Application(CacheName&"_classlist")) Then
			LoadCategoryList()
		End If
		If Not IsObject(Application(CacheName&"_parentmenu")) Then
			LoadParentMenu()
		End If

		ChcekProxy(Asked_Setting(7))
	End Sub

	Public Sub LoadSetup()
		Dim Rs,locklist,ip,ip1,XMLDom,Node,i
		Name="setup"
		Set Rs = NewAsp.Execute("SELECT id,InstallDir,Asked_Setting,Point_Setting,Posts_Setting,NowUseTable,MaxUserNum,MaxPendNum,MaxDoneNum,MaxVoteNum,MaxshareNum,MaxCommentNum,AskedOnline,AskedKey,TemplatePath,SkinPath,Badwords,LockIPlist FROM [NC_Ask_Setup]")
		Value = Rs.GetRows(1)
		CacheData=value
		Set Rs=Nothing
		Set XMLDom=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		XMLDom.appendChild(XMLDom.createElement("xml"))
		locklist=Trim(CacheData(17,0)) & ""
		'locklist = "127.0.0.*"
		locklist=Split(locklist,"|")
		For Each Ip in locklist
			Ip1=Split(Ip,".")
			Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"lockip",""))
			For i=0 To UBound(ip1)
				Node.attributes.setNamedItem(XMLDom.createNode(2,"number"& (i+1),"")).text=ip1(i)
			Next
		Next
		Application.Lock
		Set Application(CacheName & "_asked_lockip")=XMLDom.cloneNode(True)
		Application.UnLock
		Set XMLDom=Nothing
		If Not isobject(Application(CacheName & "_getbrowser")) Then
			Dim stylesheet
			Set stylesheet=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
			stylesheet.load Server.MapPath(MyAppPath &"script/getbrowser.xslt")
			Application.Lock
			Set Application(CacheName & "_getbrowser")=NewAsp.CreateAXObject("msxml2.XSLTemplate" & MsxmlVersion)
			Application(CacheName & "_getbrowser").stylesheet=stylesheet
			Application.unLock
		End If

	End Sub

	Public Sub ReloadSetupCache(MyValue,N)'更新总设置表部分缓存数组，入口：更新内容、数组位置
		CacheData(N,0) = MyValue
		Name="setup"
		value=CacheData
	End Sub

	Public Sub LoadParentMenu()
		Dim Rs,SQL,Templist
		Set Rs = Execute("SELECT classid,ClassName FROM NC_Ask_Class WHERE depth=0 ORDER BY rootid")
		If Not (Rs.BOF And Rs.EOF) Then
			SQL=Rs.GetRows(-1)
			Set Templist = ArrayToxml(SQL,Rs,"row","parentmenu")
		End If
		Rs.Close
		Set Rs = Nothing
		SQL=Empty
		If IsObject(Templist) Then
			Application.Lock
				Set Application(CacheName&"_parentmenu") = Templist
			Application.unLock
		End If
	End Sub

	Public Sub LoadCategoryList()
		Dim Rs,SQL,TempXmlDoc
		Set Rs = Execute("SELECT classid,ClassName,Readme,rootid,depth,parentid,Parentstr,child FROM NC_Ask_Class ORDER BY orders,classid")
		If Not (Rs.BOF And Rs.EOF) Then
			SQL=Rs.GetRows(-1)
			Set TempXmlDoc = ArrayToxml(SQL,Rs,"row","classlist")
		End If
		Rs.Close
		Set Rs = Nothing
		If IsObject(TempXmlDoc) Then
			Application.Lock
				Set Application(CacheName&"_classlist") = TempXmlDoc
			Application.unLock
		End If
	End Sub
	Public Function IndexMenulist()
		Dim Parentlist,Node,strTempMenu
		If IsObject(Application(CacheName&"_classlist")) Then
			Set Parentlist = Application(NewAsp.CacheName&"_classlist")
			If Not Parentlist Is Nothing Then
				Dim classid,ClassName,Childs,i,depth,strLinks,rootid
				Childs = Parentlist.documentElement.SelectNodes("row").Length
				i = 0
				For Each Node in Parentlist.documentElement.SelectNodes("row[@depth=0]")
					ClassName = Node.selectSingleNode("@classname").text
					classid = Node.selectSingleNode("@classid").text
					depth = Node.selectSingleNode("@depth").text
					rootid = Node.selectSingleNode("@rootid").text
					strLinks = "<a href=""" & InstallDir & "showlist.asp?classid=" & classid & """>"
					strLinks = strLinks & ClassName
					strLinks = strLinks & "</a> "

					strTempMenu = strTempMenu & "<dt>" & strLinks & "</dt>" & vbCrLf
					strTempMenu = strTempMenu & GetChildList(rootid,4)
				Next
				Set Parentlist = Nothing
			End If
		End If
		IndexMenulist = strTempMenu
	End Function
	Public Function GetChildList(cid,m)
		Dim Childlist,Node,strTemp,i,ParentLinks
		Dim classid,ClassName,strLinks
		If IsObject(Application(CacheName&"_classlist")) Then
			Set Childlist = Application(NewAsp.CacheName&"_classlist")
			If Not Childlist Is Nothing Then
				i = 0
				strTemp = "<dd>"
				For Each Node in Childlist.documentElement.SelectNodes("row[@rootid="&cid&"]")
					i = i + 1
					ClassName = Node.selectSingleNode("@classname").text
					classid = Node.selectSingleNode("@classid").text
					If i = 1 Then
						'ParentLinks = "<a href=""" & InstallDir & "showlist.asp?classid=" & classid & "&topicmode=1&page=1"">…</a> "
					Else
						strLinks = "<a href=""" & InstallDir & "showlist.asp?classid=" & classid & """>"
						strLinks = strLinks & ClassName
						strLinks = strLinks & "</a> "
						strTemp = strTemp & strLinks
					End If
					If i > m Then Exit For
				Next
				Set Childlist = Nothing
				strTemp = strTemp & ParentLinks & "</dd>" & vbCrLf
			End If
			Set Childlist = Nothing
		End If
		GetChildList = strTemp
	End Function
	Public Sub LetGuestSession()'写入客人session
		Dim StatUserID,UserSessionID
		StatUserID = CheckStr(Trim(Request.Cookies(Asked_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 Or StatUserID = "" Then
			StatUserID = Replace(UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 Or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
		StatUserID = Ccur(StatUserID)
		Response.Cookies(Asked_sn).path="/"
		Response.Cookies(Asked_sn).Expires=DateAdd("s",3600,Now())
		Response.Cookies(Asked_sn)("StatUserID") = StatUserID
		Set UserSession=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		UserSession.Loadxml guestxml
		UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text=StatUserID
		UserSession.documentElement.selectSingleNode("userinfo/@accesstime").text=Now()
		UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
		UserSession.documentElement.selectSingleNode("userinfo/@classid").text=classid
		Dim BS
		Set Bs=GetBrowser()
		UserSession.documentElement.appendChild(Bs.documentElement)
		If EnabledSession Then
			Session(CacheName & "UserID")=UserSession.xml
		End If
	End Sub
	Public Function NeedChecklongin()
		NeedChecklongin=True
		If UserID > 0 Then
			If InStr(ScriptName,"admin_")>0 Then Exit Function
			Dim pagelist
			pagelist=",login.asp,postask.asp,showlist.asp,question.asp,postsave.asp,user.asp,postshare.asp,"
			pagelist=pagelist&"useranswer.asp,userasked.asp,usercenter.asp,userfavorite.asp,userinfoset.asp,"
			pagelist=pagelist&"usershare.asp,usertopic.asp,"
			If InStr(pagelist,","&ScriptName&",")>0 Then Exit Function
		End If
		NeedChecklongin=False
	End Function
	Public Sub CheckUserLogin()
		If EnabledSession Then
			Set UserSession=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
			If Not UserSession.loadxml(Session(CacheName & "UserID")&"") Then
				If UserID > 0 Then
					Call TrueCheckUserLogin()
				Else
					Call LetGuestSession()
				End If
			Else
				If UserID > 0 Then
					If NeedChecklongin Then TrueCheckUserLogin
				End If
			End If
		Else
			If UserID > 0 Then
					Call TrueCheckUserLogin()
				Else
					Call LetGuestSession()
			End If
		End If
		UserID=ChkNumeric(UserSession.documentElement.selectSingleNode("userinfo/@userid").text)

		If UserID > 0 Then
			Call GetCacheUserInfo()
		End If

		Browsers=Checkstr(UserSession.documentElement.selectSingleNode("agent/@browser").text)
		Versions=Replace(Checkstr(UserSession.documentElement.selectSingleNode("agent/@version").text),"--","")
		platform=Checkstr(UserSession.documentElement.selectSingleNode("agent/@platform").text)
		If (Browsers="unknown" And Versions="unknown" And platform="unknown") Then
			If IsWebSearch Then
				IsSearch = True
			Else
				IsSearch = False
			End If
		End If
		'IP锁定
		If UserSession.documentElement.selectSingleNode("agent/@lockip").text="1"  Then
			If Not Page_Admin Then Set NewAsp = Nothing:Response.Redirect InstallDir & "showerr.asp?action=iplock"
			'If Not Page_Admin Then Session(CacheName & "UserID")=empty:Response.Status = "302 Object Moved"
		End If
	End Sub

	Public Sub TrueCheckUserLogin()
		Dim Rs,SQL
		SQL = "SELECT userid,Username,Nickname,Password,Randomcode,Randomcode as statuserid,UserClass,UserTitle,Useremail,qq,msn,Usersex,UserFace,Photo,Homepage,question,answer,Intro,Userlock,addtime,lastime as accesstime,lastime,lastime as activetime,Enternum,Points,Experience,AnswerPoint,SharePoint,RewardPoint,PunishPoint,Asktotal,Askpend,Askdone,Askvote,Askshare,Askstop,Askoverdue,Answertotal,Adopted,Delnum,Badness,userid as classid FROM NC_Ask_Users WHERE userid=" & UserID
		Set Rs = Execute(SQL)
		If Rs.EOF Then
			UserID = 0:LetGuestSession():Exit Sub
		Else
			If Not (LCase(Rs("UserName"))=LCase(UserName) And Rs("PassWord")=PassWord) Then
				If EnabledSession Then
					Set UserSession=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
					If UserSession.loadxml(Session(CacheName & "UserID")&"")  Then
						If UserSession.documentElement.selectSingleNode("userinfo/@username") Is Nothing Or UserSession.documentElement.selectSingleNode("userinfo/@password") Is Nothing Then
							UserID = 0:LetGuestSession():Exit Sub
						Else
							If Not (LCase(Rs("UserName"))=LCase(UserSession.documentElement.selectSingleNode("userinfo/@username").text) and Rs("Password")=UserSession.documentElement.selectSingleNode("userinfo/@password").text) Then
									UserID = 0:LetGuestSession():Exit Sub
							End If
						End If
					Else
						UserID = 0:LetGuestSession():Exit Sub
					End If
				Else
					UserID = 0:LetGuestSession():Exit Sub
				End If
			End If
			If Rs("UserLock")=1 Then
				UserID = 0:LetGuestSession():Exit Sub
			End if
		End If
		Set UserSession = RecordsetToxml(rs,"userinfo","xml")
		UserSession.documentElement.selectSingleNode("userinfo/@accesstime").text=Now()
		UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
		UserSession.documentElement.selectSingleNode("userinfo/@classid").text=classid
		'UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text=checkStr(Trim(Request.Cookies(Asked_sn)("StatUserID")))
		Dim BS
		Set Bs=GetBrowser()
		UserSession.documentElement.appendChild(Bs.documentElement)
		If EnabledSession Then
			Session(CacheName & "UserID")= UserSession.xml
		End If
		Set Rs=Nothing
		GetCacheUserInfo()
	End Sub

	Public Sub ActiveOnline()
		If DateDiff("s",UserSession.documentElement.selectSingleNode("userinfo/@activetime").text,Now()) < 120 And CLng(UserSession.documentElement.selectSingleNode("userinfo/@classid").text) = classid And Not InStr(ScriptName,"showerr")>0 Then Exit Sub
		UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=Now()
		Dim Rs,SQL,delflag,DelNum
		Dim StatUserID
		Dim strReferer,Thestats,theurl

		theurl=CheckBadstr(URL)
		strReferer=RemoveHtml(Referer)
		If Len(strReferer) < 2 Then
			strReferer = "★直接输入或书签导入★"
		Else
			strReferer = CheckBadstr(Left(strReferer,255))
		End If
		'Thestats="http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("HTTP_X_REWRITE_URL")
		Thestats=CheckBadstr(Stats)
		delflag=False
		If UserID = 0 Then
			If IsSearch Then Exit Sub
			StatUserID = UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text
			SQL = "SELECT id,userid,classid FROM [NC_Ask_Online] WHERE id=" & Ccur(StatUserID)
			Set Rs = Execute(SQL)
			If Rs.EOF And Rs.BOF Then
				SQL = "INSERT Into [NC_Ask_Online](id,userid,username,usertitle,stats,url,fromsite,ip,actforip,browser,classid,accesstime,activetime) Values (" & StatUserID & ",0,'客人','客人','" & Thestats & "','" & theurl & "','" & strReferer & "','" & UserTrueIP & "','"& checkstr(actforip)&"','" & platform&"|"&Browsers&" "&Versions & "'," & classid & "," & NowString & "," & NowString & ")"
				ReloadSetupCache AskedOnline+1,12
			Else
				SQL = "UPDATE [NC_Ask_Online] SET userid=0,username='客人',usertitle='客人',stats='" & Thestats & "',url='" & theurl & "',activetime=" & NowString & ",classid=" & classid & " WHERE id=" & Ccur(StatUserID)
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		Else
			StatUserID = Session.SessionID
			SQL = "SELECT id,userid,classid FROM [NC_Ask_Online] WHERE userid=" & UserID
			Set Rs = Execute(SQL)
			If Rs.EOF And Rs.BOF Then
				SQL = "INSERT Into [NC_Ask_Online](id,userid,username,usertitle,stats,url,fromsite,ip,actforip,browser,classid,accesstime,activetime) Values (" & StatUserID & "," & UserID & ",'" & UserName & "','" & UserTitle & "','" & Thestats & "','" & theurl & "','" & strReferer & "','" & UserTrueIP & "','"& checkstr(actforip)&"','" & platform&"|"&Browsers&" "&Versions & "'," & classid & "," & NowString & "," & NowString & ")"
				ReloadSetupCache AskedOnline+1,12
			Else
				SQL = "UPDATE [NC_Ask_Online] SET userid="& UserID &",username='" & UserName & "',usertitle='" & UserTitle & "',stats='" & Thestats & "',url='" & theurl & "',activetime=" & NowString & ",classid=" & classid & " WHERE userid=" & UserID
			End If
			Rs.Close
			Set Rs = Nothing
			Execute(SQL)
		End If
		Reloadtime=60
		Name="AskedOnline"
		If ObjIsEmpty() Then ReflashOnline
		Reloadtime=600
		Name="delOnline_time"
		If ObjIsEmpty() Then
			delflag=True:Value=Now()
		Else
			If DateDiff("s",Value,Now()) > 450 Then delflag=True
		End If
		If delflag Then
			Value=Now()
			If IsSqlDataBase = 1 Then
				SQL = "DELETE FROM [NC_Ask_Online] WHERE Datediff(Mi, activetime, " & NowString & ") > 45"
			Else
				SQL = "DELETE FROM [NC_Ask_Online] WHERE Datediff('s', activetime, " & NowString & ") > 45*60"
			End If
			Conn.Execute SQL,DelNum
			If DelNum>0 Then
				ReloadSetupCache AskedOnline-DelNum,12
			End If
		End If
	End Sub
	Public Sub ReflashOnline()
		Dim Rs
		Name="AskedOnline"
		Set Rs=Execute("SELECT Count(*) FROM NC_Ask_Online")
		Value=Rs(0)
		AskedOnline=CLng(Value)
		Rs.close()
		Set Rs=Nothing
		Execute("UPDATE [NC_Ask_Setup] SET AskedOnline="&AskedOnline)
		ReloadSetupCache AskedOnline,12
	End Sub

	Public Sub GetCacheUserInfo()
		UserID = CLng(UserSession.documentElement.selectSingleNode("userinfo/@userid").text)
		UserName = CheckBadstr(UserSession.documentElement.selectSingleNode("userinfo/@username").text)
		UserPoint = CLng(UserSession.documentElement.selectSingleNode("userinfo/@points").text)
		UserClass = CLng(UserSession.documentElement.selectSingleNode("userinfo/@userclass").text)
	End Sub
	Public Function ChkRefresh()
		Dim RefreshTime
		RefreshTime = 20   '防止刷新时间,单位（秒）
		If (Not IsEmpty(Session("RefreshTime"))) And RefreshTime > 0 Then
			If DateDiff("s", Session("RefreshTime"), Now()) < RefreshTime Then
				ChkRefresh = True
				Exit Function
			Else
				Session("RefreshTime") = Now()
			End If
		Else
			Session("RefreshTime") = Now()
		End If
		ChkRefresh = False
	End Function
	'取得带端口的URL
	Property Get Get_ScriptNameUrl()
		If Request.Servervariables("SERVER_PORT")="80" Then
			Get_ScriptNameUrl="http://" & Request.Servervariables("SERVER_NAME")&Replace(Lcase(Request.Servervariables("SCRIPT_NAME")),ScriptName,"")
		Else
			Get_ScriptNameUrl="http://" & Request.Servervariables("SERVER_NAME")&":"&Request.Servervariables("SERVER_PORT")&Replace(Lcase(Request.Servervariables("SCRIPT_NAME")),ScriptName,"")
		End If
	End Property
	Public Function GetBrowser()
		Dim Agent,XSLTemplate,proc
		Set Agent=Application(CacheName&"_asked_lockip").cloneNode(True)
		Agent.documentElement.attributes.setNamedItem(Agent.createNode(2,"ip","")).text=UserTrueIP
		Agent.documentElement.attributes.setNamedItem(Agent.createNode(2,"actforip","")).text=actforip
		Agent.documentElement.appendChild(Agent.createTextNode(Request.ServerVariables("HTTP_USER_AGENT")))
		Set XSLTemplate=Application(CacheName & "_getbrowser")
		Set proc = XSLTemplate.createProcessor()
		proc.input = Agent
		proc.transform()
		Set Agent=Nothing
		Set GetBrowser=NewAsp.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		GetBrowser.loadxml proc.output
	End Function
	'是否真正的搜索引擎
	Public Function IsWebSearch()
		IsWebSearch = False
		Dim Botlist,i
		BotList = "Google,Isaac,SurveyBot,Baiduspider,yahoo,yisou,3721,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
		Botlist = Split(Botlist,",")
		For i = 0 To Ubound(Botlist)
			If InStr(Lcase(Request.ServerVariables("HTTP_USER_AGENT")),Lcase(Botlist(i))) > 0 Then
				IsWebSearch = True
				Exit For
			End If
		Next
	End Function
	'================================================
	'函数名：FormatDate
	'作  用：格式化日期
	'参  数：DateAndTime   ----原日期和时间
	'        para   ----日期格式
	'返回值：格式化后的日期
	'================================================
	Public Function FormatDate(DateAndTime, para)
		On Error Resume Next
		Dim y, m, d, h, mi, s, strDateTime
		FormatDate = DateAndTime
		If Not IsNumeric(para) Then Exit Function
		If Not IsDate(DateAndTime) Then Exit Function
		y = CStr(Year(DateAndTime))
		m = CStr(Month(DateAndTime))
		If Len(m) = 1 Then m = "0" & m
		d = CStr(Day(DateAndTime))
		If Len(d) = 1 Then d = "0" & d
		h = CStr(Hour(DateAndTime))
		If Len(h) = 1 Then h = "0" & h
		mi = CStr(Minute(DateAndTime))
		If Len(mi) = 1 Then mi = "0" & mi
		s = CStr(Second(DateAndTime))
		If Len(s) = 1 Then s = "0" & s
		Select Case para
		Case "1":strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
		Case "2":strDateTime = y & "-" & m & "-" & d
		Case "3":strDateTime = y & "/" & m & "/" & d
		Case "4":strDateTime = y & "年" & m & "月" & d & "日"
		Case "5":strDateTime = m & "-" & d
		Case "6":strDateTime = m & "/" & d
		Case "7":strDateTime = m & "月" & d & "日"
		Case "8":strDateTime = y & "年" & m & "月"
		Case "9":strDateTime = y & "-" & m
		Case "10":strDateTime = y & "/" & m
		Case Else
			strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
			If CInt(h) > 12 Then
				strDateTime = strDateTime & " PM"
			Else
				strDateTime = strDateTime & " AM"
			End If
		End Select
		FormatDate = strDateTime
	End Function
	Public Function ChkBadWords(str)
		If IsNull(str) Then Exit Function
		Dim i,m_arrBadword,m_strlen
		m_arrBadword = Split(badwords & "","|")
		For i = 0 To UBound(m_arrBadword)
			m_strlen = Len(m_arrBadword(i))
			If InStr(str,m_arrBadword(i)) > 0 And m_strlen > 0 Then
				str = Replace(str,m_arrBadword(i),String(m_strlen, "*"))
			End If
		Next
		ChkBadWords = str
	End Function
	Public Function ChkBadword(ByVal str)
		If IsNull(str) Then Exit Function
		On Error Resume Next
		Dim re:Set re=new RegExp
		re.IgnoreCase=True
		re.Global=True
		re.Pattern="<(.[^>]*)>"
		str=re.Replace(str,"")
		re.Pattern="[^A-Za-z0-9\u4E00-\u9FA5]"
		str=re.Replace(str,"")
		Set re=Nothing
		str=LCase(str)
		Dim i,m_arrBadword,m_strlen
		m_arrBadword = Split(cBadwords & "","|")
		For i = 0 To UBound(m_arrBadword)
			m_strlen = Len(m_arrBadword(i))
			If InStr(str,LCase(m_arrBadword(i))) > 0 And m_strlen > 0 Then
				ChkBadword = False
				Exit Function
			End If
		Next
		ChkBadword = True
	End Function
	Public Function HTMLEncode(str)
		If Not IsNull(str) Then
			str = Replace(str, ">", "&gt;")
			str = Replace(str, "<", "&lt;")
			str = Replace(str, Chr(32), " ")
			str = Replace(str, Chr(9), " ")
			str = Replace(str, Chr(34), "&quot;")
			str = Replace(str, Chr(39), "&#39;")
			str = Replace(str, Chr(13), "")
			'str = Replace(str, Chr(10) & Chr(10), "</p><p> ")
			str = Replace(str, Chr(10), "<br/> ")
			HTMLEncode = str
		Else
			HTMLEncode = ""
		End If
	End Function
	Public Function ChkPost()
		Dim server_v1,server_v2
		Chkpost=False
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True
	End Function
	Public Sub ChcekProxy(IsProxy)
		If ChkBoolean(IsProxy) Then
			If actforip <> "" Then
				CloseConn
				Response.Status = "302 Object Moved"
				Response.End
			End If
		End If
	End Sub
	'--检查验证码是否正确
	Public Function CodeIsTrue()
		Dim CodeStr
		CodeStr=Lcase(Trim(Request.Form("verifycode")))
		If CStr(Session("verifycode"))=CStr(CodeStr) And CodeStr<>""  Then
			CodeIsTrue=True
			Session("verifycode")=empty
		Else
			CodeIsTrue=False
			Session("verifycode")=empty
		End If
	End Function
	'--系统分配随机密码
	Public Function Createpass()
		Dim Ran,i,LengthNum
		LengthNum=16
		Createpass=""
		For i=1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			If Ran = 0 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& UCase(Chr(Ran))
			ElseIf Ran = 1 Then
				Ran = CInt(Rnd * 9)
				Createpass = Createpass & Ran
			ElseIf Ran = 2 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass =Createpass& Chr(Ran)
			End If
		Next
	End Function
	'--生成随机数函数
	Function GetRandomCode(l)
		Randomize
		Dim m_strRandArray,m_intRandlen,m_strRandomize,i
		m_strRandArray = Array(0,1,2,3,4,5,6,7,8,9,"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z")
		m_intRandlen = l '定义随机码的长度
		If m_intRandlen < 5 Then m_intRandlen = 16
		for i = 1 to m_intRandlen
			m_strRandomize = m_strRandomize & m_strRandArray(Int((21*Rnd)))
		next
		GetRandomCode = m_strRandomize
	End Function
	Public Function strLength(ByVal str)
		On Error Resume Next
		If IsNull(str) Then
			strLength = 0
			Exit Function
		End If
		Dim re:Set re=new RegExp
		re.IgnoreCase=True
		re.Global=True
		re.Pattern="[^\x00-\xff]"
		str=re.Replace(str,"aa")
		Set re=Nothing
		strLength=Len(str)
		If Err.Number<>0 Then Err.Clear
	End Function

	Public Function CutStr(ByVal str,ByVal strlen)
		Dim i,l,t,c
		l=len(str)
		strlen=CLng(strlen)
		t=0
		For i=1 To l
			c=Abs(Asc(Mid(str,i,1)))
			If c<1 Then
				t=t+2
			Else
				t=t+1
			End If
			If t>=strlen Then
				cutStr=left(str,i)&"..."
				Exit for
			Else
				cutStr=str
			End If
		Next
		CutStr=Replace(cutStr,Chr(10),"")
	End Function

	Public Function CheckContinuous(ByVal str)
		CheckContinuous = False
		On Error Resume Next
		Dim l:l = 5
		If IsNull(str) Then Exit Function
		If l < 2 Then Exit Function
		Dim re:Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="^(.)(\1{"& l &",})"
		're.Pattern="([^\d\s])(\1{"& l &",})"
		CheckContinuous = re.Test(str)
		Set re=Nothing
	End Function

	Public Function CheckIDlist(ByVal strList)
		On Error Resume Next
		If Not IsNull(strList) And strList<>"" And strList<>"0" Then
			Dim strArray,i,n,m_strID,CHECK_ID
			Dim TempIDlist()
			strArray=Split(strList, ",")
			n=0
			m_strID = ","
			For i=0 To UBound(strArray)
				CHECK_ID = Trim(strArray(i))
				If CHECK_ID<>"" And IsNumeric(CHECK_ID) And CHECK_ID<>"0" Then
					If InStr(m_strID,","& CHECK_ID &",") = 0 Then
						ReDim Preserve TempIDlist(n)
						TempIDlist(n) = CHECK_ID
						n=n+1
					End If
					m_strID = m_strID & CHECK_ID &","
				End If
			Next
			CheckIDlist=Join(TempIDlist, ",")
		Else
			CheckIDlist=""
		End If
	End Function

End Class
%>