<%
'=========================================================
' 文件：iXs_Char.asp
' 版本：爱雪儿图文管理系统 PAMS Ver 1.0.0
' 全称：iXuEr Photo & Article Management System Version 1.0.0
' 时间：2005-06-20
' 作者：Guidy
' 版权：iXuEr Studio
'=========================================================
' CopyRight (C) 2005-2008 114XP.CN All Rights Reserved.
' 官方网站：http://www.114xp.cn/
' 技术论坛：http://bbs.114xp.cn/
' 电子信箱：guidy@qq.com
'=========================================================
' 爱雪儿图文管理系统核心类
'=========================================================
Class iXuEr_Core
	' 系统缓存信息
	Public Sys_Info, AcInfo, SpecialInfo, Affiche, GroupSetting, FriendSiteInfo
	' 系统模板变量
	Public Main_Style, Page_Style, PageTitle, Style_Type, Where
	' 客户端环境
	Public TimeZone, User_Agent, SystemSN
	' 用户缓存信息
	Public UserID, UserInfo, UserBrowser, UserSetting, UserName, PassWord, RndNum, LoginTime, LoginType, CooEntType, CooPath, UserCooErr
	' 管理员缓存信息
	Public Master, MasterInfo, MasterSetting
	' HTML代码过滤
	Public AllowHTML, DeCode, ReqStrLen, ReqNumLen
	' 获取文件名称
	Public ScriptName, Referer
	' Sql查询次数统计
	Public Sql_Use
	' 需要检测的组件的对象名称
	Public TheTestObj(26, 1)
	' 公用循环变量
	Private i
	' 系统缓存信息
	Public ReloadTime, CacheNameFlag, CacheName, LocalCacheName, CacheData, CachePowered
	' ============================================
	' 类模块初始化
	' ============================================
	Private Sub Class_Initialize()
		If Not Response.IsClientConnected Then Response.End
		Dim TmpStr
		
		TmpStr = Split(Request.ServerVariables("PATH_INFO"), "/")
		ScriptName = LCase(TmpStr(UBound(TmpStr)))
		PageTitle = ""
		Sql_Use = 0
		LoginType = 0
		CooEntType = 0
		UserCooErr = 0
		
		' 初始化缓存参数
		ReloadTime = 2880	' 默认缓存生存周期，单位：分钟
		CacheNameFlag = "iXuEr-PAMS"
		CacheName = Replace(Replace(Replace(UCase(Server.MapPath("Index.asp")), UCase("Index.asp"), ""), ":", ""), "\", "") & "_" & CacheNameFlag	' 默认缓存主名称
		CachePowered = "Powered By iXuEr Cache Server" ' 缓存创建信息，用以区别是否本系统创建的缓存，同一空间存在多个相同系统的时候推荐不要使用相同的值
		SystemSN = Replace(Replace(CacheName, "-", ""), "_", "")
		
		' 转入页面，用于操作之后返回
		If Session(CacheName & "Referer") <> "" And (Not IsNull(Session(CacheName & "Referer"))) Then Referer = Session(CacheName & "Referer")
		
		Call LoadSetup() ' 加载常规缓存
		AllowHTML = False ' 所有表单数据不兼容HTML 默认
		DeCode = Sys_Info(97) ' 在此之前必须先运行常规缓存
		ReqStrLen = Sys_Info(89) ' 还需要设置字符串读取的长度
		ReqNumLen = Sys_Info(67) ' 允许获取数字型变量的最大长度
		CooPath = Replace(Sys_Info(0), LCase("http://" & Request.ServerVariables("HTTP_HOST")), "")
		
		TimeZone = Session(CacheName & "iXs_TimeZone")
		If TimeZone = "" Or IsNull(TimeZone) Then
			TimeZone = ReqNum("iXs_TimeZone")
			If TimeZone = "" Then TimeZone = Sys_Info(31) ' 如果没有指定时区，则默认是当前系统时区
		End If
		If ReqNum("iXs_TimeZone") <> "" Then
			TimeZone = ReqNum("iXs_TimeZone") ' 如果指定了时区则设置自定义
			Session(CacheName & "iXs_TimeZone") = TimeZone
			Call Redirect("Help.asp", 0)
		End If
		Session(CacheName & "iXs_TimeZone") = TimeZone
		' 获取用户Cookies验证错误代码，没有错误返回0
		UserCooErr = Session(CacheName & "UserCooErr")
	End Sub
	' ============================================
	' 根据用户指派并设定缓存
	' ============================================
	Private Sub SetCache(SetName, NewValue)
		Application.Lock
		Application(SetName) = NewValue
		Application.UnLock
	End Sub 
	' ============================================
	' 根据用户指派清空某个缓存
	' ============================================
	Private Sub MakeEmpty(SetName)
		Application.Lock
		Application(SetName) = Empty
		Application.UnLock
	End Sub 
	' ============================================
	' 根据用户指派设定一个指定名称的缓存
	' ============================================
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
	End Property
	' ============================================
	' 根据用户指派设定指定缓存的数值
	' ============================================
	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName <> "" Then
			CacheData = Application(CacheName & "_" & LocalCacheName)
			If IsArray(CacheData)  Then
				CacheData(0) = vNewValue
				CacheData(1) = Now()
				CacheData(2) = CachePowered
			Else
				ReDim CacheData(2)
				CacheData(0) = vNewValue
				CacheData(1) = Now()
				CacheData(2) = CachePowered
			End If
			Call SetCache(CacheName & "_" & LocalCacheName, CacheData)
		Else
			' 输出自定义错误				错误标题				错误信息
			Err.Raise vbObjectError + 1, "iXuEr_CacheServer", " Please Change The CacheName."
		End If
	End Property
	' ============================================
	' 根据用户指派读取缓存数值
	' ============================================
	Public Property Get Value()
		If LocalCacheName <> "" Then 
			CacheData = Application(CacheName & "_" & LocalCacheName)	
			If IsArray(CacheData) Then
				Value = CacheData(0)
			Else
				Err.Raise vbObjectError + 1, "iXuEr_CacheServer" , " The CacheData(" & LocalCacheName & ") Is Empty."
				'Value = ""
			End If
		Else
			Err.Raise vbObjectError + 1, "iXuEr_CacheServer", " Please Change The CacheName."
		End If
	End Property
	' ============================================
	' 判断当前缓存是否过期
	' ============================================
	Public Function ObjIsEmpty()
		ObjIsEmpty = True
		CacheData = Application(CacheName & "_" & LocalCacheName)
		If Not IsArray(CacheData) Then Exit Function
		If Not IsDate(CacheData(1)) Then Exit Function
		If DateDiff("n", CDate(CacheData(1)), Now()) < ReloadTime Then ObjIsEmpty = False
	End Function
	' ============================================
	' 删除缓存
	' ============================================
	Public Sub DelCache(MyCaheName, DelType)
		'Response.Write(MyCaheName & "<br>")
		If DelType = 1 Then
			' 根据用户指派清除某个缓存的数值，但不删除该缓存
			MakeEmpty(CacheName & "_" & MyCaheName)
		ElseIf DelType = 0 Then
			' 根据用户指派删除该缓存
			Application.Contents.Remove(CacheName & "_" & MyCaheName)
		End If
	End Sub
	' ============================================
	' 删除所有缓存对象
	' ============================================
	Public Sub DelAll()
		Application.Contents.RemoveAll()
	End Sub
	' ============================================
	' 检测缓存数量
	' ============================================
	Public Function Cache_Use()
		Dim App, Item, Temp, i
		i = 0
		Set App = Application.Contents
		On Error Resume Next
		For Each Item In App
			Temp = App(Item)
			If CStr(Left(Item, Len(CacheName) + 1)) = CacheName & "_" And IsArray(Temp) Then ' 缓存变量应该是数组
				If Ubound(Temp) = 2 Then ' 缓存数组的最大下标为2
					' 缓存数组的第二个元素是时间，第三个元素是创建信息
					If IsDate(Temp(1)) And CStr(Temp(2)) = CStr(CachePowered) Then i = i + 1
				End If
			End If
		Next
		Cache_Use = i
	End Function
	' ============================================
	' 类模块执行完毕
	' ============================================
	Private Sub Class_Terminate
		If IsObject(Conn) Then Call CloseDB()
	End Sub
	' ============================================
	' 检测组件是否被安装（支持）
	' ============================================
	Public Function IsObjInstalled(Obj)
		On Error Resume Next
		Dim xTestObj
		Set xTestObj = Server.CreateObject(TheTestObj(Obj, 0))
		If Err Then
			Err.Clear
			IsObjInstalled = False
		Else
			IsObjInstalled = True
		End If
		Set xTestObj = Nothing
	End Function
	' ============================================
	' 检测组件的版本
	' ============================================
	Public Function GetObjVersion(Obj)
		On Error Resume Next
		Dim xTestObj
		Set xTestObj = Server.CreateObject(TheTestObj(Obj, 0))
		If Err Then
			Err.Clear
			GetObjVersion = ""
		Else
			GetObjVersion = xTestObj.Version
		End If
		Set xTestObj = Nothing
	End Function
	' ============================================
	' 装载要测试的组件对象数组
	' ============================================
	Public Sub LoadTheTestObj()
		' 内建类
		TheTestObj(0, 0) = "MSWC.AdRotator"
			TheTestObj(0, 1) = "MSWC.AdRotator"
		TheTestObj(1, 0) = "MSWC.BrowserType"
			TheTestObj(1, 1) = "MSWC.BrowserType"
		TheTestObj(2, 0) = "MSWC.NextLink"
			TheTestObj(2, 1) = "MSWC.NextLink"
		TheTestObj(3, 0) = "MSWC.Tools"
			TheTestObj(3, 1) = "MSWC.Tools"
		TheTestObj(4, 0) = "MSWC.Status"
			TheTestObj(4, 1) = "MSWC.Status"
		TheTestObj(5, 0) = "MSWC.Counters"
			TheTestObj(5, 1) = "MSWC.Counters"
		TheTestObj(6, 0) = "MSWC.PermissionChecker"
			TheTestObj(6, 1) = "MSWC.PermissionChecker"
		TheTestObj(7, 0) = "WScript.Shell"
			TheTestObj(7, 1) = "WScript.Shell"
		TheTestObj(8, 0) = "Microsoft.XMLHTTP"
			TheTestObj(8, 1) = "Microsoft.XMLHTTP"
		TheTestObj(9, 0) = "Scripting.FileSystemObject"
			TheTestObj(9, 1) = "FSO 文本文件读写"
		TheTestObj(10, 0) = "ADODB.Connection"
			TheTestObj(10, 1) = "ActiveX Data Object [ADO]"
		' 上传类
		TheTestObj(11, 0) = "SoftArtisans.FileUp"
			TheTestObj(11, 1) = "SA-FileUp 文件上传"
		TheTestObj(12, 0) = "SoftArtisans.FileManager"
			TheTestObj(12, 1) = "SoftArtisans 文件管理"
		TheTestObj(13, 0) = "LyfUpload.UploadFile"
			TheTestObj(13, 1) = "刘云峰的文件上传组件"
		TheTestObj(14, 0) = "Persits.Upload"
			TheTestObj(14, 1) = "ASPUpload 文件上传"
		TheTestObj(15, 0) = "w3.upload"
			TheTestObj(15, 1) = "Dimac 文件上传"
		' 邮件类
		TheTestObj(16, 0) = "JMail.SmtpMail"
			TheTestObj(16, 1) = "Dimac JMail 邮件收发</a>"
		TheTestObj(26, 0) = "JMail.Message"
			TheTestObj(26, 1) = "Dimac JMail 4.3/4.4</a>"
		TheTestObj(17, 0) = "CDONTS.NewMail"
			TheTestObj(17, 1) = "虚拟 SMTP 发信"
		TheTestObj(18, 0) = "Persits.MailSender"
			TheTestObj(18, 1) = "ASPemail 发信"
		TheTestObj(19, 0) = "SMTPsvg.Mailer"
			TheTestObj(19, 1) = "ASPmail 发信"
		TheTestObj(20, 0) = "DkQmail.Qmail"
			TheTestObj(20, 1) = "dkQmail 发信"
		TheTestObj(21, 0) = "Geocel.Mailer"
			TheTestObj(21, 1) = "Geocel 发信"
		TheTestObj(22, 0) = "IISmail.Iismail.1"
			TheTestObj(22, 1) = "IISmail 发信"
		TheTestObj(23, 0) = "SmtpMail.SmtpMail.1"
			TheTestObj(23, 1) = "SmtpMail 发信"
		' 图像类
		TheTestObj(24, 0) = "SoftArtisans.ImageGen"
			TheTestObj(24, 1) = "SA 的图像读写组件"
		TheTestObj(25, 0) = "W3Image.Image"
			TheTestObj(25, 1) = "Dimac 的图像读写组件"
	End Sub
	' ============================================
	' 检测网站常规信息并设置缓存
	' ============================================
	Public Sub LoadSetup()
		Name = "iXsTemp_System_Settings"
		' 如果需要更新缓存则去掉这里的单引号
		'Call DelCache("iXsTemp_System_Settings", 0)
		If ObjIsEmpty Then
			Call DelCache("iXsTemp_System_Settings", 0)
			' 关于系统的设置信息暂时使用内核类属性代替，系统完善之后再加入数据库并使用缓存
			Dim System_Settings(140)
			' 网站的访问地址，自动获取，如果在子文件夹，则会自动检测
			System_Settings(0) = "http://" & LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"), Split(Request.ServerVariables("SCRIPT_NAME"), "/")(UBound(Split(Request.ServerVariables("SCRIPT_NAME"), "/"))), ""))
			System_Settings(5) = "Index.asp" ' 首页文件名称
			System_Settings(31) = 8 ' 当前时区
			'-----------------------------------------------------
			' 附件调用限制，多个域名用“,”隔开
			System_Settings(32) = "http://www.xlfw.cn/,http://xlfw.cn/,http://www.psysch.com/,http://psysch.com/,http://www.114xp.cn/,http://pams.114xp.cn/"
			'-----------------------------------------------------
			System_Settings(33) = 419430400 ' 文章系统附件 总大小
			System_Settings(34) = 41943040 ' 文章系统附件 单文件大小 建议单个文件不要超过 4M
			System_Settings(35) = "avi/bmp/doc/gif/jpg/jpeg/wma/wmv/mid/mp3/mpg/mpeg/dat/png/ram/rar/rm/swf/torrent/txt/zip" ' 文章系统附件 文件类型
			System_Settings(36) = "Upload/" ' 文章系统附件 保存路径
			'-----------------------------------------------------
			System_Settings(37) = 409600 ' 友情链接系统附件 总大小
			System_Settings(38) = 409600 ' 友情链接系统附件 单文件大小
			System_Settings(39) = "gif/jpg/jpeg" ' 友情链接系统附件 文件类型
			System_Settings(40) = "Upload/" ' 友情链接系统附件 保存路径
			'-----------------------------------------------------
			System_Settings(41) = "asa|asp|audio|avi|bat|bmp|cmd|code|com|db|dll|doc|exe|fla|ftp|gif|h|hlp|htm|html|inc|info|ini|jpg|js|log|mdb|mid|mp|mp3|pdf|php|pic|png|ppt|ram|rar|real|rm|swf|torrent|txt|wav|wma|wmv|xls|xml|zip" ' 所有存在图标的文件类型
			System_Settings(42) = "jpg|jpeg|gif|bmp|png" ' 图像类文件类型
			System_Settings(43) = "swf" ' 动画文件类型
			System_Settings(44) = "mp3|m3u|wav|wma|wax|asx|asf|mp2|au|aif|aiff|mid|midi|rmi" ' 音频文件类型 全部采用Windows Media Player播放
			System_Settings(45) = "rm|rmvb|ram|ra|mov" ' RealPlayer 文件类型
			System_Settings(46) = "asa|asp|bat|cmd|code|com|db|dll|doc|exe|fla|ftp|h|hlp|htm|html|inc|info|ini|js|log|mdb|pdf|php|pic|ppt|rar|real|torrent|txt|xls|xml|zip" ' 其他文件类型
			System_Settings(47) = "UnKnow.gif" ' 没有图标的文件显示的图标
			'-----------------------------------------------------
			System_Settings(48) = 50 ' 文章系统允许同时上传的最大数目
			System_Settings(49) = 1 ' 友情链接系统允许同时上传的最大数目
			'-----------------------------------------------------
			System_Settings(51) = "mpg|mpeg|mpv|mps|m2v|m1v|mpe|mpa|avi|wmv|wm|wmx|wvx" ' Windows Media 视频文件类型
			System_Settings(52) = "gif/jpg/jpeg/bmp/png" ' 文章系统远程自动获取的文件类型
			'-----------------------------------------------------
			System_Settings(59) = 1 ' 用户自定义头像允许同时上传的最大数目
			System_Settings(60) = 409600 ' 用户自定义头像 总大小
			System_Settings(61) = 409600 ' 用户自定义头像 单文件大小
			System_Settings(62) = "gif/jpg/jpeg" ' 用户自定义头像 文件类型
			System_Settings(63) = "Upload/" ' 用户自定义头像 保存路径
			System_Settings(64) = 90 ' 用户自定义头像 宽度限制
			System_Settings(65) = 180 ' 用户自定义头像 高度限制
			'-----------------------------------------------------
			System_Settings(67) = 8 ' 获取数字型变量时，允许多最大数字位数，例如银行帐号需要19位
			'-----------------------------------------------------
			System_Settings(75) = 1 ' 随机字符串是否包含大写字母 1：是，0：否；下同
			System_Settings(76) = 1 ' 随机字符串是否包含小写字母
			System_Settings(77) = 1 ' 随机字符串是否包含数字
			System_Settings(78) = 0 ' 随机字符串是否包含特殊字符
			System_Settings(79) = 0 ' 随机字符串是否包含自定义字符
			System_Settings(80) = "" ' 随机字符串的自定义字符集
			'-----------------------------------------------------
			System_Settings(89) = 1024 ' 从客户端获取字符串的最大长度 默认1024字节
			'-----------------------------------------------------
			System_Settings(97) = "html|head|title|object|script|frame|data|iframe|meta|link" ' 要过滤的HTML标签 默认，可以根据具体条件进行设置
			'-----------------------------------------------------
			System_Settings(98) = "Upload/" ' 上传目录
			'-----------------------------------------------------
			System_Settings(99) = "' 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32) ' 用户名和密码中不允许出现的字符
			'-----------------------------------------------------
			System_Settings(100) = "中国企业港图文管理系统 Version 1.0.0" ' 系统版本信息
			'-----------------------------------------------------
			
			' 修复网站访问地址，此错误发生在后台更新缓存之后，修复方法就是删除路径最后的管理文件夹
			System_Settings(0) = Replace(LCase(System_Settings(0)), LCase(System_Settings(66)), "")
			Value = System_Settings
		End If
		Sys_Info = Value
	End Sub
	' ============================================
	' 执行SQL命令
	' ============================================
	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase()
		On Error Resume Next
		'Response.Write(Command & "<br>")
		Set Execute = Conn.Execute(Command)
		If Err Then
			If IsDeBug = 0 Then
				Response.Write("刚才执行的查询出现错误,请认真检查您的语句。")
			Else
				Response.Write("查询语句为：" & Command & "<br>")
				Response.Write("错误信息为：" & Err.Description & "<br>")
			End If
			Err.Clear
			Set Execute = Nothing
			Response.End()
		End If
		Sql_Use = Sql_Use + 1
	End Function
	' ============================================
	' 获取 Recordset 对象
	' ============================================
	Public Function GetRs(Command, Num1, Num2)
		On Error Resume Next
		If Not IsObject(Conn) Then ConnectionDatabase()
		Set GetRs = Server.CreateObject("ADODB.Recordset")
		'Response.Write(Command & "<br>")
		GetRs.Open Command, Conn, Num1, Num2
		If Err Then
			If IsDeBug = 0 Then
				Response.Write("创建 Recordset 对象失败,请认真检查您的语句。")
			Else
				Response.Write("查询语句为：" & Command & "<br>")
				Response.Write("错误信息为：" & Err.Description & "<br>")
			End If
			Err.Clear
			Response.End
		End If	
		Sql_Use = Sql_Use + 1
	End Function
	' ============================================
	' 检测获取的字符是否为数字
	' ============================================
	Public Function ReqNum(StrName)
		ReqNum = Trim(Request(StrName))
		If ReqNum <> "" And Not IsNull(ReqNum) Then
			If Not IsNumeric(ReqNum) Then
				Call Alert("参数  " & StrName & "  必须为数字！\n\n请重新输入！", 0, 0)
			End If
		Else
			ReqNum = ""
		End If
		' 限制输入长度！
		If Len(ReqNum) > ReqNumLen Then Call Alert("您需要输入超过 " & ReqNumLen & " 位的数字吗？\n\n请重新输入！", 0, 0)
		ReqNumLen = Sys_Info(67)
	End Function
	' ============================================
	' 检测获取的字符串并过滤 ' 为 ''
	' ============================================
	Public Function ReqStr(StrName)
		Dim Str, i
		For i = 1 To Request(StrName).Count
			Str = Str & Request(StrName)(i)
		Next
		Str = Replace(Trim(Request(StrName)), "'", "''")
		If Str = "" Or IsNull(Str) Then
			Str = ""
		Else
			If AllowHTML = False Then
				' 不允许存在任何HTML标签字串
				If RegExpSearch("<(.[^>]*)>", Str, 0, "HTML") <> "" Then
					Response.Write("<script language=""javascript1.2"">alert(""参数  " & StrName & "  不能包含HTML格式的标签！\n\n正确的格式不应该包含 <***> 格式的字串！\n\n请重新输入！"");self.history.go(-1);</script>")
					Response.End
				End If
			Else
				' 使用正则表达式过滤指定的HTML标签
				Str = RegExpFilter("</?(" & DeCode & ")[^>]*>", Str, 1, "")
				AllowHTML = False
			End If
		End If
		' 限制输入的字符长度
		If Len(Str) > ReqStrLen Then
			Response.Write("<script language=""javascript1.2"">alert(""参数  " & StrName & "  超过了允许的最大长度！\n\n请重新输入！"");self.history.go(-1);</script>")
			Response.End()
		End If
		ReqStrLen = Sys_Info(89)
		ReqStr = Str
	End Function 
	' ============================================
	' 获取随机验证码
	' ============================================
	Public Function GetCode(Col)
		' 如果服务器不支持 Adodb.Stream 组件，则直接输出文本
		Dim Ads
		On Error Resume Next
		Set Ads = Server.CreateObject("Adodb.Stream")
		' 这里不需要执行任何操作，直接关闭对象即可，如果服务器不支持该对象会出错
		Set Ads = Nothing
		If Err Then
			Dim zNum
			Randomize timer()
			zNum = Cint(8999 * Rnd + 1000)
			Session(CacheName & "iXuEr_GetCode") = zNum '设置验证码的会话变量
			GetCode = zNum
		Else
			GetCode = "<img src=""" & MyDbPath & "Get_Rnd_Num.asp?Cor=" & Col & """ width=""40"" height=""10"" hspace=""0"" vspace=""0"" border=""0"" align=""absmiddle"" title=""请将这个图片中显示的数字填入前面框中"">"
		End If
	End Function
	' ============================================
	' 获取真实的IP地址 并整形为15位
	' ============================================
	Public Function ReqIP()
		ReqIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If ReqIP = "" Or IsNull(ReqIP) Then ReqIP = Request.ServerVariables("REMOTE_ADDR")
		ReqIP = Format_Ip(ReqIP)
	End Function
	' ============================================
	' 检测上页是否从本站提交
	' 返回:True, False
	' ============================================
	Public Function IsSelfRefer()
		Dim sHttp_Referer, sServer_Name
		sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
		sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
		If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
			IsSelfRefer = True
		Else
			IsSelfRefer = False
		End If
	End Function
	' ============================================
	' 复制N个字符串Str 
	' ============================================
	Public Function Clone(ByVal Str, n)
		Dim Value
		For i = 1 To n
			Value = Value & Str
		Next
		Clone = Value
	End Function
	' ============================================
	' 删除源字符串Str的前N个字符
	' ============================================
	Public Function TrimStart(ByVal Str, n)
		Dim Value
		Value = Mid(Str, n + 1)
		TrimStart = Value
	End Function
	' ============================================
	' 删除源字符串Str的最后N个字符串
	' ============================================
	Public Function TrimEnd(ByVal Str, n)
		Dim Value
		Value = Left(Str, Len(Str) - n)
		TrimEnd = Value
	End Function
	' ============================================
	' 返回一个字符串在一个数组中的位置
	' ============================================
	Public Function InArray(Str, Arr)
		Dim i
		For i = 0 To UBound(Arr)
			If Arr(i) = Str Then InArray = i : Exit Function
		Next
	End Function
	' ============================================
	' 按照指定的正则表达式替换字符
	' ============================================
	Public Function RegExpFilter(Patrn, Str, sType, ReplaceWith)
		Dim RegEx
		Set RegEx = New RegExp
		If sType = 1 Then
			RegEx.Global = True
		Else
			RegEx.Global = False
		End If
		RegEx.Pattern = Patrn
		RegEx.IgnoreCase = True
		RegExpFilter = RegEx.Replace(Str, ReplaceWith)
	End Function
	' ============================================
	' 按照指定的正则表达式返回字符
	' ============================================
	Public Function RegExpSearch(Patrn, Str, sType, Spacer)
		Dim RegEx, Match, Matches , RetStr, i
		i = 0
		Set RegEx = New RegExp
		RegEx.Pattern = Patrn
		RegEx.IgnoreCase = True
		RegEx.Global = True
		Set Matches = RegEx.Execute(Str)
		For Each Match In Matches
			i = i + 1
			If sType = 0 Then
				RetStr = RetStr & Match.Value
				If i < Matches.Count Then RetStr = RetStr & Spacer
			Else
				RetStr = RetStr & Match.Value
				If i < Matches.Count Then RetStr = RetStr & Spacer
				If sType = i Then Exit For
			End If
		Next
		RegExpSearch = RetStr
	End Function
	' ============================================
	' 将文本中的HTML标记清理掉
	' ============================================
	Public Function RemoveHTML(StrHTML, sType)
		Dim ObjRegExp, Match, Matches
		Set ObjRegExp = New Regexp
		ObjRegExp.IgnoreCase = True
		ObjRegExp.Global = True
		' 取闭合的<>
		ObjRegExp.Pattern = "<.+?>"
		' 进行匹配
		Set Matches = ObjRegExp.Execute(StrHTML)
		' 遍历匹配集合，并替换掉匹配的项目
		For Each Match In Matches
			StrHtml = Replace(StrHTML, Match.Value, "")
		Next
		If sType = 1 And StrHtml = "" Then StrHtml = "……"
		RemoveHTML = StrHTML
		Set ObjRegExp = Nothing
	End Function
	' ============================================
	' 将字符串中的Str中的HTML代码进行过滤 
	' ============================================
	Public Function HTMLencode(Str)
		If Trim(Str) = "" Or IsNull(Str) Then
			HTMLencode = ""
		Else
			Str = Replace(Str, ">", "&gt;")
			Str = Replace(Str, "<", "&lt;")
			Str = Replace(Str, "''", "'")
			Str = Replace(Str, Chr(32), "&nbsp;")
			Str = Replace(Str, Chr(9), "&nbsp;")
			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
		End If
	End Function
	' ============================================
	' 去除Html格式，用于从数据库中取出值填入输入框时
	' 注意：value="?"这边一定要用双引号
	' ============================================
	Public Function inHTML(Str)
		inHTML = ""
		If IsNull(Str) = True Then
			Exit Function
		End If
		Str = Replace(Str, "&", "&amp;")
		Str = Replace(Str, "<", "&lt;")
		Str = Replace(Str, ">", "&gt;")
		Str = Replace(Str, Chr(34), "&quot;")
		inHTML = Str
	End Function
	'=========================================================
	' 生成指定长度的随机字符串 iXuEr Studio 挑战随机字符串
	'=========================================================
	Public Function iXuEr_Rnd_Str(Length)
		Dim S1, S2, S3, S4, Ln
		Dim Seed, SeedAry
		Dim Seed_Str, Seed_Str1, Seed_Str2, Seed_Str3, Seed_Str4, Seed_Strn
		Dim TempStr
		Dim i, m
		
		S1 = Sys_Info(75)
		S2 = Sys_Info(76)
		S3 = Sys_Info(77)
		S4 = Sys_Info(78)
		Ln = Sys_Info(79)
		
		' 自定义字符集合，注意要在每个自定义字符之间加空格！
		Seed_Str1 = "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"
		Seed_Str2 = "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"
		Seed_Str3 = "0 1 2 3 4 5 6 7 8 9"
		Seed_Str4 = "! "" # $ % & ' ( ) * + , - . / : ; < = > ? @ [ \ ] ^ _ ` { | } ~"
		Seed_Strn = Sys_Info(80)
		' 如果所有种子都没有选择，则强制包含大小写子目和数字
		If S1 <> 1 And S2 <> 1 And S3 <> 1 And S4 <> 1 And Ln <> 1 Then S1 = 1 : S2 = 1 : S3 = 1
		Seed = ""
		If S1 = 1 Then Seed = Seed & Seed_Str1
		If S2 = 1 Then Seed = Seed & " " & Seed_Str2
		If S3 = 1 Then Seed = Seed & " " & Seed_Str3
		If S4 = 1 Then Seed = Seed & " " & Seed_Str4
		If Ln = 1 Then Seed = Seed & " " & Seed_Strn
		' 建立种子数组
		SeedAry = Split(Seed," ")
		' 获取种子数组长度
		m = UBound(SeedAry)
		' 初始化随机字符串
		TempStr = ""
		' 下面是逐一获取随机字符
		Do While Len(TempStr) < Abs(Length)
			Randomize Timer()	' 设定随机种子
			TempStr = TempStr & SeedAry(m * Rnd)	' 获取随机字符
		Loop
		iXuEr_Rnd_Str = TempStr
	End Function
	' ============================================
	' 验证邮件地址的合法性
	' ============================================
	Public Function IsValidEmail(Email)
		Dim Names,Name,c
		IsValidEmail = True
		Names = Split(Email, "@")
		If UBound(Names) <> 1 Then
		   IsValidEmail = False
		   Exit Function
		End If
		For Each Name In Names
		   If Len(Name) <= 0 Then
			 IsValidEmail = False
			 Exit Function
		   End If
		   For i = 1 To Len(Name)
			 c = Lcase(Mid(Name, i, 1))
			 If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) Then
			   IsValidEmail = False
			   Exit Function
			 End If
		   Next
		   If Left(Name, 1) = "." or Right(Name, 1) = "." Then
			  IsValidEmail = False
			  Exit Function
		   End If
		Next
		If InStr(Names(1), ".") <= 0 Then
		   IsValidEmail = False
		   Exit Function
		End If
		i = Len(Names(1)) - InStrRev(Names(1), ".")
		If i <> 2 and i <> 3 Then
		   IsValidEmail = False
		   Exit Function
		End If
		If InStr(Email, "..") > 0 Then
		   IsValidEmail = False
		End If
	End Function
	' ============================================
	' 检查IP地址合法性
	' ============================================
	Public Function IsIp(IP)
		IsIp = True
		If IP = "" Then IsIp = False : Exit Function
		Dim Re
		Set Re = New RegExp
		Re.Pattern = "^(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])\.(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])\.(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])\.(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])$"
		Re.IgnoreCase = True
		Re.Global = True
		IsIp = Re.Test(IP)
		Set Re = Nothing
	End Function
	' ============================================
	' 格式化时间(用于显示)
	' ============================================
	Public Function FormatTime(s_Time, n_Flag)
		If IsDate(s_Time) = False Then Exit Function
		Dim y, m, d, h, mi, s, w
		' 增加客户端时区同步功能
		' 全站显示时间时必须调用此方法，否则无法正确显示时区
		s_Time = DateAdd("h", TimeZone - Sys_Info(31), s_Time)
		FormatTime = ""
		y = CStr(Year(s_Time))
		m = CStr(Month(s_Time))
		If Len(m) = 1 Then m = "0" & m
		d = CStr(Day(s_Time))
		If Len(d) = 1 Then d = "0" & d
		h = CStr(Hour(s_Time))
		If Len(h) = 1 Then h = "0" & h
		mi = CStr(Minute(s_Time))
		If Len(mi) = 1 Then mi = "0" & mi
		s = CStr(Second(s_Time))
		If Len(s) = 1 Then s = "0" & s
		
		w = Weekday(s_Time)
		Select Case w
			Case 1 w = "星期日"
			Case 2 w = "星期一"
			Case 3 w = "星期二"
			Case 4 w = "星期三"
			Case 5 w = "星期四"
			Case 6 w = "星期五"
			Case 7 w = "星期六"
		End Select
		
		Select Case n_Flag
			Case 1 ' yyyy-mm-dd hh:mm:ss
				FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
			Case 2 ' yyyy-mm-dd
				FormatTime = y & "-" & m & "-" & d
			Case 3 ' hh:mm:ss
				FormatTime = h & ":" & mi & ":" & s
			Case 4 ' yyyy年mm月dd日
				FormatTime = y & "年" & m & "月" & d & "日"
			Case 5 ' yyyymmddhhmmss
				FormatTime = y & m & d & h & mi & s
			Case 6 ' yyyy年mm月dd日 hh时mm分ss秒
				FormatTime = y & "年" & m & "月" & d & "日" & " " & h & "时" & mi & "分" & s & "秒"
			Case 7 ' mm-dd
				FormatTime = m & "-" & d
			Case 8 ' yyyy年mm月dd日 星期w
				FormatTime = y & "年" & m & "月" & d & "日" & " " & w
		End Select
	End Function
	' ============================================
	' 判断是否安全字符串,在注册登陆等特殊字段中使用
	' ============================================
	Public Function IsSafeStr(Str)
		Dim s_BadStr, n, i
		s_BadStr = Sys_Info(31)
		n = Len(s_BadStr)
		IsSafeStr = True
		If Str = "" Or IsNull(Str) Then
			IsSafeStr = False
			Exit Function
		End If
		For i = 1 To n
			If InStr(Str, Mid(s_BadStr, i, 1)) > 0 Then
				IsSafeStr = False
				Exit Function
			End If
		Next
	End Function
	' ============================================
	' 获取客户端配置
	' ============================================
	Public Function ClientInfo(sType)
		If sType = 0 Then
			If InStr(User_Agent, "Windows 98") Then
				ClientInfo = "Windows 98"
			ElseIf InStr(User_Agent, "Win 9x 4.90") Then
				ClientInfo = "Windows ME"
			ElseIf InStr(User_Agent, "Windows NT 5.0") Then
				ClientInfo = "Windows 2000"
			ElseIf InStr(User_Agent, "Windows NT 5.1") Then
				ClientInfo = "Windows XP"
			ElseIf InStr(User_Agent, "Windows NT 5.2") Then
				ClientInfo = "Windows 2003"
			ElseIf InStr(User_Agent, "Windows NT") Then
				ClientInfo = "Windows NT"
			ElseIf InStr(User_Agent, "unix") Or InStr(User_Agent, "Linux")  Or InStr(User_Agent, "SunOS")  Or InStr(User_Agent, "BSD") Then
				ClientInfo = "Unix & Linux"
			Else
				ClientInfo = "Other"
			End If
		ElseIf sType = 1 Then
			If InStr(User_Agent, "MSIE 6") Then
				ClientInfo = "Microsoft<sup>&reg;</sup> Internet Explorer 6.0"
			ElseIf InStr(User_Agent, "MSIE 5") Then
				ClientInfo = "Microsoft<sup>&reg;</sup> Internet Explorer 5.0"
			ElseIf InStr(User_Agent, "MSIE 4") Then
				ClientInfo = "Microsoft<sup>&reg;</sup> Internet Explorer 4.0"
			ElseIf InStr(User_Agent, "Netscape") Then
				ClientInfo = "Netscape<sup>&reg;</sup>"
			ElseIf InStr(User_Agent, "Opera") Then
				ClientInfo = "Opera<sup>&reg;</sup>"
			Else
				ClientInfo = "Other"
			End If
		End If
	End Function
	' ============================================
	' 格式化IP地址
	' ============================================
	Public Function Format_Ip(ip)
		Dim a, i, Sip
		a = Split(ip, ".")
		If UBound(a) <> 3 Then Format_Ip = 0 : Exit Function
		For i = 0 To 3
			Sip= Sip + CInt(a(i)) * (256^(3-i))
 			Format_Ip = Format_Ip & String(3-Len(a(i)),"0") & a(i) & "."
		Next
		Format_Ip = Left(Format_Ip, 15)
	End Function
	' ============================================
	' 定时地址跳转
	' ============================================
	Public Function Redirect(Url, sTime)
		On Error Resume Next
		If sTime = 0 Then Response.Redirect(Url)
		Response.Write("<script language=""javascript1.2"">window.setTimeout(""location.href='" & Url & "';"", " & sTime & ");</script>")
	End Function
	' ============================================
	' 警告框，提示并做选择性地址转向
	' ============================================
	Public Function Tp(Msg, Urlt, Urlf, sTime)
		Dim Href1, Href2
		If IsNumeric(Urlt) Then
			Href1 = "history.go(-1);"
		Else
			Href1 = "location.href='" & Urlt & "';"
		End If
		If IsNumeric(Urlf) Then
			Href2 = "history.go(-1);"
		Else
			Href2 = "location.href='" & Urlf & "';"
		End If
		Response.Write("<script language=""javascript1.2"">" & _
			"	var tp=window.confirm(""" & Msg & """);" & _
			"	if (tp) {" & _
			"		window.setTimeout(""" & Href1 & """, " & sTime & ");" & _
			"	} else { " & _
			"		window.setTimeout(""" & Href2 & """, " & sTime & ");" & _
			"	}</script>")
		Response.End()
	End Function
	' ============================================
	' 消息框，提示并做地址转向
	' ============================================
	Public Function Alert(Msg, Url, sTime)
		Dim Href
		If IsNumeric(Url) Then
			Href = "history.go(-1);"
		Else
			Href = "location.href='" & Url & "';"
		End If
		Response.Write("<script language=""javascript1.2"">alert(""" & Msg & """);window.setTimeout(""" & Href & """, " & sTime & ");</script>")
		Response.End()
	End Function
End Class
%>