生成SHTML代码

<% dim conn,rs,connstr
connstr="DBQ="+server.mappath("../netnews.mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
set conn=server.createobject("ADODB.CONNECTION")
conn.open connstr
%>
<%
set rs=server.createobject("adodb.recordset")
rs.open("select*from news_type order by id asc"),conn,1,1
set sl=server.createobject("adodb.recordset")
sl.open("select*from special order by id desc"),conn,1,1
%>
<%
dim newstitle,newstype,news
newstitle=request.form("newstitle")
newstype=request.form("newstype")
news=request.form("news")
special=request.form("special")
onfire=request.form("onfire")
if request.form("checkbox")=1 then
newstitle=newstitle&"[图文]"
end if
about=request.form("about")
if about<>"" then
set abt=server.createobject("adodb.recordset")
abt.open("select*from news where newstitle like '%"&about&"%' order by id asc"),conn,1,1
abt.pagesize=5
rowcount=abt.pagesize
end if
'格式化日期
Function format(date)
            format=datepart("yyyy",date)&"年"&datepart("m",date)&"月"&datepart("d",date)&"日&nbsp;"&formatdatetime(date,vbshorttime)
End Function
'vb代码检测
Function vbcheck(message)
            vbcheck = replace(message, "<","&lt",1,-1,1)
            vbcheck = replace(vbcheck, ">","&gt",1,-1,1)
   vbcheck = replace(vbcheck,"'","''",1,-1,1)
   vbcheck = replace(vbcheck,vbcrlf,"<br>"&vbcrlf)
            vbcheck = replace(vbcheck, "[b]","<b>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/b]","</b>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[s]", "<s>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/s]", "</s>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[u]","<u>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/u]","</u>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[i]","<i>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/i]","</i>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[red]", "<font color=red>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/red]", "</font id=red>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[green]", "<font color=green>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/green]", "</font id=green>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[blue]", "<font color=blue>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/blue]", "</font id=blue>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[white]", "<font color=white>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/white]", "</font id=white>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[purple]", "<font color=purple>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/purple]", "</font id=purple>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[yellow]", "<font color=yellow>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/yellow]", "</font id=yellow>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[violet]", "<font color=violet>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/violet]", "</font id=violet>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[brown]", "<font color=brown>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/brown]", "</font id=brown>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[black]", "<font color=black>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/black]", "</font id=black>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[pink]", "<font color=pink>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/pink]", "</font id=pink>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[orange]", "<font color=orange>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/orange]", "</font id=orange>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[gold]", "<font color=gold>", 1, -1, 1)
      vbcheck = replace(vbcheck, "[/gold]", "</font id=gold>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[size=1]", "<font size=1>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/size=1]", "</font id=size1>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[size=2]", "<font size=2>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/size=2]", "</font id=size2>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[size=3]", "<font size=3>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/size=3]", "</font id=size3>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[size=4]", "<font size=4>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/size=4]", "</font id=size4>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[size=5]", "<font size=5>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/size=5]", "</font id=size5>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[size=6]", "<font size=6>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/size=6]", "</font id=size6>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[marquee]", "<marquee direction=left>", 1, -1, 1)
   vbcheck = replace(vbcheck, "[/marquee]","</marquee>", 1, -1, 1)
            vbcheck = replace(vbcheck, "[img]","<div align='center'><img src=""",1,-1,1)
   vbcheck = replace(vbcheck, "[/img]",""" border=0></div>", 1, -1, 1)
   vbcheck=replace(vbcheck,"[url=","<a href=""",1,-1,1)
            vbcheck=replace(vbcheck,"[/url]","</a>",1,-1,1)
   vbcheck=replace(vbcheck,"[email=","<a href=""mailto:",1,-1,1)
            vbcheck=replace(vbcheck,"[/email]","</a>",1,-1,1)
   vbcheck=replace(vbcheck,"]",""" target=_blank>",1,-1,1)
End Function
news=vbcheck(news)
dim fmonth,fday,fhour,fminute,fsecond
fmonth=month(date)
if len(month(date))<2 then fmonth="0"&month(date) end if
fday=day(date)
if len(day(date))<2 then fday="0"&day(date) end if
fhour=hour(now())
if len(hour(now()))<2 then fhour="0"&hour(now()) end if
fminute=minute(now())
if len(minute(now()))<2 then fminute="0"&minute(now()) end if
fsecond=second(now())
if len(second(now()))<2 then fsecond="0"&second(now()) end if
newspath=year(date)&fmonth&fday
newsurl=fhour&fminute&fsecond
putdate=format(now())
if request("action")="do" then
conn.execute("insert into news (newstype,newstitle,newspath,newsurl,putdate,special,onfire) values('"&newstype&"','"&newstitle&"','"&newspath&"','"&newsurl&"','"&putdate&"','"&special&"','"&onfire&"')")
set ns=server.createobject("adodb.recordset")
ns.open("select*from news_type where english_name like '"&newstype&"'"),conn,1,1
path=server.MapPath("../"&newstype)
set fso=server.CreateObject("Scripting.FileSystemObject")
if fso.FolderExists(path)=false then
fso.CreateFolder(path)
end if
path=path&"/"&newspath
if fso.FolderExists(path)=false then
fso.CreateFolder(path)
end if
path=path&"/"&newsurl&".shtml"
set ts=fso.OpenTextFile(path,2,true,-2)
ts.writeline"<html>"
ts.writeline"<head>"
ts.writeline"<title>"&newstitle&"</title>"
ts.writeline"<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
ts.writeline"<link rel=""stylesheet"" href=""../../config.css"" type=""text/css"">"
ts.writeline"</head>"
ts.writeline""
ts.writeline"<body bgcolor=""#FFFFFF"" text=""#000000"">"
ts.writeline"<table width=""97%"" border=""0"" cellspacing=""0"" cellpadding=""0"">"
ts.writeline"  <tr>"
ts.writeline"    <td><img src='../../image/title.jpg' width='210' height='67'></td>"
ts.writeline"  </tr>"
ts.writeline"</table><br>"
ts.writeline"<table width=""97%"" border=""0"" cellspacing=""0"" cellpadding=""0"">"
ts.writeline"  <tr>"
ts.writeline"    <td><font size='2'><a href='../../index.asp'>首页</a>>>"
ts.writeline"<a href='../../readnews.asp?newstype="
ts.writeline newstype
ts.writeline"'>"
ts.writeline ns("news_type")
ts.writeline"</a>"
ts.writeline">>内容</font></td>"
ts.writeline"  </tr>"
ts.writeline"  <tr>"
ts.writeline"    <td><br><div align='center'><font color='#6699ff' size='3'>"&newstitle&"<br><font size='2'>"&putdate&"</font><br></font></div></td>"
ts.writeline"  </tr>"
ts.writeline"  <tr>"
ts.writeline"    <td><br><font size='2'>"&news&"</font></td>"
ts.writeline"  </tr>"
ts.writeline"</table><br>"
ts.writeline"<hr width=""90%"" size=""1""><font size='2'>相关新闻</font><br>"
if about<>"" then
do while not abt.eof and rowcount>0
ts.writeline"<a href='../../"&abt("newstype")&"/"&abt("newspath")&"/"&abt("newsurl")&".shtml' target='_blank'>"
ts.writeline abt("newstitle")
ts.writeline "</a><br>"
abt.movenext
loop
rowcount=rowcount-1
abt.close
set abt=nothing
end if
ts.writeline"</body>"
ts.writeline"</html>"
end if
%>
<html>
<head>
<title>添加新闻！</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>

<body bgcolor="#FFFFFF" text="#000000">
<table width="97%" border="0" cellspacing="0" cellpadding="0">
  <tr>
    <td><img src="../image/title.jpg" width="210" height="67"></td>
  </tr>
</table>
<br><form name="form1" method="post" action="addnews.asp?action=do">
<table width="97%" border="0" cellspacing="0" cellpadding="0">
 <tr>
    <td>
        <table width="97%" border="0" cellspacing="1" cellpadding="4" bgcolor="#FF6600">
          <tr bgcolor="#FFFFFF">
            <td width="20%" height="20"><font size="2">新闻标题：</font></td>
            <td>
              <input type="text" name="newstitle" size="50">
            </td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td height="9" bgcolor="#FFFFFF"><font size="2">新闻类别：</font></td>
            <td>
              <select name="newstype">
                <option value="" selected>选择新闻类别</option>
                <%do while not rs.eof%>
                <option value="<%=rs("english_name")%>"><%=rs("news_type")%></option>
                <%rs.movenext
    loop
    rs.close
    set rs=nothing
    %>
              </select>
            </td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td height="4" bgcolor="#FFFFFF"><font size="2">新闻专题：</font></td>
            <td>
              <select name="special">
                <option value="0" selected>选择新闻专题</option>
    <%do while not sl.eof%>
                <option value="<%=sl("id")%>"><%=sl("special_name")%></option>
    <%sl.movenext
    loop
    sl.close
    set sl=nothing
    %>
              </select>
            </td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td height="5" bgcolor="#FFFFFF"><font size="2">热点新闻：</font></td>
            <td>
              <select name="onfire">
                <option value="1">是</option>
                <option value="0" selected>否</option>
              </select>
            </td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td height="20" valign="top"><font size="2">新闻内容：</font></td>
            <td><img src="../IMAGE/toolbar.gif" width="139" height="22" align="absmiddle" usemap="#Map" border="0">
              <font size="2">有关更多的允许使用的代码信息请看 <a href="vbhelp.htm" target="_blank">VB代码帮助</a></font>
              <textarea name="news" cols="50" rows="8"></textarea>
            </td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td>
              <div align="left"><font size="2">新闻是否含有图片</font>:</div>
            </td>
            <td>
              <input type="checkbox" name="checkbox" value="1">
              <font size="2"> 如选择,新闻标题前将自动加上[图文]标志</font></td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td>
              <div align="left"><font size="2">相关新闻：</font></div>
            </td>
            <td>
              <input type="text" name="about" size="50">
              <font size="2">相关新闻里只需填入关键字（如：足球）或完整标题(只显示5条相关新闻) </font></td>
          </tr>
          <tr bgcolor="#FFFFFF">
            <td colspan="2">
              <div align="center">
                <input type="submit" name="Submit" value="确定">
                <input type="reset" name="Submit2" value="清除">
              </div>
            </td>
          </tr>
        </table>
    </td>
  </tr>
 </table>
</form>
<SCRIPT>
function addcode(code)
{ var tmp=code
 form1.news.value=form1.news.value+tmp;
 }
</script>

<map name="Map">
 <area shape="rect" coords="1,1,23,23" href="javascript:addcode('[b]文字[/b]');" alt="粗体字">
 <area shape="rect" coords="23,1,45,21" href="javascript:addcode('[i]文字[/i]');" alt="斜体字">
 <area shape="rect" coords="45,1,69,20" href="javascript:addcode('[u]文字[/u]');" alt="下划线文字">
 <area shape="rect" coords="69,1,91,22" href="javascript:addcode('[url=链接地址]说明[/url]');" alt="插入网址">
 <area shape="rect" coords="92,0,115,22" href="javascript:addcode('[email=电子信箱地址]说明[/email]');" alt="插入电子邮件">
 <area shape="rect" coords="115,1,138,22" href="javascript:addcode('[img]图片链接地址[/img]');" alt="插入图片">
</map>
</body>
</html>