creathmllist.asp

Art2008 CMS是一款具有强大的功能的基于ASP语言的网站管理软件

<%
Function CreatHmlList(lmid)


Dim roott_path:roott_path=finddir(request.servervariables("URL"))

  sql5 = "select * from lm where id="&lmid
  Set rs5 = Server.CreateObject("ADODB.RecordSet")
  rs5.Open sql5,conn,1,1
   if rs5.recordcount <> 0 then
     id=trim(rs5("id"))
	 mb=trim(rs5("mb"))
     lmm=rs5("lm")&rs5("lm2")&rs5("lm3")
     if lmid="0" then lmm="所有栏目"
	 lm_path=rs5("lm_path")
     ClassKeywords=rs5("ClassKeywords")
     ClassDescription=rs5("ClassDescription")
     if ClassKeywords="" then ClassKeywords=setting("sitekey")
     if ClassDescription="" then ClassDescription=setting("sitedes")
	 end if
	 rs5.close:set rs5=nothing
		
		 dim fddh   '08_09_01 增加$$浮动导航$$标签
         if config("fddh") =0 then
           fddh_x=config("fddh_x")
	       fddh_y=config("fddh_y")
	       fddh_body=config("fddh_body")
	
          fddh="<SCRIPT FOR=window EVENT=onload LANGUAGE=""javascript"">initAd();</SCRIPT>"
          fddh=fddh&"<script language=""javascript"">function initAd() {" & vbcrlf
          fddh=fddh&"           document.all.AdLayer.style.posTop = -250;" & vbcrlf
          fddh=fddh&"            document.all.AdLayer.style.visibility = 'visible'" & vbcrlf
          fddh=fddh& "           MoveLayer('AdLayer');}" & vbcrlf
          fddh=fddh& "        function MoveLayer(layerName) {" & vbcrlf
          fddh=fddh&"            var x = "& fddh_x &";" & vbcrlf
          fddh=fddh&"            var y = "& fddh_y &";" & vbcrlf
          fddh=fddh&"            var diff = (document.body.scrollTop + y - document.all.AdLayer.style.posTop)*.40;" & vbcrlf
          fddh=fddh&"            var y = document.body.scrollTop + y - diff;" & vbcrlf
          fddh=fddh&"           eval(""document.all."" + layerName + "".style.posTop = y"");" & vbcrlf
          fddh=fddh&"            eval(""document.all."" + layerName + "".style.posLeft = x"");" & vbcrlf
          fddh=fddh&"            setTimeout(""MoveLayer('AdLayer');"", 10);}" & vbcrlf
          fddh=fddh&"          </script>" & vbcrlf
          fddh=fddh&"<div id=AdLayer style='position:absolute; z-index:20; visibility:hidden;'>"& fddh_body &"</div>"
          else
          fddh=""
          end if

	
	 sql3 = "select * from newsmb where id="&clng(mb)
     Set rs3 = Server.CreateObject("ADODB.RecordSet")
     rs3.Open sql3,conn,1,1
     if rs3.recordcount<>0 then
	     listmb=rs3("listmb")
	     listshu=rs3("list")
	     tb=rs3("tb")
	     lmnameid=rs3("lmname")
	     newstime=rs3("newstime")
	     newshit=rs3("newshit")
	     openwindow=rs3("openwindow")
	     icon=rs3("icon")
		 moreline=rs3("moreline")
		 
		 copen=trim(rs3("copen"))   '新闻列表复杂样式设置
         ccount=trim(rs3("ccount"))
         ccolor=trim(rs3("ccolor"))
         csize=trim(rs3("csize"))
         tbold=trim(rs3("tbold"))
         tface=trim(rs3("tface"))
         tcolor=trim(rs3("tcolor"))
         tsize=trim(rs3("tsize"))   '新闻列表复杂样式设置结束
		 end if
		 rs3.close:set rs3=nothing 	
		 if lmname="" then lmname=0
         if tb="" then tb=20
         if listshu="" then listshu=20
         if openwindow="1" then
         openwindow=" target=_blank "
         else
         openwindow=" target=_top  "
         end if
		 
		Set rs4 = Server.CreateObject("ADODB.RecordSet")   '页头页尾调用开始
		rs4.Open "select * from [config]",conn,1,1
		if rs4.recordcount<>0 then
		  top=rs4("top")
		  down=rs4("down")
		rs4.close:set rs4=nothing 
		end if        '页头页尾调用结束



		   
