titleb.asp

Art2008 CMS是一款具有强大的功能的基于ASP语言的网站管理软件

				ElseIf c=">" Then
					IsCount=True
				Else
					If IsCount=True Then
						'If Abs(Asc(c))>255 Then
						'	iCount=iCount+2
						'Else
							iCount=iCount+1
						'End If
						If iCount>=maxPagesize And i<Len(sContent) Then
							strTemp=Left(sContent,i)
							If CheckPagination(strTemp,"table|a|b>|i>|strong|div|span") then
								Temp_String=Temp_String & Trim(CStr(i)) & "," 
								iCount=0
							End If
						End If
					End If
				End If	
			Next
			If Len(Temp_String)>1 Then Temp_String=Left(Temp_String,Len(Temp_String)-1)
			Temp_Array=Split(Temp_String,",")
			For i = UBound(Temp_Array) To LBound(Temp_Array) Step -1
				ss = Mid(sContent,Temp_Array(i)+1)
				If Len(ss) > 100 Then
					sContent=Left(sContent,Temp_Array(i)) & SplitPageStr & ss
				Else
					sContent=Left(sContent,Temp_Array(i)) & ss
				End If
			Next
		End If
		sContent=Replace(sContent, "<&nbsp;>", "&nbsp;")
		sContent=Replace(sContent, "<&gt;>", "&gt;")
		sContent=Replace(sContent, "<&lt;>", "&lt;")
		sContent=Replace(sContent, "<&quot;>", "&quot;")
		sContent=Replace(sContent, "<&#39;>", "&#39;")
		AutoSplitPage=sContent
	End Function
    '结合以上函数使用
	Private Function CheckPagination(strTemp,strFind)
		Dim i,n,m_ingBeginNum,m_intEndNum
		Dim m_strBegin,m_strEnd,FindArray
		strTemp=LCase(strTemp)
		strFind=LCase(strFind)
		If strTemp<>"" and strFind<>"" then
			FindArray=split(strFind,"|")
			For i = 0 to Ubound(FindArray)
				m_strBegin="<"&FindArray(i)
				m_strEnd  ="</"&FindArray(i)
				n=0
				do while instr(n+1,strTemp,m_strBegin)<>0
					n=instr(n+1,strTemp,m_strBegin)
					m_ingBeginNum=m_ingBeginNum+1
				Loop
				n=0
				do while instr(n+1,strTemp,m_strEnd)<>0
					n=instr(n+1,strTemp,m_strEnd)
					m_intEndNum=m_intEndNum+1
				Loop
				If m_intEndNum=m_ingBeginNum then
					CheckPagination=True
				Else
					CheckPagination=False
					Exit Function
				End If
			Next
		Else
			CheckPagination=False
		End If
	End Function
	
'**************************************************
	'函数名：strLength
	'作  用：求字符串长度。汉字算两个字符，英文算一个字符。
	'参  数：str  ----要求长度的字符串
	'返回值：字符串长度
'**************************************************
Function strLength(Str)
		On Error Resume Next
		Dim WINNT_CHINESE:WINNT_CHINESE = (Len("中国") = 2)
		If WINNT_CHINESE Then
			Dim l, T, c,I
			l = Len(Str)
			T = l
			For I = 1 To l
				c = Asc(Mid(Str, I, 1))
				If c < 0 Then c = c + 65536
				If c > 255 Then
					T = T + 1
				End If
			Next
			strLength = T
		Else
			strLength = Len(Str)
		End If
		If Err.Number <> 0 Then Err.Clear
	End Function
'**************************************************
'管理员用户检测过程
'**************************************************
Sub admin_chk()
Dim adminuser:adminuser=chkhtm(Request.Cookies(Art2008)("adminuser"))
Dim adminpass:adminpass=chkhtm(Request.Cookies(Art2008)("adminpass"))
Dim admindj:admindj=chkhtm(Request.Cookies(Art2008)("admindj"))

