拿到一段程序，是截取标题长度的程序。。。。但是没有能截取成功。。。我看不出有什么问题。。麻烦兄弟们给指点指点。。。
也就是说....我用<script src="my_news.asp?参数一&参数二&....&参数十"></script>来调用下面的程序的时候,用<script src="my_news.asp?max=20&data=0"></script>带上参数的时候没有作用,都得到max=40和DATA=1这样的默认效果.....但是没有见程序的错误在哪里...
——————————————————————————————————————————
<%
Dim strConnString, conn, SQL, RS, strDateType
Dim i, strSubject, strTrueSubject, strNews
Dim strShowLen, strMaxLen, strTime, strClick, StrImg, strToday, strBigclassName, strSmallClassName, strSpecialName, strPath,
strwhat
Dim m_bOverFlow, strTip
strMaxLen = 40
strShowLen = 10
strDate = 1
strTime = 0
strClick = 0
strImg = 0
strToday = 0
strFocusnews = 0
strGoodnews = 0
strhot = 0
strWhat = "NewsID"
strBigClassName = "大类名称"
strSmallClassName = "小类名称"
strSpecialName = "专题名称"
strDateType = "cnmd"
strPath = WebUrl
if CLng(Request.QueryString("Max")) > 0 then strMaxLen = Request.QueryString("Max")
if CLng(Request.QueryString("Show")) > 0 then strShowLen = Request.QueryString("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.QueryString("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=true"
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=true"
if strGoodNews=1 then SQL = SQL & " and goodnews=true"
if strFocusNews=1 then SQL = SQL & " and Focusnews=true"
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=94% 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 width=10 height=9>
if strFaceURL = "" then strFaceURL="<li>"
strNews = strFaceURL & "<a 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
%>
————————————————————————————————————————————————
[此贴子已经被作者于2006-8-24 13:34:02编辑过]
