<%
'*************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			gotTopic=left(str,i) & "…"
			exit for
		else
			gotTopic=str
		end if
	next
	gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function
'**********************************************
'函数名：GetCount(InfoId,TableName,Teams)
'**********************************************
Function GetCount(InfoId,TableName,Teams)
	If Teams="0" then
		sql="select "&InfoId&" from ["&TableName&"] "
	Else
		sql="select "&InfoId&" from ["&TableName&"] "&Teams&""
	End If
	set rs=server.createobject("adodb.recordset")
	rs.open sql,Conn,1,1
	GetCount=rs.recordcount
	rs.close:set rs=nothing
End Function
'***********************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end function
'***********************************************
'过程名：showpage
'作  用：显示“上一页 下一页”等信息
'参  数：sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
	dim n, i,strTemp,strUrl
	if totalnumber mod maxperpage=0 then
    	n= totalnumber \ maxperpage
  	else
    	n= totalnumber \ maxperpage+1
  	end if
  	strTemp= "<form name='showpages' method='Post' action='" & sfilename & "'><table width=""100%"" align='center' height='40'><tr><td align=""center"">"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='?page=1&classid="&classid&"'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='?page=" & (CurrentPage-1) & "&classid="&classid&"'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='?page=" & (CurrentPage+1) & "&classid="&classid&"'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='?page=" & n & "&classid="&classid&"'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange='javascript:submit()'>"   
    	for i = 1 to n   
    		strTemp=strTemp & "<option value='" & i & "'"
			if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
			strTemp=strTemp & ">第" & i & "页</option>"   
	    next
		strTemp=strTemp & "</select>"
	end if
	strTemp=strTemp & "</td></tr></table></form>"
	response.write strTemp
end sub

sub showpages(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit,classid,Title,mkid)
	dim n, i,strTemp,strUrl
	if totalnumber mod maxperpage=0 then
    	n= totalnumber \ maxperpage
  	else
    	n= totalnumber \ maxperpage+1
  	end if
  	strTemp= "<form name='showpages' method='Post' action='" & sfilename & "'><table width=""100%"" align='center' height='40'><tr><td align=""center"">"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='?page=1&classid="&classid&"&mkid="&mkid&"'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='?page=" & (CurrentPage-1) & "&classid="&classid&"&Title="&Title&"&mkid="&mkid&"'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='?page=" & (CurrentPage+1) & "&classid="&classid&"&Title="&Title&"&mkid="&mkid&"'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='?page=" & n & "&classid="&classid&"&mkid="&mkid&"'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange=""window.location.href('Article_manage.asp?mkid="&mkid&"&Title="&Title&"&classid="&classid&"&page='+this.value)"">"   
    	for i = 1 to n   
    		strTemp=strTemp & "<option value='" & i & "'"
			if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
			strTemp=strTemp & ">第" & i & "页</option>"   
	    next
		strTemp=strTemp & "</select>"
	end if
	strTemp=strTemp & "</td></tr></table></form>"
	response.write strTemp
end sub


sub showpages_mp(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit,Theme,Title,Area)
	dim n, i,strTemp,strUrl
	if totalnumber mod maxperpage=0 then
    	n= totalnumber \ maxperpage
  	else
    	n= totalnumber \ maxperpage+1
  	end if
  	strTemp= "<form name='showpages' method='Post' action='" & sfilename & "'><table width=""100%"" align='center' height='40'><tr><td align=""center"">"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='?page=1&Theme="&Theme&"&Area="&Area&"'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='?page=" & (CurrentPage-1) & "&Theme="&Theme&"&Title="&Title&"&Area="&Area&"'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='?page=" & (CurrentPage+1) & "&Theme="&Theme&"&Title="&Title&"&Area="&Area&"'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='?page=" & n & "&Theme="&Theme&"&Area="&Area&"'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange=""window.location.href='?Area="&Area&"&Title="&Title&"&Theme="&Theme&"&page='+this.value"">"   
    	for i = 1 to n   
    		strTemp=strTemp & "<option value='" & i & "'"
			if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
			strTemp=strTemp & ">第" & i & "页</option>"   
	    next
		strTemp=strTemp & "</select>"
	end if
	strTemp=strTemp & "</td></tr></table></form>"
	response.write strTemp
end sub
%>
<%
'********************************************
'函数名：checkurl
'作  用：检查合法性
'********************************************
  
'********************************************
'函数名：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
	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

'***************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'       False ----没有安装
'***************************************************
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
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
        dim 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
Function Unknown()
%>

<%End Function

