ixs_char.asp

不错的一个网站哦, 不错的一个网站哦

			HTMLencode = ""
		Else
			Str = Replace(Str, ">", ">")
			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
%>