sql="select * from news where (lm='"&lmid&"' or lm2='"&lmid&"' or lm3='"&lmid&"') and sh=1 order by ontop desc , updat desc , id desc" '在这里添加条件
set rs=server.createObject("ADODB.Recordset")
rs.open sql,conn,1,1

rs.pagesize=listshu
totalpage=rs.pagecount
rs.close:set rs=nothing
for j=1 to totalpage
set rs=server.createObject("ADODB.Recordset")
rs.open sql,conn,1,1
whichpage=j 
rs.pagesize=listshu
totalpage=rs.pagecount
rs.absolutepage=whichpage
howmanyrecs=0
bbb=0
'标签替换部分
		 listmb=replace(listmb,"$$通用页头$$",top)
		 listmb=replace(listmb,"$$通用页尾$$",down)
	     listmb=replace(listmb,"$$栏目名$$",lmm)
	     listmb=replace(listmb,"$$LMID$$",lmid)
		 listmb=replace(listmb,"$$网站目录$$",roott_path)
		 listmb=replace(listmb,"$$浮动导航$$",fddh)   
		 listmb=replace(listmb,"$$网站名$$",setting("sitename"))
         listmb=replace(listmb,"$$网站描述$$",ClassDescription)
         listmb=replace(listmb,"$$关键字$$",ClassKeywords)
         listmb=replace(listmb,"$$版权信息$$",setting("sitecr"))
		  if lmid<>"0" then 
         listmb=replace(listmb,"$$路径$$",morepath())
           else
         listmb=replace(listmb,"$$路径$$","新闻列表-->所有栏目：")
           end if
'列表部分
str0=""
str0=str0&"<div id='newslist'>	"

do while not rs.eof and howmanyrecs<rs.pagesize


	lm2=rs("lm3")
     if lm2="0" or lm2="" then lm2=rs("lm2")
        if lm2="0" or lm2="" then lm2=rs("lm")
         sql2 = "select * from lm where id="&lm2
         Set rs2 = Server.CreateObject("ADODB.RecordSet")
         rs2.Open sql2,conn,1,1
         lm=rs2("lm")&rs2("lm2")&rs2("lm3")
         pic=rs2("pic")
		 
%><%
str0=str0&"<ul style='padding-bottom:"&moreline&"pt;'>"
str0=str0&"<li class='title'>"
str0=str0&"<span class=icon>"&icon&"</span>"

if lmnameid="1" then 
str0=str0&"<span class='lmname'>[<a href='"&list_html_url(rs2("id"))&"' "&openwindow&">"&lm&"</a>]</span>"
end if

str0=str0&"<span class='news'><a href='"&fun_html_url(rs("id"))&"' "&openwindow&">"
      if copen="1" then 
str0=str0&"<font color='"&trim(tcolor)&"' style='font-size:"&trim(tsize)&" pt;font-family:"&trim(tface)&";font-weight:"&trim(tbold)&"'>"
      else 
str0=str0&"<font color='"&trim(titlecolor)&"'>"
      end if 
str0=str0&titleb(rs("title"),tb)&"</font></a></span>"
	  
if newshit="1" then 
str0=str0&"<span class='hit'>阅读:"&rs("hit")&"</span>"
end if 

if trim(rs("pic"))<>"" and pic="1" then 
str0=str0&"<span class='pic'>[图]</span>"
end if 
	  
str0=str0&"</li>"

if newstime="1" then 
str0=str0&"<li class='time'>"&Format_Time(rs("time"),2)&"</li></ul>"
end if
	 
