function.asp

大型豪华网络游戏交易平台!!有喜欢的就的就快哦~~~~~~

<%
Function Templates(File)
	Set TemplateFso = Server.Createobject("Scripting.Filesystemobject")
	If TemplateFso.FileExists(Server.MapPath(File)) Then
		Set Stream = TemplateFso.Opentextfile(Server.Mappath(File),1,False)
			Templates = Stream.Readall()
		Stream.Close
		Set Stream = Nothing
	Else
		Call Info("模板打开发生错误，请与系统管理员联系！",1,"")
	End If
	Set TemplateFso = Nothing
End Function
Function IsExists(FileSpec)
	Set Fso = CreateObject("Scripting.FileSystemObject")
	If (Fso.FileExists(Server.MapPath(FileSpec))) Then
		If Musicto = true then 
			IsExists = False
		Else
			IsExists = True
		End If
	Else
		IsExists = False
	End If
	Set Fso = Nothing
End Function
Function CreateFolder(Fldr)
	On Error Resume Next
	Set Fso = CreateObject("Scripting.FileSystemObject")
	Set F = Fso.CreateFolder(Server.MapPath(Fldr))
		CreateFolder = F.Path
	Set F = Nothing
	Set Fso = Nothing
End Function
Function CreateDir(Folder)
	If IsExists(Folder) = False Then
		GetNewsFold = Split(Folder,"/")
		For I = 0 To Ubound(GetNewsFold)-1
			If I = 0 Then Fldr = GetNewsFold(0) & "/" Else Fldr = Fldr & GetNewsFold(I) & "/"
			Fldrs = Left(Fldr,Len(Fldr)-1)
			If IsExists(Fldrs) = False Then Call CreateFolder(Fldrs)
		Next
	End if