'****************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'****************************************************
sub WriteErrMsg()
	dim strErr
	strErr=strErr & "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd""><html xmlns=""http://www.w3.org/1999/xhtml""><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strErr=strErr & "<link href='css/adminstyle.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
	strErr=strErr & "<div class=""container"">" & vbcrlf
	strErr=strErr & "<div class=""local""><h3>您现在的位置：<a href='admin_Index_Main.asp'>管理首页</a> >> 错误信息</h3></div>" & vbcrlf
	strErr=strErr & "<table width=""100%"" border=""0"" cellpadding=""10"" cellspacing=""0"" class=""border"" style=""margin-top:10px;""><tr><td><div class=""page_content"">"
	strErr=strErr & "<div class='r_title'><h3><img src='images/xiao.jpg' /> 错误信息</h3></div>" & vbcrlf
	strErr=strErr & "<div class='WriteErrMsg'>" & vbcrlf
	strErr=strErr & "<h3>产生错误的可能原因：</h3>" & errmsg &"<li><li>其它未知错误，请确定程序是否正常注册，或者咨询相关技术人员！</li>" & vbcrlf
	strErr=strErr & " <li><a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a></li>" & vbcrlf
	strErr=strErr & "</div>" & vbcrlf
	strErr=strErr & "</div></td></tr></table></div></body></html>" & vbcrlf
	response.write strErr
end sub

'****************************************************
'过程名：WriteSuccessMsg
'作  用：显示成功提示信息
'参  数：无
'****************************************************
sub WriteSuccessMsg(SuccessMsg)
	dim strSuccess
	strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strSuccess=strSuccess & "<link href='inc/Admin_Style.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
	strSuccess=strSuccess & "<table cellpadding=0 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center'><td height='20' class='title'><strong>恭喜你！</strong></td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr><td height='100' class='tdbg' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center'><td class='title'><a href='javascript:history.back()'>【返 回】</a></td></tr>" & vbcrlf
	strSuccess=strSuccess & "</table>" & vbcrlf
	strSuccess=strSuccess & "</body></html>" & vbcrlf
	response.write strSuccess
end sub
Function UnExist(FolderName) 
set fso=Server.CreateObject ("Scripting.FileSystemObject")  
if fso.FileExists(server.MapPath (FolderName)) then 
	UnExist=True
else 
	UnExist=False 
end if
set fso=nothing
End Function
function HTMLEncode(fString)
fString = replace(fString,">",">")
fString = replace(fString,"<","<")
fString = Replace(fString,CHR(32)," ")
fString = Replace(fString,CHR(13),"")
fString = Replace(fString,CHR(10) & CHR(10),"<br>")
fString = Replace(fString,CHR(10),"<br>")
HTMLEncode = fString
end function

function ReHTMLEncode(fString)
fString = replace(fString,">",">")
fString = replace(fString,"<","<")
fString = Replace(fString," ",CHR(32))
fString = Replace(fString,"",CHR(13))
'fString = Replace(fString,"<br>",CHR(10) & CHR(10))
fString = Replace(fString,"<br>",CHR(10))
ReHTMLEncode = fString
end function


function SelectStyle(style)
select case style
case 1
StrTitle="单页"
case 2
StrTitle="资讯"
case 3
StrTitle="产品"
case 4
StrTitle="图文"
case 5
StrTitle="下载"
case else
StrTitle="其它"
end select
SelectStyle=StrTitle
end function

function SelectMkid(mkid)
set rs=server.createobject("adodb.recordset")
sql="select * from Dream_Class where Dream_ModularID="&mkid
rs.open sql,conn,1,3
StrStyle=rs("Dream_Style")
rs.close
set rs=nothing
SelectStyle=StrStyle
end function


Function ClearHtml(Content,style)
Content=Zxj_ReplaceHtml("</?p[^>]*>","",Content)
Content=Zxj_ReplaceHtml("&#[^>]*;", "", Content) 
Content=Zxj_ReplaceHtml("</?marquee[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?object[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?param[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?embed[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?table[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml(" ","",Content)
Content=Zxj_ReplaceHtml("　","",Content)
Content=Zxj_ReplaceHtml("	","",Content)
Content=Zxj_ReplaceHtml("&nbsp;","",Content)
Content=Zxj_ReplaceHtml("</?tr[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?st1[^>]*>", "", Content)
Content=Zxj_ReplaceHtml("</?th[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?a[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?img[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?tbody[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?li[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?span[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?div[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?th[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?td[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?script[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("(javascript|jscript|vbscript|vbs):", "", Content) 
Content=Zxj_ReplaceHtml("on(mouse|exit|error|click|key)", "", Content) 
Content=Zxj_ReplaceHtml("<\\?xml[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("<\/?[a-z]+:[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?font[^>]*>", "", Content) 
Content=Zxj_ReplaceHtml("</?b[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?u[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?i[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?h[^>]*>","",Content) 
Content=Zxj_ReplaceHtml("</?strong[^>]*>","",Content) 
ClearHtml=Content 
End Function 

Function Zxj_ReplaceHtml(patrn, strng,content) 
IF IsNull(content) Then 
content="" 
End IF 
Set regEx = New RegExp ' 建立正则表达式。 
regEx.Pattern = patrn ' 设置模式。 
regEx.IgnoreCase = true ' 设置忽略字符大小写。 
regEx.Global = True ' 设置全局可用性。 
Zxj_ReplaceHtml=regEx.Replace(content,strng) ' 执行正则匹配 
End Function
%>

