my_img.asp

庐江二中

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

Dim strConnString, strDateType
Dim i, strSubject, strTrueSubject, strTitle
Dim strShowLen, strMaxLen, strFocusnews, strGoodnews, strhot, strNewsTitle, strBigclassName, strSmallClassName, strSpecialName, strPath, strwhat,strwidth,strheight,strtwidth,CurrentPath
Dim m_bOverFlow, strTip
Dim ServerObject(9)
ServerObject(9) = "Scripting.FileSystemObject"
'################################################ 命令行参数及设置初始变量 ##################################
strMaxLen = 40							' ### 标题最多显示字符(双数)。                 参数：Max
strShowLen = 1							' ### 设定显示个数                             参数：Show
strNewsID = 0							' ### 指定文章ID号（其他选择无效）             参数：NewsID
strFocusnews = 0                        ' ### 是否显示焦点文章图片，1为是，否不用写。  参数：FocusNews
strGoodnews = 0                         ' ### 是否显示推荐文章图片，1为是，否不用写。  参数：GoodNews
strhot = 0                              ' ### 是否显示热点文章图片，1为是，否不用写。  参数：hot
strTitle = 0                            ' ### 是否显示文章标题，1为是且文字在下，2为是且文字环绕，否不用写。      
										' ###                                          参数：Title
strWhat = "NewsID"						' ### 选择按什么排序：NewsID，Click。          参数：What
strBigClassName = "大类名称"			' ### 显示某大类最新新闻图片                   参数：BigClassName
strSmallClassName = "小类名称"			' ### 显示某小类最新新闻图片                   参数：SmallClassName
strSpecialName = "专题名称"     		' ### 显示某专题最新新闻图片                   参数：SpecialName																																												
strPath = WebUrl						' ### 使用前请先设好后台中的[网站资料管理-网站地址]
										' ### 文章所在路径，可以是其他服务器上的文章， 参数：Path
strwidth=100							' ### 图片宽度，0为无限制					   参数：width
strheight=0 							' ### 图片高度，0为无限制					   参数：height
strtwidth=120							' ### 表格宽度								   参数：twidth
strpath=weburl                          ' ### 程序所在URL路径						   参数：path
										' ### 使用前请先设好后台中的[网站资料管理-网站地址]，也可在此设定
ImagePath=server.MapPath(imgPath)+"/" ' ### 图片所在路径，使用前请先设好后台中的[网站资料管理-图片相对路径]，也可在此设定
'#############################################################################################################

