⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 xbqq_function.asp

📁 欢迎使用酷航设计系统
💻 ASP
📖 第 1 页 / 共 2 页
字号:

<%
    '//文章搜索调用
    Sub xbqq_Search()
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=80>"
    response.write "<tr>"
    response.write "<td>"
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=80 style='border-left: 1px solid #CECFCE; border-right: 1px solid #CECFCE; border-bottom: 1px solid #CECFCE;border-top: 1px solid #CECFCE' bgcolor=#F7F7F7>"
    response.write "<tr>"
    response.write "<td>"
    '------------主要内容开始
    response.write "<table width=""100%"" border=""0"" cellspacing=""3"" cellpadding=""2"">"& vbCrLf
    response.write "<form name=""search"" method=""post"" action=""search.asp""> "& vbCrLf
    response.write "<tr><td height=""32"" colspan=""2"" align=""center"">"& vbCrLf
    response.write "请输入要搜索信息的内容!<br>搜索信息:<input name=txtitle type=Text id=txtitle size=12 maxlength=50>"
    response.write "</td></tr>"& vbCrLf
    response.write "<tr><td width=""49%""align=""right"">"& vbCrLf
    response.write "<input type=""submit"" value=""查 询"" name=""title2"" class=""buttonface""></td>"& vbCrLf
    response.write "<td width=""51%"" align=""center"">"& vbCrLf
    response.write "<input type=""reset"" name=""Submit3"" value=""清 除""></td></tr>"& vbCrLf
    response.write "</form></table>"& vbCrLf
    '------------主要内容结束
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=10>"
    response.write "<tr>"
    response.write "<td></td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    End sub
%>
<%
    '//投票调用
    Function xbqq_vote()
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=100 background=xbqq_img/kind3.gif>"
    response.write "<tr>"
    response.write "<td>"
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=100 style='border-left: 1px solid #CECFCE; border-right: 1px solid #CECFCE; border-bottom: 1px solid #CECFCE' bgcolor=#F7F7F7>"
    '-----------主要内容开始
    response.write "<tr>"
    response.write "<td height=5></td>"
    response.write "</tr>"
    response.write "<tr>"
    response.write "<td>"
    response.write "<center>"
    response.write "<IFRAME ID=""vote"" SRC=""Vote/index.htm"" FRAMEBORDER=""0"" SCROLLING=""no"" WIDTH=""190"" HEIGHT=""180""></IFRAME> "& vbCrLf
    response.write "</center>"
    response.write "</td>"
    response.write "</tr>"
    response.write "<tr>"
    response.write "<td height=5></td>"
    response.write "</tr>"
    '-----------主要内容结束
    response.write "</table>"
    response.write "</div>"
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"

    End Function
%>
<%
    '//公告调用
    Function xbqq_Marquee()
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=148 background=xbqq_img/kind3.gif>"
    response.write "<tr>"
    response.write "<td>"
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=148 style='border-left: 1px solid #CECFCE; border-right: 1px solid #CECFCE; border-bottom: 1px solid #CECFCE' bgcolor=#F7F7F7>"
    response.write "<tr>"
    response.write "<td>"
    '-----------主要内容开始
    response.write "<p style='line-height: 150%; margin-left: 8px; margin-right: 6px'>"
    response.write"<MARQUEE direction='Up' id=scrollarea onmouseover=this.stop(); onmouseout=this.start(); scrollAmount=1 scrollDelay=10  height=195>"
    sql="select * from announce ORDER BY taxis ASC"
    set rs=conn.execute(sql)
    if Rs.eof or Rs.bof then
    response.write "还没有任何滚动公告..."
    end if
    do while not Rs.eof
    response.write"<center><b>"
    response.write rs("Title")
    response.write"</b>"
    response.write"<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
    response.write"<font color='#808080'>[ "
    response.write rs("time")
    response.write" ]</font>"
    response.write"</center>"
    response.write"<img border=0 src='Images/xbqq_skin/Gaobei_ico.gif'>"
    response.write rs("Content")
    response.write"<br><center><font color='#C0C0C0'>---------------------------</font></center>"
    Rs.movenext
    loop
    response.write "</MARQUEE>"
    Rs.close
    set Rs=nothing
    '-----------主要内容结束
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"

    End Function
%>
<%
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			gotTopic=left(str,i) & ".."
			exit for
		else
			gotTopic=str
		end if
	next
	gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function


Function FlashNews(num,fontnum,PicWidthStr,PicHeightStr,BGcolor,txtheight)
Dim RsFilterObj,FlashStr,ImagesStr,TxtStr,LinkStr
FilterSql = "SELECT top "&num&" * FROM news where Ispic=1 and pic<>'' ORDER BY ID DESC"
Set RsFilterObj = Conn.Execute(FilterSql)
If not RsFilterObj.Eof then
  Dim Temp_Num
  Temp_Num = 0
  Do While Not RsFilterObj.Eof
  Temp_Num = Temp_Num + 1
  RsFilterObj.MoveNext
  Loop
  RsFilterObj.MoveFirst
  If Temp_Num <=1 then
  Set RsFilterObj = Nothing
  FlashNews = "至少需要两条幻灯新闻才能正确显示幻灯效果"
  Set RsFilterObj = Nothing
  Exit Function 
  End If
  do while Not RsFilterObj.Eof
   if ImagesStr = "" then
     ImagesStr = RsFilterObj("pic")
     TxtStr = gotTopic(RsFilterObj("Title"),fontnum)
     LinkStr = "NewsInfo.asp?id="&RsFilterObj("id")
   else
     ImagesStr = ImagesStr &"|"& RsFilterObj("pic")
     TxtStr = TxtStr & "|" & gotTopic(RsFilterObj("title"),fontnum)
     LinkStr = LinkStr & "|" & "NewsInfo.asp?id="& RsFilterObj("id")
   end if
  RsFilterObj.MoveNext
  loop
