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

📄 createhtmlfiles_fun_1.asp

📁 新闻发布系统
💻 ASP
字号:
<%
  '建立HTML页面开始
Function GetHDaohang(GHClassID)
    set rsgd=Server.CreateObject("ADODB.RECORDSET")
    sql="Select * from NewsClass where id="&GHClassID
    rsgd.open sql,conn,1,1
    Gparentstr=rsgd("parentstr")
    GClassCN=rsgd("ClassCN")
    GClassEN=rsgd("ClassEN")
    sql="select * from newsclass where id in ("&Gparentstr&") order by RootID asc,orders asc"
    rsgd.close
    GetHDaohang="<a href=""http://"&sowinpath&""">首页</a>&nbsp;>>&nbsp;"
    rsgd.open sql,conn,1,1
    do while not rsgd.eof
    GetHDaohang=GetHDaohang+"<a href=""http://"&sowinpath&"Class/"&rsgd("ClassEN")&"/"">"&rsgd("ClassCN")&"</a>&nbsp;>>&nbsp;"
       rsgd.movenext
    loop
    GetHDaohang=GetHDaohang+"<a href=""http://"&sowinpath&"Class/"&GClassEN&"/"">"&GClassCN&"</a>&nbsp;>>&nbsp;"
    GetHDaohang=GetHDaohang+"<font color=red>新闻正文</font>"
    rsgd.close
    set rsgd=nothing
End Function

Sub CreateRefresh(PageCount,PageContent,y,TNewsID)
    session("FilePath")=""
    CTNewsId=TNewsID
    set rstt=Server.CreateObject("adodb.recordset")
    sql="Select * From News where NewsID="&CTNewsID
    rstt.open sql,conn,1,1
    CTemplet=rstt("Templet")
    CClassCn=rstt("ClassCn")
    Clpath=rstt("lpath")
    Ctemp=split(Clpath,"/")
    CFileName=rstt("FileName")
    KeyWord=rstt("KeyWord")
    rstt.close
    set rstt=nothing
    Set rs=Server.CreateObject("adodb.recordset")
    sql="Select * from Templet Where TempletName='"&CTemplet&"'"
    rs.open sql,conn,1,1
    set rs1=Server.CreateObject("adodb.recordset")
    sql1="Select * from newsClass Where ClassCN='"&CClassCN&"'"
    rs1.open sql1,conn,1,1
	Templet=CCoRe(rs("TempletContent"),PageCount,PageContent,y,CTNewsID)
    Set MyFile=Server.CreateObject("Scripting.FileSystemObject")
    if MyFile.FolderExists(Server.MapPath("..")&"\"&Ctemp(0))=false then MyFile.CreateFolder(Server.MapPath("..")&"\"&Ctemp(0))
    if MyFile.FolderExists(Server.MapPath("..")&"\"&Ctemp(0)&"\"&Ctemp(1))=false then MyFile.CreateFolder(Server.MapPath("..")&"\"&Ctemp(0)&"\"&Ctemp(1))
	if y>1 then
      Set CrFi=MyFile.CreateTextFile(Server.MapPath("..")&"\"&Clpath&CFileName&"-"&y&".html")
	else
	  Set CrFi=MyFile.CreateTextFile(Server.MapPath("..")&"\"&Clpath&CFileName&".html")	 
	end if
	'-----相关新闻处理开始
	set rshtml=Server.CreateObject("adodb.recordset")
    sqlKey="Select * from News Where Keyword like '%"&KeyWord&"%' and classcn='"&CClassCn&"' order by Date Desc"
    rshtml.open sqlKey,conn,1,1
    for i=1 to rs1("MNCount")
      if rshtml.eof then exit for
	  if rshtml("title")=request.form("Title") then
        rshtml.MoveNext
	  end if
	  if rshtml.eof then exit for
      correlation=correlation+""&rs1("MNTitle")&"<a href= http://"&sowinpath&rshtml("lpath")&rshtml("FileName")&".html target=_blank>"&BTitle(rshtml("title"))&"</a><br>"
      rshtml.MoveNext
	  '-----相关处理开始
    next
    session("FilePath")="<font color=red>新闻文件名:</font><a href=../"&Ctemp(0)&"\"&Ctemp(1)&"\"&CFileName&".html target=_blank>"&CFileName&".html</a><br>"
    Templet=replace(Templet,"[correlation]",""&correlation&"")
	Templet=replace(Templet,"[Sendmail]","<a href=http://"&sowinpath&"sendmail.asp?filename="&CFileName&" target=_blank>发送给好友</a>")
	CrFi.Writeline(""&Templet&"")
	CrFi.close
	set CrFi=nothing
    rshtml.close
	set rshtml=nothing
    rs1.close
    set rs1=nothing
    rs.close
    set rs=nothing
  End Sub
  '建立HTML页面结束

    function CCoRe(content,PageCount,PageContent,y,CTNewsID)
  if content <> "" then
    CTNewsId=CTNewsID
    set rstt=Server.CreateObject("adodb.recordset")
    sql="Select * From News where NewsID="&CTNewsID
    rstt.open sql,conn,1,1
    set rscc=Server.CreateObject("adodb.recordset")
    sql="Select * From NewsClass where ClassCN='"&rstt("ClassCN")&"'"
    rscc.open sql,conn,1,1
    CCoRe=content
    set rscon=Server.CreateObject("adodb.recordset")
    sqlcon="Select * from Config"
    rscon.open sqlcon,conn,1,1
    CCoRe=replace(CCoRe,"[url]",""&rscon("Domain")&"")
 WordNumber=rscon("WordNumber")
    rscon.close
    set rscon=nothing 
 CurrentPage=y
 if PageCount>1 then
 for CurrentPage=1 to PageCount
   if CurrentPage=1 then
     PageN=PageN+" <a href="&rstt("FileName")&".html>"&CurrentPage&"</a> "
   else
        PageN=PageN+" <a href="&rstt("FileName")&"-"&CurrentPage&".html>"&CurrentPage&"</a> "
   end if
 next 
    CCoRe=replace(CCoRe,"[content]",""&urlname(PageContent)&"<p>此新闻共有<font color=red><b>"&PageCount&"</font></b>页  "&PageN&"")
 else
     CCoRe=replace(CCoRe,"[content]",""&urlname(rstt("content"))&"")
 end if
 
    strNavigate=GetHDaohang(rscc("ID"))
    CCoRe=replace(CCoRe,"[title]",""&BTitle(rstt("title"))&"")
    CCoRe=replace(CCoRe,"[filetitle]","<title>"&BTitle(rstt("title"))&"</title>")
    CCoRe=replace(CCoRe,"[source]",""&rstt("source")&"")
    CCoRe=replace(CCoRe,"[editer]",""&rstt("editer")&"")
    CCoRe=replace(CCoRe,"[author]",""&rstt("author")&"")
    CCoRe=replace(CCoRe,"[date]",""&rstt("date")&"") 
    CCoRe=replace(CCoRe,"[click]","<script src=http://"&sowinpath&"Click.asp?filename="&rstt("filename")&"></script>")
    CCoRe=replace(CCoRe,"[hotnews]","<script src=http://"&sowinpath&"CodeJS/Hots_News.js></script>")
    CCoRe=replace(CCoRe,"[recommendnews]","<script src=http://"&sowinpath&"CodeJS/Tj_News.js></script>")
    CCoRe=replace(CCoRe,"[newssearch]","<script src=http://"&sowinpath&"JS/search.js></script>")
    CCoRe=replace(CCoRe,"[lastnews]","<script src=http://"&sowinpath&"CodeJS/new_news.js></script>")
    CCoRe=replace(CCoRe,"[speical]","<a href=http://"&sowinpath&"special/special.html>[专题阅读]</a>")
    CCoRe=replace(CCoRe,"[Navigation]",strNavigate)
    CCoRe=replace(CCoRe,"[review]","<form method=post action=http://"&sowinpath&"add_review.asp><input type=hidden Name=FileName value="&rstt("filename")&">共有评论<font color=red><script src=http://"&sowinpath&"reviewcount.asp?filename="&rstt("filename")&"></script></font>篇   <a href="&rstt("filename")&".asp>查看评论</a><br>姓名:<input type=text name=Name><input type=submit name=Submit value=发表评论><br><textarea name=Content cols=30 rows=4 title=不支持HTML,支持UBB代码></textarea></font></form>")
    set rstt=nothing
  end if
  end function
%>

⌨️ 快捷键说明

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