if copen="1" then
content=glhtml(rs("content"))    
content=glhtml(titleb(content,cint(ccount)))
str0=str0&"<ul><li class=cont>"
str0=str0&"<font color="& trim(ccolor)&" style='font-size:"&trim(csize)&"pt'>"&content&"</font><a href='"&fun_html_url(rs("id"))&"' "&openwindow&">【阅读全文】</a>"	
str0=str0&"</li></ul>"
end if
%><%
        bbb=bbb+1
        if bbb mod 10 = 0 then
		str0=str0&"<br>"
		end if
rs.movenext
howmanyrecs=howmanyrecs+1
loop
rs.close:set rs=nothing
%>
<%str0=str0&"</div>"%>

<%
'分页部分
ref=""
ref=ref&"<div id=htmlnextpage>"
ref=ref&"<table align=center border=0 width=100% cellpadding=0 cellspacing=0> "
ref=ref&"<tr>"
ref=ref&"<td width='18%'> "
ref=ref&"Pages： " & j & " / " & totalpage &""
ref=ref&"</td>"
ref=ref&"<td width='82%' align=center> "
ref=ref&"<a href=list_1."&config("file_type")& ">" & "<FONT face=Webdings>9</FONT>" & "</a> "
   if whichpage=1 then
   ref=ref&"<FONT face=Webdings>7</FONT>"
   else
   ref=ref&"<a href=list_"&j-1&"."&config("file_type")& ">" & "<FONT face=Webdings>7</FONT>" & "</a> "
   end if
   
   for counter=1 to totalpage
    ref=ref&"<a href=list_"&counter&"."&config("file_type")& ">[" & counter & "]</a>"
    ref=ref& " "
    'if counter mod 10 = 0 then
    'ref=ref& "<br>"
    'end if
   next
   if (whichpage>totalpage or whichpage=totalpage) then
   ref=ref&"<FONT face=Webdings>8</FONT>"
   else
   ref=ref&"<a href=list_"&j+1&"."&config("file_type")& ">" & "<FONT face=Webdings>8</FONT>" & "</a> "
   end if
   ref=ref&"<a href=list_"&totalpage&"."&config("file_type")& ">" & "<FONT face=Webdings>:</FONT>" & "</a> "
   ref=ref&"</td></tr></table></div> "  
   
     Dim newsList:newsList=""
   
	if instr(listmb,"$$列表$$")<>0 then
		     nr=split(listmb,"$$列表$$")
		    
		 newsList= newsList&nr(0)	
		 newsList= newsList&str0&ref	
		 newsList= newsList&nr(1)
		 else
			 newsList= newsList& "模版代码不正确，没有找到“$$列表$$”，不知道应该显示在哪里？"
		 end if
   
   
Dim fso,f
Dim strTitle,strContent,strOut
'创建文件系统对象
Dim listPath:listPath=config("path")&"html/"&lm_path&"/"
 
Set fso=Server.CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(server.mappath(listPath))=False Then
              fso.CreateFolder(server.mappath(listPath))
      End If
Set f=fso.CreateTextFile(Server.MapPath(""&listPath&"list_"&j&"."&config("file_type")&""),true)
'写入网页内容
f.WriteLine newsList
f.close

next

Set fso = nothing

Dim FsoHtmlList
FsoHtmlList="<table border=""0"" class=tdbg width=100% >"_
			& "<tr><td width='10%'><strong>ID 号 为：</strong></td><td><font color=red>"  & ID & "</font> 的栏目已生成</td></tr>"_
			& "<tr><td><strong>栏目名称：</strong></td><td><font color=red>" & lmm & "</font></td><tr>" _
			& "<tr><td><strong>生成路径：</strong></td><td><a href=""" & listPath & """ target=""_blank"">" & listPath & "</a></td><tr>" _
			& "<tr><td colspan=2 align=center><strong>操作完成!</strong>共生成<font color=#FF0000>" & totalpage &"</font>页。完成时间:"&Now()&"</td><tr>" _
			& "</table>"			

response.write FsoHtmlList

End Function
%>