FlashStr="<script type=""text/javascript"">"& Chr(13)
FlashStr=FlashStr&"<!--"& Chr(13)
FlashStr=FlashStr&"var focus_width="&PicWidthStr& Chr(13)   
FlashStr=FlashStr&"var focus_height="&PicHeightStr& Chr(13) 
FlashStr=FlashStr&"var text_height="&txtheight& Chr(13) 
FlashStr=FlashStr&"var swf_height = focus_height+text_height"& Chr(13)
FlashStr=FlashStr&"var pics='"&ImagesStr&"'"&Chr(13)
FlashStr=FlashStr&"var links='"&LinkStr &"'"&Chr(13)
FlashStr=FlashStr&"var texts='"&TxtStr&"'"&Chr(13)
FlashStr=FlashStr&"document.write('<object classid=""clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"" codebase=""http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"" width=""'+ focus_width +'"" height=""'+ swf_height +'"">');"&Chr(13)
FlashStr=FlashStr&"document.write('<param name=""allowScriptAccess"" value=""sameDomain""><param name=""movie"" value=""xbqq_img/pic.swf""><param name=""quality"" value=""high""><param name=""bgcolor"" value="&BGcolor&">');"&Chr(13)
FlashStr=FlashStr&"document.write('<param name=""menu"" value=""false""><param name=wmode value=""opaque"">');"&Chr(13)
FlashStr=FlashStr&" document.write('<param name=""FlashVars"" value=""pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'"">');"&Chr(13)
FlashStr=FlashStr&"document.write('<embed src=""xbqq_img/pic.swf"" wmode=""opaque"" FlashVars=""pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'"" menu=""false"" bgcolor="&BGcolor&" quality=""high"" width=""'+ focus_width +'"" height=""'+ swf_height +'"" allowScriptAccess=""sameDomain"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />');"&Chr(13)
FlashStr=FlashStr&"document.write('</object>');"&Chr(13)
FlashStr=FlashStr&"//-->"& Chr(13)
FlashStr=FlashStr&"</script>"
  else
    FlashStr="没有幻灯图片"
  end if
    RsFilterObj.Close
Set RsFilterObj = Nothing
    FlashNews= FlashStr
End Function
%>
<%
    '//文章信息调用
    Function xbqq_articleInfo(s_num,nums,Linenum,S_info,Show_date)
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=128 background=xbqq_img/kind3.gif>"

    response.write "<tr>"
    response.write "<td>"
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=100 style='border-left: 1px solid #CECFCE; border-right: 1px solid #CECFCE; border-bottom: 1px solid #CECFCE' bgcolor=#F7F7F7>"
    response.write "<tr>"
    response.write "<td valign=top>"
    '------------主要内容开始
    response.write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
    Select case s_num
    case 1 '热门
    InfoSql="select top "&nums&" * from Info order by hits desc,ID desc"
    case 2 '新信息
    InfoSql="select top "&nums&" * from Info order by AddDate desc,ID desc"
    case 3 '大类热门
    InfoSql="select top "&nums&" * from Info where Sort1="&S_info&" order by hits desc,ID desc"
    case 4 '小类热门
    InfoSql="select top "&nums&" * from Info where Sort2="&S_info&" order by hits desc,ID desc"
    case 5 '大类
    InfoSql="select top "&nums&" * from Info where Sort1="&S_info&" order by AddDate desc,ID desc"
    case 6 '小类
    InfoSql="select top "&nums&" * from Info where Sort2="&S_info&" order by AddDate desc,ID desc"
    Case 7 '推荐
    InfoSql="select top "&nums&" * from Info Where Pw_Good=True ORDER BY id DESC"
    Case else  '其它
    InfoSql="select top "&nums&" * from Info order by hits desc"
    End Select
    Set InfoRs=Conn.Execute(InfoSql)
    if InfoRs.eof or InfoRs.bof then
    response.write"<tr><td align='center'>没有信息...</td></tr>"
    end if 
    while not Infors.eof 
    set title=Infors("title")
    set id=Infors("id")
    response.write "<tr><td width=""8%""align=""right""><img src=""Images/xbqq_skin/Gaobei_ico.gif"" width=""12"" height=""11"" align=""absmiddle""></td><td width=""92%""><p style='line-height: 150%'>"& vbCrLf
    response.write "<a href='ViewInfo.asp?id="&id&"'title='"&title&"'>"
    if GetLen(title)>Linenum then
    response.write ""&LeftStr(title,Linenum-2)&""
    response.write "..."
    else
    response.write ""&title&""
    end if
    if Show_date=1 then 
    response.write "&nbsp;&nbsp;"
    response.write DateTimeFormat(Infors("AddDate"),3)
    End if
    response.write "</a></td></tr>"
    Infors.movenext  
    wend
    Infors.close
    set Infors=nothing
    response.write "</table>"
    '-----------主要内容结束
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=10>"
    response.write "<tr>"
    response.write "<td></td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"
    End Function
%>
<%
    '//下载分类调用
    Function xbqq_downclass()
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=208 height=100>"

    response.write "<tr>"
    response.write "<td>"
    response.write "<div align=center>"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -