📄 my_news.asp
字号:
<%@ Language=VBScript %>
<!--#include file="conn.asp"-->
<!--#include file="const.asp"-->
<%
' ###################################################################################################################
' ## 调用方法：<SCRIPT src="shownews.asp"></SCRIPT> ##
' ## 多个参数的使用：<SCRIPT src="http://www.Ahljez.cn/"></SCRIPT> ##
' ###################################################################################################################
Dim strDateType
Dim i, strSubject, strTrueSubject, strNews
Dim strShowLen, strMaxLen, strTime, strClick, StrImg, strToday, strBigclassName, strSmallClassName, strSpecialName, 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 = 1 ' ### 是否为今日文章加NEW，1为是，否不用写。 参数：Today
strFocusnews = 0 ' ### 是否显示焦点文章，1为是，否不用写。 参数：FocusNews
strGoodnews = 0 ' ### 是否显示推荐文章，1为是，否不用写。 参数：GoodNews
strhot = 0 ' ### 是否显示热点图文，1为是，否不用写。 参数：hot
strWhat = "NewsID" ' ### 选择按什么排序：NewsID，Click。 参数：What
strBigClassName = "大类名称" ' ### 显示最新大类文章， 参数：BigClassName
strSmallClassName = "小类名称" ' ### 显示最新小类文章， 参数：SmallClassName
strSpecialName = "专题名称" ' ### 显示最新专题文章， 参数：SpecialName
strDateType = "cnmd" ' ### 设置日期显示格式， 参数：DateType
' ### cnymd 2003年12月21日
' ### cnmd 12月21日
' ### ymd 2003/12/21
' ### ydm 2003/21/12
' ### mdy 12/21/2003
' ### dmy 21/12/2003
' ### md 12/21
' ### dm 21/12
strPath = WebUrl ' ### 文章所在路径，必须含有 "/" 字符，可以是其他服务器上的文章，参数：Path
' 默认为程序所在目录。
'####################################################################################################################
if Request.QueryString("Max") <> "" then strMaxLen = Request("Max")
if Request.QueryString("Show") <> "" then strShowLen = Request("Show")
if Request.QueryString("Date") <> "" then strDate = 1
if Request.QueryString("Time") <> "" then strTime = 1
if Request.QueryString("Click") <> "" then strClick = 1
if Request.QueryString("Img") <> "" then strImg = 1
if Request.QueryString("Today") <> "" then strToday = 1
if Request.QueryString("hot") <> "" then strhot = 1
if Request.QueryString("GoodNews") <> "" then strGoodNews = 1
if Request.QueryString("FocusNews") <> "" then strFocusNews = 1
if Request.QueryString("What") = "click" then
strWhat = "click"
else
strWhat="NewsID"
end if
if Request.QueryString("DateType") <> "" then strDateType = Request("DateType")
if Request.QueryString("BigClassName")<>"" then
strBigClassName = Request.QueryString("BigClassName")
else
strBigClassName = ""
end if
if Request.QueryString("SpecialName") <> "" then
strSpecialName = Request.QueryString("SpecialName")
else
strSpecialName=""
end if
if Request.QueryString("SmallClassName")<>"" then
strSmallClassName = Request.QueryString("SmallClassName")
else
strSmallClassName = ""
end if
if Request.QueryString("Path") <> "" then strPath = Request.QueryString("Path")
if Right(strPath,1)<>"/" then strPath = strPath + "/"
SQL = "SELECT top " & strShowLen & " * FROM news WHERE checked=1"
if strBigClassName<>"" and strSmallClassName="" then SQL = SQL & " and BigClassName = '" & strBigClassName &"'"
if strBigClassName<>"" and strSmallClassName<>"" then SQL = SQL & " and BigClassName = '" & strBigClassName &"' and SmallClassName = '" & strSmallClassName &"'"
if strBigClassName="" and strSmallClassName<>"" then SQL = SQL & " and SmallClassName = '" & strSmallClassName &"'"
if strSpecialName<>"" then SQL = SQL & " and SpecialName = '" & strSpecialName &"'"
if strhot=1 then SQL = SQL & " and hot=1"
if strGoodNews=1 then SQL = SQL & " and goodnews=1"
if strFocusNews=1 then SQL = SQL & " and Focusnews=1"
Set rs = Server.CreateObject("ADODB.Recordset")
SQL = SQL & " ORDER BY " & strWhat & " DESC"
RS.open sql,Conn,1,1
if RS.EOF or RS.BOF then
Response.Write ("document.write('还没有文章或该文章不存在！');")
else
Response.Write ("document.write('<table width=100% border=0 cellspacing=0 cellpadding=0>');")
Do while Not RS.EOF
strSubject = HTMLDecode(RS("Title"))
strTrueSubject = GetTrueLength(strSubject,strSpaceBar)
m_bOverFlow = CheckOverFlow(strSubject)
if m_bOverFlow = True then
strTip = strSubject
else
strTip = ""
end if
strFaceURL = "<img src=" & strPath & "images/go.gif> " '如果标题前想放图片，就把·改为：<img src=" & strPath & "images/go.gif>
strNews = strFaceURL & "<a class=MainContentS href=" & strPath & "shownews.asp?NewsID=" & RS("NewsID") & " title=""" & strTip & """ target=_blank>" & strTrueSubject & "</a>" & strSpaceBar & ""
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
if strClick = 1 then strNews = strNews & " <font color=red>" & RS("Click") & "</font>"
if strImg = 1 and rs("image")>0 then strNews = strNews & " <img src=" & strPath & "images/img.gif height=9>"
if strToday = 1 and DateValue(rs("updatetime"))=DateValue(date()) then strNews = strNews & " <img src=" & strPath & "images/new.gif height=9>"
Response.Write ("document.write('<tr><td style=""FONT-SIZE: 12px; LINE-HEIGHT: 140%"">" & strNews & "<br></td></tr>');")
'|___字体大小 |____行距
RS.MoveNext
Loop
Response.Write ("document.write('</table>');")
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"))
End Select
end function
function CheckOverFlow(strChinese)
'判断字符长度是否溢出
dim i, lenTotal, strWord
if strChinese = "" or vartype(strChinese) = vbNull or CLng(strMaxLen) <= 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 > strMaxLen then
CheckOverFlow = True
else
CheckOverFlow = False
end if
end function
function GetTrueLength(strChinese,strSpaceBar)
'截取正确的英文/汉字长度
dim i, j, strTail, lenTotal, lenWord, strWord, bOverFlow, RetString
if strChinese = "" or vartype(strChinese) = vbNull or CLng(strMaxLen) <= 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 > strMaxLen 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
end if
lenWord = lenWord + lenNow
'截掉多余部分
if lenWord <= (strMaxLen - Len(strTail)) then
RetString = RetString + strWord
else
RetString = RetString + strTail
lenWord = lenWord + Len(strTail) - lenNow
if (strMaxLen-lenWord)>0 then
for j =1 to strMaxLen-lenWord
strSpaceBar = strSpaceBar + " "
next
end if
GetTrueLength = RetString
exit for
end if
next
else
'字符不溢出,填充空位
RetString = strChinese
if (strMaxLen-lenTotal)>0 then
for i =1 to strMaxLen-lenTotal
strSpaceBar = strSpaceBar + " "
next
end if
GetTrueLength = RetString
end if
end function
function HTMLDecode(fString)
fString = replace(fString, "&", "&")
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = replace(fString, """, Chr(34))
fString = Replace(fString, "…", "...")
HTMLDecode = fString
end function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -