xpnews.asp

综合信息管理系统

<%@ Language=VBScript %>
<!--#include file="include/conn.asp"-->
<%
' ############################################################################################################
' ##  调用方法：<SCRIPT src="xpnews.asp?Show=12"></SCRIPT>                        ##
' ##  多个参数的使用：<SCRIPT src="xpnews.asp?Show=10&click=1&today=1"></SCRIPT>  ##
' ############################################################################################################

Dim strConnString, conn, SQL, RS, strDateType
Dim i, strSubject, strTrueSubject, strNews
Dim strShowLen, strMaxLen, strTime, strClick, StrImg, strToday, strBigclassName, strSmallClassName, strSpecial, strPath, strwhat
Dim m_bOverFlow, strTip

' ################################################ 命令行参数及设置初始变量 ############################################################
  strMaxLen = 40							' ### 每条信息最多显示字符(双数)。           参数：Max
  strShowLen = 10							' ### 设定显示条数，范围 5-30 条。           参数：Show
  strDate = 1     							' ### 是否显示日期，0为否,是不用写。         参数：Date  
  strTime = 0     							' ### 是否显示时间，1为是，否不用写。        参数：Time
  strClick = 0  							' ### 是否显示点击数，1为是，否不用写。      参数：Click
  strImg = 0    							' ### 是否显示图文标识，1为是，否不用写。    参数：Img
  strToday = 0  							' ### 是否为今日新闻加NEW，1为是，否不用写。 参数：Today   
  strWhat = "NewsID"						' ### 选择按什么排序：NewsID，Click。        参数：What  
  strBigClassName = "BigClassName"			' ### 显示最闻大类新新，                     参数：BigClassName
  strSmallClassName = "SmallClassName"		' ### 显示最新小类新闻，                     参数：SmallClassName  
  strSpecialID = "SpecialID"        		' ### 显示最新专题新闻，                     参数：SpecialID
  strDateType = "cnymd"						' ### 设置日期显示格式：
                    						' ### cnymd  2001年12月21日
                    						' ### cnmd   12月21日
                    						' ### ymd    2001/12/21
                    						' ### ydm    2001/21/12
                    						' ### mdy    12/21/2001
                    						' ### dmy    21/12/2001																						
                    						' ### md     12/21
                    						' ### dm     21/12																																												
  strPath = "http://" & Request.ServerVariables("SERVER_NAME") & "/xxgl/jygl"                      
											' ### 新闻所在路径，必须含有 "/" 字符，可以是其他服务器上的新闻，参数：Path
											' 如：Path = "http://www.czndzx.com/"
' ########################################################################################################################################

if Request.QueryString("Max") <> "" then
	strMaxLen = Request.QueryString("Max")
end if
if not IsNull(Request.QueryString("Show")) then
	if Request.QueryString("Show") > 5 and Request.QueryString("Show") <= 30 then
		strShowLen = Request.QueryString("Show")
	end if
end if
if Request.QueryString("Date") = "" then
	strDate = 1
	else
	strDate = 0
end if
if Request.QueryString("Time") = "" then
	strTime = 0
	else
	strTime = 1
end if
if Request.QueryString("Click") = "" then
	strClick = 0
	else
	strClick = 1
end if
if Request.QueryString("Img") = "" then
	strImg = 0
	else
	strImg = 1
end if
if Request.QueryString("Today") = "" then
	strToday = 0
	else
	strToday = 1
end if
if Request.QueryString("What") = "click" then
	strWhat = "click"
	else
	strWhat="NewsID"
end if	
if Request.QueryString("DateType") <> "" then
	strDateType = Request.QueryString("DateType")
end if
if Request.QueryString("BigClassName")<>"" then
	strBigClassName = Request.QueryString("BigClassName")
	else
  strBigClassName = ""	
end if
if Request.QueryString("SpecialID") <> "" then
	strSpecialID = Request.QueryString("SpecialID")
	else
	strSpecialID=""
end if
if Request.QueryString("SmallClassName")<>"" then
	strSmallClassName = Request.QueryString("SmallClassName")
	else
	  strSmallClassName = ""