if Request.QueryString("Max")<>"" and Request.QueryString("Max") > 0 then strMaxLen = Request.QueryString("Max")
if Request.QueryString("show")<>"" and Request.QueryString("Show") > 0 then strShowLen = Request.QueryString("Show")
if Request.QueryString("hot")<>"" then strhot = 1
if Request.QueryString("Title")<>"" and Request.QueryString("Title") => 0 then strTitle = Request.QueryString("Title")
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("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 + "/"
if Right(imgPath,1)<>"/" then imgPath = imgPath + "/"
imgurl=strPath & imgPath
if Request.QueryString("width")<>"" and Request.QueryString("width") >= 0 then strwidth = Request.QueryString("width")
if Request.QueryString("height")<>"" and Request.QueryString("height") >= 0 then strheight = Request.QueryString("height")
if Request.QueryString("twidth")<>"" then strtwidth = Request.QueryString("twidth")

SQL = "SELECT top " & strShowLen & " * FROM news where image>0 and 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"
if request("NewsID")<>"" then SQL="SELECT top 1 * FROM news where newsid="&request("NewsID")&" and image>0 and checked=1"
RS.open sql,Conn,1,1

i=0: Randomize
if NOT(RS.EOF or RS.BOF) then
Response.Write ("document.write('<table width="""&strtwidth&""" border=0 cellspacing=0 cellpadding=0>');")
Do while Not RS.EOF

if i < strShowLen then
strSubject = HTMLDecode(RS("Title"))
strTrueSubject = GetTrueLength(strSubject)
m_bOverFlow = CheckOverFlow(strSubject, strMaxLen)
if m_bOverFlow = True then
strTip = strSubject
else
strTip = ""
end if

strNewsTitle ="<a href=""" & strPath & "shownews.asp?NewsID=" & RS("NewsID") & """ title=""" & strTip & """ target=""_blank"">" & strTrueSubject & "</a>"
if Request.QueryString("Title")="" or Request.QueryString("Title") =0 then strNewsTitle=""
strimg="<tr><td align=center><a href=""" & strPath & "shownews.asp?NewsID=" & RS("NewsID") & """ title=""" & strSubject & """ target=""_blank"">"&ImageFile(rs("NewsID"),1)&"</a></td></tr>"
if strTitle=2 then
Response.Write ("document.write('<tr><td style=""FONT-SIZE: 12px; LINE-HEIGHT: 140%""><table border=0 cellspacing=0 cellpadding=0 align=""left"">"&strimg&"</table>" & strNewsTitle&"</td></tr>');") 
else
Response.Write ("document.write('"&strimg&"<tr><td style=""FONT-SIZE: 12px; LINE-HEIGHT: 140%"">" & strNewsTitle&"</td></tr>');") 
end if
else
exit do
end if
i = i + 1
RS.MoveNext
Loop
Response.Write ("document.write('</table>');")	
else
Response.Write ("document.write('尚无图片文章！');")
End if
Response.End
RS.close
SET RS = Nothing
conn.close
SET Conn = Nothing

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

function ImageFile(NewsID,i)
'dim imgwidth,imgheight,DelectFile,FileName
if strwidth>0 then 
imgwidth=" width="&strwidth
else
imgwidth=""
end if
if strheight>0 then 
imgheight=" height="&strheight
else
imgheight=""
end if
On Error Resume Next
If  not IsObjInstalled(ServerObject(9)) Then
Response.Write "<img src="""& strPath & imgpath & NewsID & "-" & i & ".jpg"" border=""0"" "& imgwidth & imgheight& " alt=""不支持FSO组件&#13;&#10;只显示JPG图片"">"
else	
set DelectFile=server.CreateObject("scripting.filesystemobject")
CurrentPath=ImagePath & NewsID & "-" & i 
FileName=CurrentPath & ".jpg"
if DelectFile.FileExists(FileName) then
ImageFile="<img src="""& imgurl & NewsID & "-" & i & ".jpg"" border=""0"" "& imgwidth & imgheight&">" 
exit function
else
FileName=CurrentPath & ".gif"
if DelectFile.FileExists(FileName) then
ImageFile="<img src="""& imgurl & NewsID & "-" & i & ".gif"" border=""0"" "& imgwidth & imgheight&">"
exit function
else
FileName=CurrentPath & ".png"
if DelectFile.FileExists(FileName) then
ImageFile="<img src="""& imgurl & NewsID & "-" & i & ".png"" border=""0"" "& imgwidth & imgheight&">"
exit function
else
FileName=CurrentPath & ".swf"
if DelectFile.FileExists(FileName) then
ImageFile="<object Classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000  codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0 """& imgwidth & imgheight&"><param name=movie value="""& imgurl & NewsID & "-" & i & ".swf""><param name=quality value=high><embed src="""& imgurl & NewsID & "-" & i & ".swf"" pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" "& imgwidth & imgheight&"></embed></object>"
exit function
else
FileName=CurrentPath & ".bmp"
if DelectFile.FileExists(FileName) then
ImageFile="<img src="""& imgurl & NewsID & "-" & i & ".bmp"" border=0 "& imgwidth & imgheight&">"
exit function
else
ImageFile="<img src="""& imgurl & "error.jpg"" border=""0"" "& imgwidth & imgheight &" alt=""找不到图片，请检查图片 "& NewsID & "-" & i &" 是否在 "&ImgPath&" 目录内"">"
exit function
end if
end if
end if
end if
end if
end if
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)
'截取正确的英文/汉字长度
'strChinese 为被检测字符串,lenMaxWord 为限制的字符长度
lenMaxWord=strMaxLen
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))

HTMLDecode = fString
end function
%>