ixs_char.asp

是一个QQWRY.DAT的ASP利用程序

<%
'=========================================================
' 文件：iXs_Char.asp
' 版本：爱雪儿图文管理系统 PAMS Ver 1.0.0
' 全称：iXuEr Photo & Article Management System Version 1.0.0
' 时间：2004-10-27
' 作者：Guidy
' 版权：iXuEr Studio
'=========================================================
' CopyRight (C) 2005-2008 114XP.CN All Rights Reserved.
' 官方网站：http://www.114xp.cn/
' 技术论坛：http://bbs.114xp.cn/
' 电子信箱：[e-mail]
'=========================================================
' 爱雪儿图文管理系统核心类
'=========================================================
Class iXuEr_Core
	Public Sys_Info
	Public User_Agent
	Public AllowHTML, DeCode, AllowLen
	Private i
	Public ReloadTime, CacheNameFlag, CacheName, LocalCacheName, CacheData, CachePowered
		
	' ============================================
	' 类模块初始化
	' ============================================
	Private Sub Class_Initialize()
		If Not Response.IsClientConnected Then Response.End
		' 初始化缓存参数
		ReloadTime = 14400	' 默认缓存生存周期，单位：分钟
		CacheNameFlag = "iXuEr-PAMS"
		CacheName = Replace(Replace(Replace(UCase(Server.MapPath("Index.asp")), UCase("Index.asp"), ""), ":", ""), "\", "") & "_" & CacheNameFlag	' 默认缓存主名称
		CachePowered = "Powered By iXuEr Cache Server" ' 缓存创建信息，用以区别是否本系统创建的缓存，同一空间存在多个相同系统的时候推荐不要使用相同的值
		
		' 加载常规缓存
		Call LoadSetup() ' 检测并设置常规信息缓存
		AllowHTML = False ' 所有表单数据不兼容HTML 默认
		DeCode = Sys_Info(4) ' 在此之前必须先运行常规缓存
		' 还需要设置字符串读取的长度
		AllowLen = Sys_Info(3)
	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)
		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
	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(9)
			' 网站的访问地址，自动获取，如果在子文件夹，则会自动检测
			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(1) = "爱雪儿IP定位查询系统 Version 3.0.0" ' 标题栏信息
			System_Settings(2) = "net|com|cn|org|cc|tv|info|tw|biz|sh|ws|name|ac|io" ' 可以查询的域名后缀
			System_Settings(3) = 1024 ' 从客户端获取字符串的最大长度 默认1024字节
			'-----------------------------------------------------
			System_Settings(4) = "html|head|title|object|script|frame|data|iframe|meta|link" ' 要过滤的HTML标签 默认，可以根据具体条件进行设置
			System_Settings(5) = True ' 是否要格式化IP地址，是：True；否：False
			System_Settings(6) = True ' 是否支持IP地址批量查询，是：True；否：False
			System_Settings(7) = True ' 是否支持域名批量解析查询，是：True；否：False
			'-----------------------------------------------------
			System_Settings(8) = "http://www.114xp.cn/" ' IP签名图片上链接到地址
			System_Settings(9) = "爱雪儿工作室" ' IP签名图片上的工具提示文字
			Value = System_Settings
		End If
		Sys_Info = Value
	End Sub
	' ============================================
	' 检测获取的字符是否为数字
	' ============================================
	Public Function ReqNum(StrName)
		ReqNum = Trim(Request(StrName))
		If ReqNum <> "" And Not IsNull(ReqNum) Then
			If Not IsNumeric(ReqNum) Then
				Response.Write("<script language=""javascript1.2"">alert(""参数  " & StrName & "  必须为数字！\n\n请重新输入！"");self.history.go(-1);</script>")
				Response.End
			End If
		Else
			ReqNum = ""
		End If
	End Function
	' ============================================
	' 检测获取的字符串并过滤 ' 为 ''
	' ============================================
	Public Function ReqStr(StrName)
		Dim Str, i
		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) > AllowLen Then
			Response.Write("<script language=""javascript1.2"">alert(""参数  " & StrName & "  超过了允许的最大长度！\n\n请重新输入！"");self.history.go(-1);</script>")
			Response.End()
		End If
		AllowLen = Sys_Info(3)
		ReqStr = Str
	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
	' ============================================
	' 按照指定的正则表达式替换字符
	' ============================================
	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
	' ============================================
	' 检查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 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
		If Sys_Info(5) = False Then Format_Ip = ip : 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 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
	' ============================================
	' 利用XML技术来获取网页数据
	' ============================================
	Public Function GetHTTPPage(Url)
		Dim HTTP
		On Error Resume Next
		Set HTTP = Server.CreateObject("Microsoft.XMLHTTP")
		HTTP.Open "GET", Url, False
		HTTP.Send()
		If HTTP.ReadyState <> 4 Then Exit Function
		GetHTTPPage = Bytes2Bstr(HTTP.ResponseBody)
		Set HTTP = Nothing
		If Err.Number <> 0 Then Err.Clear
	End Function
	' ============================================
	' 还原网页数据为文本字符
	' ============================================
	Private Function Bytes2Bstr(vIn)
		Dim StrReturn
		Dim i, ThisCharCode, NextCharCode
		StrReturn = ""
		For i = 1 To LenB(vIn)
			ThisCharCode = AscB(MidB(vIn, i, 1))
			If ThisCharCode < &H80 Then
				StrReturn = StrReturn & Chr(ThisCharCode)
			Else
				NextCharCode = AscB(MidB(vIn,i+1, 1))
				StrReturn = StrReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
				i = i + 1
			End If
		Next
		Bytes2Bstr = StrReturn
	End Function
End Class
%>