End Function
Function CreateFile(FileName,Countent,Num)
	If Num = 1 Then
		Dir = Split(FileName,"/")
		Catalogue = Dir(0) & "/" & Dir(1) & "/" & Dir(2) & "/" & Dir(3) & "/"
		Set Fso = Server.CreateObject("Scripting.FileSystemObject")
		Set Fsa = Fso.CreateTextFile(Server.Mappath(Catalogue) & "\" & Dir(4),True)
		Fsa.Write(Countent)
		Fsa.Close
		Set Fsa = Nothing
		Set Fso = Nothing
	ElseIf Num = 2 Then
		Set Fso = Server.CreateObject("Scripting.FileSystemObject")
		Set Fsa = Fso.CreateTextFile(Server.Mappath("\") & FileName,True)
		Fsa.Write(Countent)
		Fsa.Close
		Set Fsa = Nothing
		Set Fso = Nothing
	End If
End Function
Function DelFile(FileName)
	Set CebFso = Server.CreateObject("Scripting.FileSystemObject")
	If CebFso.FileExists(Server.MapPath(FileName)) Then CebFso.DeleteFile Server.MapPath(FileName)
	Set CebFso = Nothing
End Function
Function SqlError(Num)
	On Error Resume Next
	ChkData = ChkData & "'|and|select|update|chr|delete|%20from|;|insert|mid|master.|set|chr(37)|""|<|>" '定义非法参数,使用"|"号间隔
	ChkData = ChkData & "|ゴ|ガ|ギ|グ|ゲ|ザ|ジ|ズ|ヅ|デ|ド|ポ|ベ|プ|ビ|パ|ヴ|ボ|ペ|ブ|ピ|バ|ヂ|ダ|ゾ|ゼ" '日文处理
	If Session("iCebLoginUserName") = "" Or Session("iCebLoginUserPass") = "" Then
		Session("iCebLoginUserName") = "whelpu.com"
		Session("iCebLoginUserPass") = "whelpu_pd"
	End If
	If Num = 1 Then
		If Request.QueryString <> "" Then
			ChkData = Split(ChkData,"|")
			For Each Query_Name In Request.QueryString
				For I = 0 To Ubound(ChkData)
					If Instr(LCase(Request.QueryString(Query_Name)),ChkData(i)) <> 0 Then
						Call Info("请不要在参数中加入非法字符！",1,"")
					End If
				Next
			Next
		End if
	ElseIf Num = 2 Then
		If Request.Form <> "" Then
			ChkData = Split(ChkData,"|")
			For Each Query_Name In Request.Form
				For I = 0 To Ubound(ChkData)
					If Instr(LCase(Request.Form(Query_Name)),ChkData(i)) <> 0 Then
						Call Info("请检查您提交的表单数据是否含有非法字符！",1,"")
					End If
				Next
			Next
		End if
	End If
End Function
Function Filters(Str,Gutter)
	If Str = "" Then Exit Function
	On Error Resume Next
	ChkData = Split(Gutter,",")
	For I = 0 To Ubound(ChkData)
		If Instr(LCase(Str),ChkData(i)) <> 0 Then Call Info("请检查您提交的表单数据是否含有不雅词汇(如:sb,傻比,傻B,tmd,TMD,他妈的等)！",1,"")
	Next
End Function
Function IsEn(Str,Asgm,Num)
	If Str = "" Then Exit Function
	If Num = 1 Then
		A = "0123456789"
	ElseIf Num = 2 Then
		A = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
	ElseIf Num = 3 Then
		A = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
	End If
	B = Len(Str)
	For I = 1 To B
		C = Mid(Str,I,1)
		If Instr(A,C) = 0 Then Call Info(Asgm,1,"")
	Next
End Function
Function Info(Str,Num,Url)
	If Num = 1 Then
		Response.Write "<script>javascript:alert('" & Str & "');window.self.location.replace('javascript:history.go(-1)');</script>"
	ElseIf Num = 2 Then
		Response.Write "<script>javascript:alert('" & Str & "');window.self.location.replace('" & Url & "');</script>"
	ElseIf Num = 3 Then
		Response.Write Escape(Str)
	ElseIf Num = 4 Then
		Response.Redirect Url
	End If
	Response.End
End Function
Function HtmlCode(Code,Num)
	HtmlCode = Code
	If Num = 1 Then
		HtmlCode = Replace(HtmlCode, ">", "&gt;")
		HtmlCode = Replace(HtmlCode, "<", "&lt;")
		HtmlCode = Replace(HtmlCode, " ", "&nbsp;")
		HtmlCode = Replace(HtmlCode, Chr(32), "&nbsp;")
		HtmlCode = Replace(HtmlCode, Chr(34), "&quot;")
		HtmlCode = Replace(HtmlCode, Chr(39), "&#39;")
		HtmlCode = Replace(HtmlCode, Chr(13), "")
		HtmlCode = Replace(HtmlCode, Chr(10) & Chr(10), "</P><P>")
		HtmlCode = Replace(HtmlCode, Chr(10), "<BR>")
	ElseIf Num = 2 Then
		HtmlCode = Replace(HtmlCode, "&gt;", ">")
		HtmlCode = Replace(HtmlCode, "&lt;", "<")
		HtmlCode = Replace(HtmlCode, "&nbsp;", " ")
		HtmlCode = Replace(HtmlCode, "&quot;", Chr(34))
		HtmlCode = Replace(HtmlCode, "&#39;", Chr(39))
		HtmlCode = Replace(HtmlCode, "</P><P>", Chr(10) & Chr(10))
		HtmlCode = Replace(HtmlCode, "<BR>", Chr(10))
	ElseIf Num = 3 Then
		HtmlCode = Replace(HtmlCode, " ", "&nbsp;")
		HtmlCode = Replace(HtmlCode, ">", "＞")
		HtmlCode = Replace(HtmlCode, "<", "＜")
		HtmlCode = Replace(HtmlCode, "|", "‖")
		HtmlCode = Replace(HtmlCode, ";", ":")
		HtmlCode = Replace(HtmlCode, Chr(32), "&nbsp;")
		HtmlCode = Replace(HtmlCode, Chr(34), "＂")
		HtmlCode = Replace(HtmlCode, Chr(39), "＇")
		HtmlCode = Replace(HtmlCode, Chr(13), "")
	ElseIf Num = 4 Then
		Set objRegExp = New Regexp
		objRegExp.IgnoreCase = True
		objRegExp.Global = True
		objRegExp.Pattern = "<.+?>"
		HtmlCode = objRegExp.Replace(HtmlCode,"")
		HtmlCode = Replace(HtmlCode, "<","<")
		HtmlCode = Replace(HtmlCode, ">",">")
		HtmlCode = Replace(HtmlCode,"chr(32)","")
		HtmlCode = Trim(HtmlCode)
		Set objRegExp = Nothing
	End If
End Function
Function AdminCls(cId,Num)
	Set Ceb_Rsc = Conn.Execute("Select * From iHelp_Class Where F_ClsNum = " & cId & " Order By F_ClsId")
	Do While Not Ceb_Rsc.Eof
		ClsId = Ceb_Rsc("F_ClsId")
		ClsNum = Ceb_Rsc("F_ClsNum")
		ClsAdminId = Ceb_Rsc("F_ClsAdminId")
		If ClsNum = 0 Then
			Set Ceb_Rss = Server.CreateObject("ADODB.RecordSet")
			Ceb_Rss.Open "Select * From iHelp_Problem Where F_HelpIClsId = " & Ceb_Rsc("F_ClsId"),Conn,1,1
			InfoNum = " <a href='Admin_Info.asp?ClsId=" & Ceb_Rsc("F_ClsId") & "&Solve=&Recommendation=&Uid=' class='cpx12lan1left'>(" & Ceb_Rss.RecordCount & ")</a>"
			Set Ceb_Rss = Nothing
		End If
		Set Ceb_Rscs = Conn.Execute("Select * From iHelp_Class Where F_ClsNum = " & ClsId)
		If Not Ceb_Rscs.Eof Then
			DelNum = 2
			iAles = "请先删除下级类，再执行本操作"
		Else
			DelNum = 1
			iAles = "删除将同时删除该分类的所有相关信息，且不可恢复，确定删除吗？"
		End If
		Set Ceb_Rscs = Nothing
		ClsAdmin = ""
		If ClsAdminId <> "0" Then
			ClsAdminId = Split(ClsAdminId,",")
			For Ii = 0 To UBound(ClsAdminId)
				Set Ceb_Rss = Conn.Execute("Select * From iHelp_User Where F_HelpUserId = " & Clng(ClsAdminId(Ii)))
				if ceb_rss.eof then
				F_HelpUserName="已删除"
				else
				F_HelpUserName = Ceb_Rss("F_HelpUserName")
				end if
				Set Ceb_Rss = Nothing
				ClsAdmin = ClsAdmin & "<a href='User.asp?Uid=" & ClsAdminId(Ii) & "' target='_blank'>" & F_HelpUserName & "</a> "
			Next
		End If
		AdminCls = AdminCls & "<tr><td width=50% colspan='2'><table width='100%'><tr><td width='50%'>&nbsp;<font color=red>" & AdminClsTmp(Num) & Ceb_Rsc("F_ClsName")
		AdminCls = AdminCls & "</font>" & InfoNum
		AdminCls = AdminCls & "&nbsp;&nbsp;<a href='#top' onClick=""openWindow('?Save=Add&Send=" & Ceb_Rsc("F_ClsId") & "','470','350','添加二级分类');return false"">添加二级分类</a>&nbsp;&nbsp;<a href='#top' onClick=""openWindow('?Save=Edit&Send=" & Ceb_Rsc("F_ClsId") & "','470','350','修改分类');return false"" class='cpx12lan1left'>修改</a>&nbsp;&nbsp;<a "
		AdminCls = AdminCls & "href='#top' class='cpx12lan1left' onClick=""ales('" & iAles & "','?"
		AdminCls = AdminCls & "Save=Del&Send=" & Ceb_Rsc("F_ClsId") & "'," & DelNum & ")"">删除</a></td><td align='right'>版主:" & ClsAdmin & "</td></tr></table></td></tr>"
		AdminCls = AdminCls & AdminCls(Ceb_Rsc("F_ClsId"),Num + 1)
	Ceb_Rsc.Movenext
	Loop
	Ceb_Rsc.Close
	Set Ceb_Rsc = Nothing
End Function
Function AdminClsTmp(N)
	For i = 0 To N
		AdminClsTmp = AdminClsTmp & "&nbsp;&nbsp;"
	Next
End Function
Function ChkEmail(Email) 
	ChkEmail = true
	Names = Split(Email, "@")
	If UBound(Names) <> 1 Then
		ChkEmail = false
		Exit Function
	End If
	For Each Name In Names
		If Len(Name) <= 0 Then
			ChkEmail = 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
				ChkEmail = false
				Exit Function
			End If
		Next
		If Left(Name, 1) = "." Or Right(Name, 1) = "." Then
			ChkEmail = false
			Exit Function
		End If
	Next
	If InStr(Names(1), ".") <= 0 Then
		ChkEmail = False
		Exit Function
	End If
	I = Len(Names(1)) - InStrRev(Names(1), ".")
	If I <> 2 And I <> 3 Then
		ChkEmail = false
		Exit Function
	End If
	If InStr(Email, "..") > 0 Then ChkEmail = false
End Function
Function RandomNum(Group)
	Randomize Timer
	RandomNum = Clng(9999*Rnd+Group)
End Function
Function Cut(Txt,Length)
	Txt = Trim(Txt)
	X = Len(Txt)
	Y = 0
	If X >= 1 Then
		For Ii = 1 To X
			If Asc(Mid(Txt,Ii,1)) < 0 Or Asc(Mid(Txt,Ii,1)) > 255 Then
				Y = Y + 2
			Else
				Y = Y + 1
			End If
			If Y >= Length Then
				Txt = Left(Trim(Txt),Ii)
				Exit For
			End If
		Next
		Cut = TxT
	End If
End Function
Function Count(iCeb)
	Txt = Trim(iCeb)
	If Txt = "" Then Exit Function