www.gusucode.com > 学校共青团组织网站源代码 > 学校共青团组织网站源代码/626/titleb.asp
<% function titleb(str,strlen) dim l,t,c, i 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 titleb=left(str,i)&"…" exit for else titleb=str&"" end if next end function function lmpath() systempath=config("path") systempath=replace(systempath,"admin/","") if newsid="" then newsid=trim(request("newsid")) if newsid<>"" then set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [news] where id="&newsid&" order by id desc",conn,1,1 if rs.recordcount<>0 then lm3=rs("lm3") lm2=rs("lm2") lm1=rs("lm") title=rs("title") lmpath=title end if rs.close set rs=nothing if lm3<>"0" then set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [lm] where id="&lm3&" order by id desc",conn,1,1 if rs.recordcount<>0 then lm3name=rs("lm3") lmpath="<a href="&systempath&"news_more.asp?lm2="&rs("id")&">"&lm3name&"</a> - "&lmpath end if rs.close set rs=nothing end if if lm2<>"0" then set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [lm] where id="&lm2&" order by id desc",conn,1,1 if rs.recordcount<>0 then lm2name=rs("lm2") lmpath="<a href="&systempath&"news_more.asp?lm2="&rs("id")&">"&lm2name&"</a> - "&lmpath end if rs.close set rs=nothing end if if lm1<>"0" then set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [lm] where id="&lm1&" order by id desc",conn,1,1 if rs.recordcount<>0 then lmname=rs("lm") lmpath="<a href="&systempath&"news_more.asp?lm2="&rs("id")&">"&lmname&"</a> - "&lmpath end if rs.close set rs=nothing end if end if end function function lmaa() if lm2="" then lm2=0 set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [lm] where id="&lm2&" and lm3<>'' order by id desc",conn,1,1 if rs.recordcount<>0 then lm3name=rs("lm3") lmaa="<a href=news_more.asp?lm2="&rs("id")&">"&lm3name&"</a> - " lm2=rs("lmID") end if rs.close set rs=nothing set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [lm] where id="&lm2&" and lm2<>'' order by id desc",conn,1,1 if rs.recordcount<>0 then lm2name=rs("lm2") lmaa="<a href=news_more.asp?lm2="&rs("id")&">"&lm2name&"</a> - "&lmaa lm2=rs("lmid") end if rs.close set rs=nothing set rs = Server.CreateObject("ADODB.RecordSet") rs.Open "select * from [lm] where id="&lm2&" and lm<>'' order by id desc",conn,1,1 if rs.recordcount<>0 then lmname=rs("lm") lmaa="<a href=news_more.asp?lm2="&rs("id")&">"&lmname&"</a> - "&lmaa end if rs.close end function function newsx() Set rsnewsx=conn.Execute("select [newsx] from [config]") newsx=int(rsnewsx("newsx")) rsnewsx.close set rsnewsx=nothing end function function pl() Set rsnewsx=conn.Execute("select [pl] from [config]") pl=int(rsnewsx("pl")) rsnewsx.close set rsnewsx=nothing end function function config(zd) Set rsnewsx=conn.Execute("select "&zd&" from [config]") config=rsnewsx(""&zd&"")&" " config=replace(config,"admin/","") config=trim(config) rsnewsx.close set rsnewsx=nothing end function function chkhtm(stra) stra=stra&" " stra=replace(stra,"<","<") stra=replace(stra,">",">") stra=replace(stra,"'","") stra=replace(stra,"(","(") stra=replace(stra,")",")") stra=replace(stra,";",";") stra=replace(stra,",",",") stra=replace(stra,"%","%") stra=replace(stra,"+","+") chkhtm=trim(stra) end function Function glhtml(title) title=replace(title," "," ") title=replace(title," ","") title=replace(title,chr(32),"") title=replace(title,chr(13),"") title=replace(title,chr(10),"") title=replace(title,chr(9),"") title=replace(title," ","") title=replace(title,"""","") title=replace(title,"'","") set reg=new regexp reg.IgnoreCase=true reg.Global=true reg.Pattern="<(.+?)>" glhtml=reg.Replace(title,"") set reg=nothing End Function Function finddir(filepath) finddir="" for i=1 to len(filepath) if left(right(filepath,i),1)="/" or left(right(filepath,i),1)="\" then abc=i exit for end if next if abc <> 1 then finddir=left(filepath,len(filepath)-abc+1) finddir=replace(finddir,"admin/","") end if end Function function GoogleSo() GoogleSo="<center><hr size=1>" GoogleSo=GoogleSo&"<center>" GoogleSo=GoogleSo&"<form method='get' name=E_FORM action='http://www.google.cn/custom' target=_blank>" GoogleSo=GoogleSo&"<table bgcolor='#ffffff'>" GoogleSo=GoogleSo&"<tr><td nowrap='nowrap' valign='top' align='left' height='32'>" GoogleSo=GoogleSo&"<label for='sbi' style='display: none'>输入您的搜索字词</label>" GoogleSo=GoogleSo&"<input type='text' name='q' size='30' maxlength='255' value='"&glhtml(title)&"' id='sbi'></input>" GoogleSo=GoogleSo&"<label for='sbb' style='display: none'>提交搜索表单</label>" GoogleSo=GoogleSo&"<input type='submit' name='sa' value='Google搜索' id='sbb'></input>" GoogleSo=GoogleSo&"<input type='hidden' name='client' value='pub-7709734864915288'></input>" GoogleSo=GoogleSo&"<input type='hidden' name='forid' value='1'></input>" 'GoogleSo=GoogleSo&"<input type='hidden' name='ie' value='utf-8'></input>" 'GoogleSo=GoogleSo&"<input type='hidden' name='oe' value='utf-8'></input>" GoogleSo=GoogleSo&"<input type='hidden' name='cof' value='GALT:#008000;GL:1;DIV:#336699;VLC:663399;AH:center;BGC:FFFFFF;LBGC:336699;ALC:0000FF;LC:0000FF;T:000000;GFNT:0000FF;GIMP:0000FF;LH:43;LW:100;L:http://www.google.cn/logos/Logo_40wht.gif;S:http://;LP:1;FORID:1'></input>" GoogleSo=GoogleSo&"<input type='hidden' name='hl' value='zh-CN'></input>" GoogleSo=GoogleSo&"</td></tr></table>" GoogleSo=GoogleSo&"</form>" GoogleSo=GoogleSo&"</center>" end function function nrreplace(content) pp="" pp=pp&" " pp=pp&"<a name=pl><img src=../../../images/bbstitle.gif></a><a href=#pl onclick='window.open(""../../../NewsPL.asp?id="&newsid&""",""newsview"",""width=680,height=400,top=70,left=150,scrollbars=yes"" )' title='"&title&"'>发表,查看评论(<script charset='gb2312' TYPE='text/javascript' language='javascript' src='"&config("path")&"js-pls.asp?newsid="&newsid&" '></script>)</a> " pp=pp&"<img border='0' src='../../../images/print.gif' width='16' height='16'><a href='javascript:window.print()'>打印本页</a> " lmid=lm3 if lmid="0" or lmid="" then lmid=lm2 if lmid="0" or lmid="" then lmid=lm1 sql2 = "select * from lm where mb<>'' and id="&clng(lmid) Set rs2 = Server.CreateObject("ADODB.RecordSet") rs2.Open sql2,conn,1,1 if rs2.recordcount<>0 then lmname=rs2("lm")&rs2("lm2")&rs2("lm3") mbid=rs2("mb") sql3 = "select * from newsmb where id="&mbid Set rs3 = Server.CreateObject("ADODB.RecordSet") rs3.Open sql3,conn,1,1 if htitle="" then htitle=" " if rs3.recordcount<>0 then updown=rs3("updown") nr=rs3("mid") if config("ggso")="1" then content=content&GoogleSo() end if if config("xuasGG")="1" then nrGG="<center><iframe name='xGGI1' src='http://www.xuas.com/Other/GoogleAD/Google468x60-FFFFFF.asp' marginwidth='1' marginheight='1' height='60' width='468' scrolling='no' border='0' frameborder='0'></iframe></center><BR><BR>" if config("xuasGGWZ")="1" then content=nrgg+content elseif config("xuasGGWZ")="2" then content=content+nrgg end if end if webxgnews=trim(xgnews) if webxgnews="" then webxgnews=left(glhtml(title),5) if webxgnews<>"" then webxgnews=replace(webxgnews,"[","") webxgnews=replace(webxgnews,"]","") end if if trim(Url)<>"" then nr="<META http-equiv='refresh' CONTENT='0;url="&url&"'>"&nr if pl()=1 then ppll="<iframe src='../../../newspl.asp?id="&NewsID&"' name='"&NewsID&"' width=100% height=300 border=0 marginwidth=1 marginheight=1 frameborder=0></iframe>" nr=replace(nr,"$$路径$$",lmpath()) nr=replace(nr,"$$副标题$$",htitle) nr=replace(nr,"$$标题$$",title) nr=replace(nr,"$$栏目名$$",lmname) nr=replace(nr,"$$时间$$",addtime) nr=replace(nr,"$$访问量$$","<script language='javascript' type='text/javascript' src='../../../JS-hit.asp?id="&newsid&"'></script>") nr=replace(nr,"$$内容$$",content) nr=replace(nr,"$$来源$$",laiyuan) nr=replace(nr,"$$作者$$",zz) nr=replace(nr,"$$评论$$",ppll) nr=replace(nr,"$$图片作者$$",piczz) nr=replace(nr,"$$打印$$",pp) nr=replace(nr,"$$工具栏$$",pp) nr=replace(nr,"$$相关$$","<script language='javascript' type='text/javascript' charset='gb2312' src='../../../JS-XGXX.asp?id="&newsid&"&xgnews="&webxgnews&"'></script>") nr=replace(nr,"$$NEWSID$$",newsid) if updown=0 then nr=replace(nr,"$$上下条$$","") else nr=replace(nr,"$$上下条$$","<script language='javascript' type='text/javascript' charset='gb2312' src='../../../JS-ShangXiaTiao.asp?id="&newsid&"'></script>") end if nrreplace=nr else response.write "<script>alert('模版设置不正确。');</script>" Response.end end if rs3.close:set rs3=nothing else Response.Write "<script>alert('此栏目模版设置不正确');</script>" Response.end mbid=1 end if rs2.close:set rs2=nothing end function function hrefID(ID,filename) if filename<>"0" then hrefid=""&filename else hrefid="News_View.asp?NewsID="&ID end if end function function sdDel(purl) on error resume next dim fso set fso=server.CreateObject("Scripting.FileSystemObject") fso.DeleteFile server.MapPath(purl),true set fso=nothing for dd=1 to 50 purl2=replace(purl,".htm","-"&dd&".htm") set fso=server.CreateObject("Scripting.FileSystemObject") fso.DeleteFile server.MapPath(purl2),true set fso=nothing next end function function datetime(dat) mmm=Month(dat) if len(mmm)=1 then mmm="0"&mmm ddd=day(dat) if len(ddd)=1 then ddd="0"&ddd hhh=hour(dat) if len(hhh)=1 then hhh="0"&hhh minu=Minute(dat) if len(minu)=1 then minu="0"&minu sss=Second(dat) if len(sss)=1 then sss="0"&sss datetime=year(dat)&"-"&mmm&"-"&DDD&" "&hhh&":"&minu&":"&sss end function Sub BuildPath(strPath) On Error Resume Next Dim nPos,fso,strFolder nPos = Len(Server.MapPath("/")) Set fso = CreateObject("Scripting.FileSystemObject") Do nPos = InStr(nPos + 1,strPath,"/") If nPos = 0 Then strFolder = strPath Else strFolder = Left(strPath,nPos - 1) End If If fso.FolderExists(strFolder) Then 'Response.Write strFolder & " 已经有了.<br>" Else fso.CreateFolder(strFolder) If Err Then Response.Write err.description Else 'Response.Write strFolder & " 建立成功.<br>" End If End If Loop Until nPos = 0 End Sub function schtml() '必有 filename、content、bbbhtml 参数 ccc=filename if bbbhtml<>"" and filename<>"" and html="1" then if instr(content,"$$分页$$")<>0 then nrfy=split(content,"$$分页$$") content=nrfy(page) fy=1 for i=0 to ubound(nrfy) if i<>0 then bbb=an&"-"&i+1&".htm" else bbb=an&".htm" end if ccc=bbb ddd=ddd&"<a href="&CCC&">"&i+1&"</a> " next for i=0 to ubound(nrfy) CNR=nrfy(i)&"<center>第 "&ddd&"页</center>" BuildPath Replace(Server.MapPath(bbbhtml),"\","/") if i<>0 then bbb=an&"-"&i+1&".htm" else bbb=an&".htm" end if ccc=bbbhtml&"/"&bbb if content<>"" then set fso = Server.CreateObject("Scripting.FileSystemObject") set fout = fso.CreateTextFile(server.mappath(ccc),2,true) fout.write nrreplace(CNR) fout.close set fout=nothing set fso=nothing end if next else '没有分页符 BuildPath Replace(Server.MapPath(bbbhtml),"\","/") if content<>"" then 'filename=Replace(Server.MapPath(bbbhtml),"\","/") & filename set fso = Server.CreateObject("Scripting.FileSystemObject") set fout = fso.CreateTextFile(server.mappath(filename),2,true) fout.write nrreplace(content) fout.close set fout=nothing set fso=nothing end if end if end if end function %>