if admindj="3" then
Call AdminReadonly()
end if
if adminuser="" or adminpass="" then
  Response.Redirect config("path")&"admin/login.asp?id=8"
end if
Dim AdminChk_sql,AdminChk_rs
AdminChk_sql = "select * from admin where [user]='"&adminuser&"' and [pass]='"&adminpass&"'"
Set AdminChk_rs = Server.CreateObject("ADODB.RecordSet")
AdminChk_rs.Open AdminChk_sql,conn,1,1
if AdminChk_rs.recordcount=0 then
  Response.Cookies(Art2008)("adminuser")=""
  Response.Cookies(Art2008)("adminpass")=""
  Response.Cookies(Art2008)("admindj")=""
  Response.Cookies(Art2008)("OSKEY")=""
  Response.cookies(Art2008)("purview")=""
  
  Response.Redirect config("path")&"admin/login.asp?id=8" 
else
	Response.Cookies(Art2008)("admindj")=AdminChk_rs("dj")
	response.cookies(Art2008)("purview")=AdminChk_rs("purview")
    response.cookies(Art2008)("OSKEY")=AdminChk_rs("OSKEY")

end if
AdminChk_rs.close
set AdminChk_rs=nothing
End Sub
'**************************************************
	'会员系统函数
	'函数名：
	'作  用：
	'参  数：
	'返回值：
'**************************************************
Function ChkNumeric(ByVal CheckID)
			If CheckID <> "" And IsNumeric(CheckID) Then
				CheckID = CLng(CheckID)
				If CheckID < 0 Then CheckID = 0
			Else
				CheckID = 0
			End If
			ChkNumeric = CheckID
		End Function

'**************************************************
'字符过滤函数
'**************************************************
Function DelSql(Str)
			Dim SplitSqlStr,SplitSqlArr,I
			SplitSqlStr="*|and |exec |insert |select |delete |update |count |master |truncate |declare |and	|exec	|insert	|select	|delete	|update	|count	|master	|truncate	|declare	|char(|mid(|chr("
			SplitSqlArr = Split(SplitSqlStr,"|")
			For I=LBound(SplitSqlArr) To Ubound(SplitSqlArr)
				If Instr(LCase(Str),SplitSqlArr(I))<>0 Then
					Call Alert ("系统警告！\n\n1、您提交的数据有恶意字符;\n2、您的数据已经被记录;\n3、操作日期："&Now&";\n		Powered By Art2008 CMS.Com!","")
					Response.End
				End if
			Next
			DelSql = Str
		End Function
'**************************************************
'取得Request.Querystring 或 Request.Form 的值
'**************************************************
		
Function S(Str)
		 S = DelSql(Replace(Replace(Request(Str), "'", ""), """", ""))
		End Function
		
Public Function G(Str)
		 G = Replace(Replace(Request(Str), "'", ""), """", "")
		End Function
'**************************************************
'操作提示
'**************************************************
Function ArtErr(ErrMsg,ErrNum)'操作提示
		Response.Redirect(config("path")&"admin/showerr.asp?action="&ErrNum&"&message=" & Server.URLEncode(ErrMsg) & " ")
		Response.end
	End Function 
	
Function Alert(SuccessStr, Url)'操作提示
		 If Url <> "" Then
		  Response.Write ("<script language=""Javascript""> alert('" & SuccessStr & "');location.href='" & Url & "';</script>")
		 Else
		  Response.Write ("<script language=""Javascript""> alert('" & SuccessStr & "');history.back(-1);</script>")
		 End If
		 response.end
		End Function
'**************************************************
	'函数名：RSQL
	'作  用：过滤非法的SQL字符
	'参  数：strChar-----要过滤的字符
	'返回值：过滤后的字符
'**************************************************
Function RSQL(strChar)
			If strChar = "" Or IsNull(strChar) Then RSQL = "":Exit Function
			Dim strBadChar, arrBadChar, tempChar, I
			'strBadChar = "$,#,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
		    strBadChar = "+,',--,%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
			arrBadChar = Split(strBadChar, ",")
			tempChar = strChar
			For I = 0 To UBound(arrBadChar)
				tempChar = Replace(tempChar, arrBadChar(I), "")
			Next
		    tempChar = Replace(tempChar, "@@", "@")
			RSQL = tempChar
		End Function
'**************************************************
	'函数名：Replace_Text
	'作  用：'过滤SQL非法字符并格式化html代码
	'参  数：sfString-----要过滤的字符
	'返回值：过滤后的字符
'**************************************************		
Function Replace_Text(fString)
			If IsNull(fString) Then
			Replace_Text=""
			Exit Function
			Else
			fString=Trim(fString)
			fString=Replace(fString,">","")
			fString=Replace(fString,"<","")
			fString=Replace(fString,"'","")
			fString=Replace(fString,";","；")
			fString=Replace(fString,"--","—")
			fString=Server.HtmlEncode(fString)
			Replace_Text=fString
			End If	
		End function
'**************************************************
'功能:数据库表查询函数
'参数:Command:表达式
'**************************************************
Function ArtEXE(Command)
		If Not IsObject(Conn) Then OpenConn	
			on error resume next
			Set ArtEXE = Conn.Execute(Command)
			If Err Then
				err.Clear
				Set Conn = Nothing
				Response.Write "<li>查询数据的时候发现错误，请检查您的查询代码是否正确。<br /><li>"
				Response.Write Command
				Response.End
			End If
	 End Function
'********************************************
	'函数名：IsValidEmail
	'作  用：检查Email地址合法性
	'参  数：email ----要检查的Email地址
	'返回值：True  ----Email地址合法
	'       False ----Email地址不合法
'********************************************
Function IsValidEmail(Email)
		Dim names, name, I, c
		IsValidEmail = True
		names = Split(Email, "@")
		If UBound(names) <> 1 Then IsValidEmail = False: Exit Function
		For Each name In names
			If Len(name) <= 0 Then IsValidEmail = False:Exit Function
			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
		   Next
		   If Left(name, 1) = "." Or Right(name, 1) = "." Then IsValidEmail = False:Exit Function
		Next
		If InStr(names(1), ".") <= 0 Then IsValidEmail = False:Exit Function
		I = Len(names(1)) - InStrRev(names(1), ".")
		If I <> 2 And I <> 3 Then IsValidEmail = False:Exit Function
		If InStr(Email, "..") > 0 Then IsValidEmail = False
	End Function
'**************************************************
	'生成指定位数的随机数
'**************************************************
	Public Function MakeRandom(ByVal maxLen)
	  Dim strNewPass,whatsNext, upper, lower, intCounter
	  Randomize
	 For intCounter = 1 To maxLen
	   upper = 57:lower = 48:strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
	 Next
	   MakeRandom = strNewPass
	End Function
'**************************************************
	'函数：FoundInArr
	'作  用：检查一个数组中所有元素是否包含指定字符串
	'参  数：strArr     ----字符串
	'        strToFind    ----要查找的字符串
	'       strSplit    ----数组的分隔符
	'返回值：True,False
'**************************************************
	Function FoundInArr(strArr, strToFind, strSplit)
		Dim arrTemp, i
		FoundInArr = False
		If InStr(strArr, strSplit) > 0 Then
			arrTemp = Split(strArr, strSplit)
			For i = 0 To UBound(arrTemp)
			If LCase(Trim(arrTemp(i))) = LCase(Trim(strToFind)) Then
				FoundInArr = True:Exit For
			End If
			Next
		Else
			If LCase(Trim(strArr)) = LCase(Trim(strToFind)) Then FoundInArr = True
		End If
	End Function
'**************************************************
'检查是否是数字 ，并转换为长整型