function.asp

新闻发布系统

		.Close()
	End With
	Set Ads=nothing
 end sub
'保存图片到本地结束
'采集分页管理
Function ExportPageInfo(ByRef PageCount,RecordCount,CurrentPage,PageSize,i,LinkFile)
	Dim retval, j, pageNumber, BasePage
	If CurrentPage = "" Then currentpage = 1 else currentpage = cint(CurrentPage)
	retval = "第" & CurrentPage & "页/共" & PageCount & "页 " 
	retval = retval & "本页" & i & "条/共" & RecordCount & "条 "
	If CurrentPage = 1 Then              
		retval = retval & "首页 前页 "             
	Else
		retval = retval & "<a href='" & LinkFile & "page=1'>首页</a> <a href='" & LinkFile & "page=" & cstr(CurrentPage - 1) & "'>前页</a> "
	End If
	If  CurrentPage = PageCount Then             
		retval = retval & "后页 末页"
	Else
		retval = retval & "<a href='" & LinkFile & "page=" & cstr(CurrentPage + 1) & "'>后页</a> <a href='" & LinkFile & "page=" & cstr(PageCount) & "'>末页</a>"
	End if
 	retval = retval & " | "
	BasePage = (CurrentPage \ 10) * 10
	If BasePage > 0 Then retval = retval & " <a href='" & LinkFile & "page=" & (BasePage - 9) & "'><<</a>"
	For j = 1 to 10
		pageNumber = BasePage + j
		If PageNumber > pagecount Then Exit For
		If pageNumber = Cint(CurrentPage) Then
			retval =  retval & " <font color='#FF0000'>" & pageNumber & "</font>"
		Else
			retval =  retval & " <a href='" & LinkFile & "page=" & pageNumber & "'>" & pageNumber & "</a>"
		End If
	Next
	if PageCount < BasePage + 11 then
		retval = retval & " >>"
	else
		If pagecount > BasePage Then retval = retval & " <a href='" & LinkFile & "page=" & (BasePage + 11) & "'>>></a>"
	end if
	ExportPageInfo = retval
End Function	

function cms_picture_show(byval sortid,line_cols,line_coms,is_default_size,width,height,display_title,max_length,currentpage)
' by jaron , 2003-06-16
'分类_是否为默认大小_宽_高_显示标题_标题长度
	Set Rs=Server.CreateObject("ADODB.Recordset")
'	sql = "sp_sitemanager_picture_show " & sortid
	if line_coms=0 then line_coms=1
	if line_cols=0 then line_cols=1
	maxrecords = line_cols*line_coms
	if sortid>0 then
		sql = "SELECT top " & maxrecords & " tblArticles.id,tblArticles.news_title,tblArticles.title_color,tblArticles.images,tblArticles.img_width,tblArticles.img_height,tblArticles.date_time,tblArticles.class_id,tblCategory.PHYSICAL_PATH,tblArticles.news_content FROM tblArticles LEFT OUTER JOIN tblCategory ON tblArticles.class_id = tblCategory.class_id where images<>'' and tblArticles.admincheck=1 and tblArticles.class_id=" & sortid & " order by id desc"
	else
		sql = "SELECT top " & maxrecords & " tblArticles.id,tblArticles.news_title,tblArticles.title_color,tblArticles.images,tblArticles.img_width,tblArticles.img_height,tblArticles.date_time,tblArticles.class_id,tblCategory.PHYSICAL_PATH,tblArticles.news_content FROM tblArticles LEFT OUTER JOIN tblCategory ON tblArticles.class_id = tblCategory.class_id where images<>'' and tblArticles.admincheck=1 order by id desc"
	end if
	if is_default_size=0 then picture_size = "width=" & height & " height=" & height & "" else	picture_size = ""
	table_start = "<table width=""98%"" border=""0"" align=""center"" cellPadding=""0"" cellSpacing=""0"">"
	rs.Open sql,Conn,1,1
	i=0
	TotalPages = rs.PageCount
	rs.PageSize = 5 * line_cols
	rs.AbsolutePage = currentpage
	Do While Not rs.EOF and i<rs.pagesize
		if i mod line_cols = 0 then table_data = table_data & "<tr>"
		LINK_URL = getHTMLFileName(rs(6),rs(0),rs(7),rs(8))
		table_data = table_data & "<td width= height= align=middle title=><a href=" & LINK_URL & "><img border=0 " & picture_size & " src="&rs(3)&"></a><br>"&rs(1)&"</td><td width=5>　</td>"
		'if i mod line_cols then response.Write "</tr>"
		i = i + 1
		rs.movenext
	loop
	rs.close
	set rs=nothing
	table_end = "</tr></table>"
	cms_picture_show = table_start & table_data & table_end
end function
'采集分页管理结束
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= "<table align='center'><tr><td>"
	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='" & strUrl & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</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:window.location='" & strUrl & "page=" & "'+this.options[this.selectedIndex].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>"
	response.write strTemp
end sub

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

'**************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'**************************************************
sub WriteErrMsg()
	dim strErr
	strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
	strErr=strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strErr=strErr & "  <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & errmsg &"</td></tr>" & vbcrlf
	strErr=strErr & "  <tr align='center' class='tdbg'><td><a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a></td></tr>" & vbcrlf
	strErr=strErr & "</table>" & vbcrlf
	strErr=strErr & "</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='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
	strSuccess=strSuccess & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center' class='title'><td height='22'><strong>恭喜你！</strong></td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr class='tdbg'><td height='100' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center' class='tdbg'><td>&nbsp;</td></tr>" & vbcrlf
	strSuccess=strSuccess & "</table>" & vbcrlf
	strSuccess=strSuccess & "</body></html>" & vbcrlf
	response.write strSuccess
end sub

'**************************************************
'函数名：CheckLevel
'作  用：检查用户级别
'参  数：LevelNum-----要检查的级别值
'返回值：级别名称
'**************************************************
function CheckLevel(LevelNum)
	select case LevelNum
	case 1
		CheckLevel="一般会员"
	case 2
		CheckLevel="高级会员"
	case 3
		CheckLevel="认证会员"
	case 4
		CheckLevel="VIP会员"
	case 5
		CheckLevel="系统管理员"
	end select
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 CheckPurview(AllPurviews,strPurview)
	if isNull(AllPurviews) or AllPurviews="" or strPurview="" then
		CheckPurview=False
		exit function
	end if
	CheckPurview=False
	if instr(AllPurviews,",")>0 then
		dim arrPurviews,i
		arrPurviews=split(AllPurviews,",")
		for i=0 to ubound(arrPurviews)
			if trim(arrPurviews(i))=strPurview then
				CheckPurview=True
				exit for
			end if
		next
	else
		if AllPurviews=strPurview then
			CheckPurview=True
		end if
	end if
end function

%>