end if
if Request.QueryString("Path") <> "" then
	if Right(Trim(Request.QueryString("Path")),1) = "/" then
		strPath = Request.QueryString("Path")
	end if
end if
if Right(strPath,1)<>"/" then
	strPath = strPath + "/"
end if

SQL = "SELECT top " & strShowLen & " NewsID,Title,UpdateTime,BigClassName,SmallClassName,SpecialID,image,click FROM news"
if strBigClassName<>"" and strSmallClassName="" then
	SQL = SQL & " WHERE BigClassName = '" & strBigClassName &"'"
end if
if strBigClassName<>"" and strSmallClassName<>"" then
	SQL = SQL & " WHERE BigClassName = '" & strBigClassName &"' and  SmallClassName = '" & strSmallClassName &"'"
end if
if strBigClassName="" and strSmallClassName<>"" then
	SQL = SQL & " WHERE SmallClassName = '" & strSmallClassName &"'"
end if
if strBigClassName="" and strSmallClassName="" and strSpecialID<>"" then
	SQL = SQL & " WHERE SpecialID = " & strSpecialID
end if
Set rs = Server.CreateObject("ADODB.Recordset")
SQL = SQL & " ORDER BY " & strWhat & " DESC"
RS.open sql,Conn,1,1

if NOT(RS.EOF or RS.BOF) then
	Do while Not RS.EOF
			strSubject = HTMLDecode(RS("Title"))
			strTrueSubject = GetTrueLength(strSubject, strMaxLen, strSpaceBar)
			m_bOverFlow = CheckOverFlow(strSubject, strMaxLen)
			if m_bOverFlow = True then
				strTip = strSubject
			else
				strTip = ""
			end if
			
			strFaceURL = "<img src=" & strPath & "images/go.gif width=10 height=9>&nbsp;"

			strNews = strFaceURL & "<a href=" & strPath & "ReadNews.asp?NewsID=" & RS("NewsID") & "&BigClassName=" & RS("BigClassName") & "&SmallClassName=" & RS("SmallClassName") & "&SpecialID=" & RS("SpecialID") & " title=""" & strTip & """ target=_blank>" & strTrueSubject & "</a>" 
			
			if strDate=1 then
			  if strTime=1 then
			    strNews = strNews & "(" & ChkDate(RS("updatetime")) & " " & TimeValue(RS("updatetime")) & ")"
			  else
			    strNews = strNews & "(" & ChkDate(RS("updatetime")) & ")"
			  end if
			else
				if strTime=1 then
				strNews = strNews & "(" & TimeValue(RS("updatetime")) & ")"
				end if
			end if			
			if strClick = 1 then
			    strNews = strNews & "[<font color=red>" & RS("Click") & "</font>]"
			end if
			if strImg = 1 and rs("image")>0 then
			    strNews = strNews & " <img src=" & strPath & "images/img.gif height=9>"
			end if
			if strToday = 1 and year(RS("updatetime"))=year(date()) and month(RS("updatetime"))=month(date()) and day(RS("updatetime"))=day(date()) then
			    strNews = strNews & " <img src=" & strPath & "images/new.gif height=9>"
			end if
			strNews = strNews & "<br>"									
			Response.Write ("document.write('" & strNews & "');")
		RS.MoveNext
	Loop
else
	Response.Write ("document.write('还没有新闻或该新闻不存在！');")
End if
	Response.End
RS.close
SET RS = Nothing
conn.close
SET Conn = Nothing

function ChkDate(fDate)
	if fDate = "" or vartype(fDate) = vbNull then
		exit function
	end if

	select case strDateType
		case "cnymd"
			ChkDate =  year(RS("updatetime")) &"年"& Month(RS("UpdateTime"))  &"月"& Day(RS("UpdateTime")) &"日"
		case "cnmd"
			ChkDate =  Month(RS("UpdateTime"))  &"月"& Day(RS("UpdateTime")) &"日"
		case "ymd"
			ChkDate =  DateValue(RS("UpdateTime"))
	    case "ydm"
		    ChkDate =  Year(RS("UpdateTime"))  &"/"& Day(RS("UpdateTime"))&"/"& Month(RS("UpdateTime"))
	    case "dmy"
		    ChkDate =  Day(RS("UpdateTime"))  &"/"& Month(RS("UpdateTime"))&"/"& year(RS("UpdateTime"))
	    case "mdy"
		    ChkDate =  Month(RS("UpdateTime"))  &"/"& Day(RS("UpdateTime"))&"/"& year(RS("UpdateTime"))
	    case "dm"
		    ChkDate =  Day(RS("UpdateTime"))  &"/"& Month(RS("UpdateTime"))									
		case else
			ChkDate =  Month(RS("UpdateTime"))  &"/"& Day(RS("UpdateTime"))   '默认值:md						
	End Select
end function

function CheckOverFlow(strChinese, lenMaxWord)
	'判断字符长度是否溢出
	'strChinese 为被检测字符串,lenMaxWord 为限制的字符长度

	dim i, lenTotal, strWord

	if strChinese = "" or vartype(strChinese) = vbNull or CLng(lenMaxWord) <= 0 then
		CheckOverFlow = False
		exit function
	end if

	lenTotal = 0
	for i=1 to Len(strChinese)
		strWord = mid(strChinese, i, 1)
		if asc(strWord) < 0 or asc(strWord) > 127 then
			lenTotal = lenTotal + 2
		else
			lenTotal = lenTotal + 1
		end if
	next

	'判断字符是否溢出
	if lenTotal > lenMaxWord then
		CheckOverFlow = True
	else
		CheckOverFlow = False
	end if
end function

function GetTrueLength(strChinese, lenMaxWord, strSpaceBar)
	'截取正确的英文/汉字长度
	'strChinese 为被检测字符串,lenMaxWord 为限制的字符长度

	dim i, j, strTail, lenTotal, lenWord
	dim strWord, bOverFlow, RetString

	if strChinese = "" or vartype(strChinese) = vbNull or CLng(lenMaxWord) <= 0 then
		GetTrueLength = ""
		exit function
	end if

	strTail = " ..."
	bOverFlow = False

	lenTotal = 0
	for i=1 to Len(strChinese)
		strWord = mid(strChinese, i, 1)
		if asc(strWord) < 0 or asc(strWord) > 127 then
			lenTotal = lenTotal + 2
		else
			lenTotal = lenTotal + 1
		end if
	next
	'判断字符是否溢出
	if lenTotal > lenMaxWord then bOverFlow = True

	strSpaceBar = ""
	if bOverFlow = True then
		'字符溢出,去尾
		lenWord = 0
		RetString = ""
		for i=1 to Len(strChinese)
			strWord = mid(strChinese, i, 1)
			if asc(strWord) < 0 or asc(strWord) > 127 then lenNow = 2 else lenNow = 1
			lenWord = lenWord + lenNow
			'截掉多余部分
			if lenWord <= (lenMaxWord - Len(strTail)) then
				RetString = RetString + strWord
			else
				RetString = RetString + strTail
				lenWord = lenWord + Len(strTail) - lenNow
				if (lenMaxWord-lenWord)>0 then
					for j =1 to lenMaxWord-lenWord
						strSpaceBar = strSpaceBar + "&nbsp;"
					next
				end if
				GetTrueLength = RetString
				exit for
			end if
		next
	else
		'字符不溢出,填充空位
		RetString = strChinese
		if (lenMaxWord-lenTotal)>0 then
			for i =1 to lenMaxWord-lenTotal
				strSpaceBar = strSpaceBar + "&nbsp;"
			next
		end if
		GetTrueLength = RetString
	end if
end function

function HTMLDecode(fString)
	fString = replace(fString, "&amp;", "&")
	fString = replace(fString, "&gt;", ">")
	fString = replace(fString, "&lt;", "<")
	fString = replace(fString, "&quot;", Chr(34))
	fString = Replace(fString, "…", "...")

	HTMLDecode = fString
end function
%>