asp编程实例:用文本+ASP打造新闻发布系统2

　　〈%
　　dim myfso,myread
　　set myfso=createobject("scripting.filesystemobject")
　　set myread=myfso.opentextfile(server.mappath("./new_list.asp"),1,0)
　　if myread.atendofstream then
　　Response.Write "目前没有添加新闻"
　　Response.End
　　else
　　dim mytext,listarray
　　mytext=myread.readall
　　listarray=split(mytext,"|") ‘#######把所有记录分割成一个数组a
　　dim recordcount,pagecount, pagesize, pagenum
　　recordcount=ubound(listarray)‘############记录条数
　　pagesize=2
　　pagecount=recordcount/pagesize ‘#######取得页面数
　　if instr(1,pagecount,".")=null or instr(1,pagecount,".")=0 then
　　pagenum=pagecount
　　else
　　pagenum=int(pagecount)+1
　　end if
　　dim topage
　　topage=cint(Request.QueryString ("topage")) ‘########取得要显示的页面
　　if topage〈=0 then
　　topage=1
　　end if
　　if topage〉pagenum then
　　topage=pagenum
　　end if
　　dim i,j,n
　　b=listarray
　　for i=0 to recordcount-1 ‘########把每一条记录组成一个数组
　　j=split(listarray(i),",")
　　if ubound(j)=6 then
　　b(i)="〈SPAN style=‘COLOR: #ffbd00; FONT-SIZE: 7px‘〉〈li〉〈/SPAN〉〈span style=‘font-size:10pt‘〉〈a href=‘news_view.asp?id=" & j(0) & "‘ target=blank〉" & j(1) & "(图)〈/a〉 点击:" & j(4)&"次 最后发布时间:"&j(5)&"〈/span〉"
　　else
　　b(i)="〈SPAN style=‘COLOR: #ffbd00; FONT-SIZE: 7px‘〉〈li〉〈/SPAN〉〈span style=‘font-size:10pt‘〉〈a href=‘news_view.asp?id=" & j(0) & "‘ target=blank〉" & j(1) & "〈/a〉 点击:" & j(4)&"次 最后发布时间:"&j(5)&"〈/span〉"
　　end if
　　next
　　‘########把记录反排序存储在新的数组实现按时间反排序
　　dim c(100)
　　n=0
　　for i=recordcount to 0 step -1
　　c(n)=b(i)
　　n=n+1
　　next
　　dim currentrecord
　　currentrecord=pagesize*(topage-1)+1 ‘#########显示每一页
　　for k=1 to pagesize
　　if len(c(currentrecord))=0 then
　　exit for
　　end if
　　Response.Write c(currentrecord)&"〈br〉"
　　currentrecord=currentrecord+1
　　next
　　Response.Write "〈body bgcolor=#EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0〉"
　　for m=1 to pagenum
　　response.write "〈span style=font-size:10pt〉〈a href=news_list.asp?topage="&m&"〉"&m&"〈/a〉〈/span〉 "
　　next
　　end if%>
　　//新闻删除
　　〈!--#include file="news_session.asp"--〉
　　〈%
　　dim id
　　id=Request.QueryString ("id")
　　dim myfso
　　set myfso=createobject("scripting.filesystemobject")
　　if myfso.FileExists(server.mappath("./news_content/"&id&".txt"))then
　　myfso.DeleteFile (server.mappath("./news_content/"&id&".txt"))‘#############删除新闻内容
　　end if
　　dim mytext2,myread2
　　set myread2=myfso.opentextfile(server.mappath("./new_list.asp"),1,0)
　　if myread2.atendofstream then
　　Response.Write "没有新闻内容"
　　myread2.close
　　Response.End
　　end if
　　mytext2=myread2.readall
　　myread2.close
　　dim listarray,i,h,count,sf,title
　　listarray=split(mytext2,"|") ‘#########读取记录并以#分割成listarray数组
　　count=ubound(listarray)
　　for i=0 to count ‘###########根据ID找到该新闻实现删除功能
　　sf=split(listarray(i),",")
　　if right(sf(0),7)=right(id,7) then
　　dim thisid
　　thisid=i
　　‘#######为6说明上传了图片,删除新闻图片和该列表记录
　　if ubound(sf)=6 then
　　myfso.deletefile(server.MapPath ("./images/"&sf(6)))
　　end if
　　exit for
　　end if
　　next
　　dim mytext,mappath
　　mappath=server.mappath("./")
　　set mytext=myfso.createtextfile(mappath&"\new_list.asp",-1,0)
　　for i=0 to thisid-1‘ ##########把所有数据重新写入文件
　　mytext.write listarray(i)&"|"
　　next
　　for i=thisid+1 to ubound(listarray)
　　if i=ubound(listarray) then
　　mytext.write listarray(i)
　　exit for
　　else
　　mytext.write listarray(i)&"|"
　　end if
　　next
　　mytext.close
　　%〉
　　〈script language="javascript"〉
　　alert("删除成功");
　　location.href =("news_admin1.asp");
　　〈/script〉
　　---------------
　　news_view.asp
　　〈% Response.Expires=0
　　dim myid,myfso,myread,mytext1
　　myid=request.querystring("id")
　　if len(myid)=0 then
　　Response.Write "没有该新闻"
　　Response.End
　　end if
　　set myfso=createobject("scripting.filesystemobject")
　　set myread=myfso.opentextfile(server.mappath("./news_content/"&myid&".txt"),1,0)
　　if myread.atendofstream then
　　Response.Write "没有新闻内容"
　　Response.End
　　else
　　mytext1=myread.readall ‘#######打开对应的新闻内容文件,并读取用变量存储
　　function htmlencode2(str)‘###########字符处理函数
　　dim result
　　dim l
　　l=len(str)
　　result=""
　　dim i
　　for i = 1 to l
　　select case mid(str,i,1)
　　case chr(34)
　　result=result+""""
　　case "&"
　　result=result+"&"
　　case chr(13)
　　result=result+"〈br〉"
　　case " "
　　result=result+" "
　　case chr(9)
　　result=result+" "
　　case chr(32)
　　result=result+" "
　　if i+1〈=l and i-1〉0 then
　　if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
　　result=result+" "
　　else
　　result=result+" "
　　end if
　　else
　　result=result+" "
　　end if
　　case else
　　result=result+mid(str,i,1)
　　end select
　　next
　　htmlencode2=result
　　end function
　　myread.close
　　end if
　　dim mytext2,myread2
　　set myread2=myfso.opentextfile(server.mappath("./new_list.asp"),1,0)
　　if myread2.atendofstream then
　　Response.Write "没有新闻内容"
　　Response.End
　　else
　　mytext2=myread2.readall
　　myread2.close
　　dim listarray,i,h
　　listarray=split(mytext2,"|") ‘#########读取记录并以#分割成listarray数组
　　dim count,sf,title,src
　　count=ubound(listarray)
　　for i=0 to count ‘###########根据ID找到该新闻并把文章点击次数加1
　　sf=split(listarray(i),",")
　　if right(sf(0),7)=right(myid,7) then
　　title=sf(1)
　　src=sf(3)
　　sf(4)=sf(4)+1
　　‘#######为6说明上传了图片,存储为新的数组
　　if ubound(sf)=6 then
　　listarray(i)=sf(0)&","&sf(1)&","&sf(2)&","&sf(3)&","&sf(4)&","&sf(5)&","&sf(6)
　　dim mypic
　　mypic=sf(6)
　　else
　　listarray(i)=sf(0)&","&sf(1)&","&sf(2)&","&sf(3)&","&sf(4)&","&sf(5)
　　end if
　　‘##################
　　exit for
　　end if
　　next
　　dim k,mytext,mappath
　　mappath=server.mappath("./")
　　set mytext=myfso.createtextfile(mappath&"\new_list.asp",-1,0)
　　for i=0 to ubound(listarray)‘ ##########把所有数据重新写入文件
　　if i=ubound(listarray) then
　　mytext.write listarray(i)
　　else
　　mytext.write listarray(i)&"|"
　　end if
　　next
　　Response.Write "〈body bgcolor=#EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0〉"
　　Response.Write"〈div align=center style=font-size:13pt〉〈strong〉"&title&"〈/strong〉〈span〉〈/div〉〈br〉"
　　Response.Write "〈hr size=1〉"
　　if len(mypic)〈〉0 then
　　Response.write "〈center〉〈img src=‘./images/"&mypic&"‘〉〈/center〉"
　　end if
　　Response.Write "〈span style=font-size:10pt〉"&htmlencode2(mytext1)&"〈/span〉"
　　Response.Write "〈br〉〈div align=right style=‘font-size:9pt‘〉新闻来源:〈font color=red〉"&src&"〈/font〉〈/div〉"
　　%〉
　　〈OBJECT id=closes type="application/x-oleobject" classid="clsid:adb880a6-d8ff-11cf-9377-00aa003b7a11"〉
　　〈param name="Command" value="Close"〉
　　〈/object〉
　　〈center〉〈input type="button" value="关闭窗口" onclick="closes.Click();"〉〈/center〉
　　〈% end if%〉
　　//新闻修改
　　‘#######news_update.asp
　　〈!--#include file="news_session.asp"--〉
　　〈SCRIPT ID=clientEventHandlersJS LANGUAGE=javascript〉
　　〈!--
　　function client_onblur(ii) {
　　server=eval("form1.server"+ii)
　　if(server.value==""){
　　client=eval("form1.client"+ii)
　　clientvalue=client.value+""
　　varlen=clientvalue.length
　　a=clientvalue.lastIndexOf(‘\\‘)
　　clientvalue=clientvalue.substring(a+1)
　　//alert(clientvalue);
　　server.value=clientvalue
　　}
　　}
　　function form1_onsubmit() {
　　for(i=1;i〈1;i++){
　　client=eval("form1.client"+i)
　　server=eval("form1.server"+i)
　　if(client.value!="" && server.value==""){alert("上传后的文件名不能空！");server.focus();return false}
　　}
　　}
　　//--〉
　　〈/SCRIPT〉
　　〈% dim myid
　　myid=Request.QueryString ("id")
　　if len(myid)=0 then
　　Response.Write "没有该新闻"
　　Response.End
　　end if
　　dim myfso,myread,mytext,newscontent
　　‘#######打开对应的新闻内容文件,并读取用变量存储
　　set myfso=createobject("scripting.filesystemobject")
　　if myfso.FileExists (server.mappath("./news_content/"&myid&".txt")) then
　　set myread=myfso.opentextfile(server.mappath("./news_content/"&myid&".txt"),1,0)
　　newscontent=myread.readall
　　myread.close
　　newscontent=replace(newscontent,"〈br〉",chr(13))
　　newscontent=replace(newscontent," "," ")
　　newscontent=replace(newscontent," ",chr(32))
　　newscontent=replace(newscontent,"‘‘ ",chr(34))
　　else
　　Response.Write "该新闻已被删除"
　　Response.End
　　end if
　　dim mytext2,myread2 ‘#######打开新闻列表文件
　　set myread2=myfso.opentextfile(server.mappath("./new_list.asp"),1,0)
　　if myread2.atendofstream then
　　Response.Write "没有新闻内容"
　　Response.End
　　end if
　　mytext2=myread2.readall
　　dim listarray
　　listarray=split(mytext2,"|") ‘#########读取记录并以#分割成listarray数组
　　dim count,sf,i,title,src
　　count=ubound(listarray)
　　for i=0 to count ‘###########根据ID找到该新闻并用变量存储给新闻的标题
　　sf=split(listarray(i),",")
　　if right(sf(0),7)=right(myid,7) then
　　title=sf(1)
　　src=sf(3)
　　exit for
　　end if
　　next
　　%〉
　　〈head〉
　　〈style〉
　　td {font-size:9pt}
　　INPUT.buttonface {
　　BACKGROUND-COLOR: #0079F2; BORDER-BOTTOM: #333333 1px outset; BORDER-LEFT: #333333 1px outset; BORDER-RIGHT: #ffffff 1px outset; BORDER-TOP: #ffffff 1px inset; COLOR: black; FONT-SIZE: 9pta { color: #000000; text-decoration: none}
　　.text {font-size:11pt}
　　INPUT.buttonface2 {
　　BACKGROUND-COLOR: #EDF0F5; COLOR: black; FONT-SIZE: 9pta { color: #000000; text-decoration: none}
　　a:hover { color: white; text-decoration: underline overline; background: #007EBB}
　　.text {font-size:11pt}
　　〈/style〉
　　〈/head〉
　　〈body bgcolor=#EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0〉
　　〈form method="POST" action="news_updateing.asp" name="form1" enctype="multipart/form-data" onsubmit="return form1_onsubmit()"〉
　　〈div align="left"〉
　　〈table border="1" width="752" height="240" cellspacing="0" cellpadding="0"〉
　　〈tr〉
　　〈td colspan="2" height="12" align="center" width="800" style="font-size:12pt"〉〈strong〉新闻发布系统后台管理--新闻修改〈/strong〉〈/td〉
　　〈/tr〉
　　〈tr〉
　　〈td width="119" height="12" style="font-size:9pt"〉新闻标题〈/td〉
　　〈td width="675" height="12"〉
　　〈input type="text" name="newtitle" size="94" value="〈%=title%〉" class="buttonface2 "〉
　　〈/td〉
　　〈/tr〉
　　〈tr〉
　　〈td width="119" height="213" style="font-size:9pt"〉
　　新〈br〉
　　闻〈br〉
　　内〈br〉
　　容〈/td〉
　　〈td width="675" height="213"〉
　　〈textarea rows="14" name="newcontent" cols="93" style=" color: #000000; " class="buttonface"〉
　　〈input type="reset" value="全部重写" name="B2" style="font-size:10pt;color:#000000;" class="buttonface"〉
　　〈input type="button" value="帐号修改" onclick="location.href=‘admin/news_chadmin.asp‘" name="B2" style="font-size:10pt;color:#000000;" class="buttonface"〉
　　〈input type="button" value="新闻添加" onclick="location.href=‘news_add.asp‘" name="B2" style="font-size:10pt;color:#000000;" class="buttonface"〉〈/p〉
　　〈input type=hidden name="myid" value="〈%=myid%〉"〉
　　〈INPUT type="hidden" name="server1"〉
　　〈input type="hidden" name="mysession" value="mysession"〉
　　〈/form〉
　　##########
　　news_updating.asp
　　〈!--#include file="news_session.asp"--〉
　　〈!--#include file="upload.inc"--〉
　　〈%
　　‘Fields("xxx").Name 取得Form中xxx(Form Object)的名字
　　‘Fields("xxx").FilePath 如果是file Object 取得文件的完整路径
　　‘Fields("xxx").FileName 如果是file Object 取得文件名
　　‘Fields("xxx").ContentType 如果是file Object 取得文件的类型
　　‘Fields("xxx").Length 取得Form中xxx(Form Object)的数据长度
　　‘Fields("xxx").Value 取得Form中xxx(Form Object)的数据内容
　　Dim FormData,FormSize,gnote,bnote,notes,binlen,binstr
　　FormSize=Request.TotalBytes
　　FormData=Request.BinaryRead(FormSize)
　　Set Fields = GetUpload(FormData)
　　‘############判断输入错误
　　dim mytitle,content,src,id,mysession
　　mysession=Fields("newtitle").value
　　if len(mysession)=0 then
　　Response.Write "非法登陆或超时间,请重新登陆"
　　Response.End
　　end if
　　mytitle=Fields("newtitle").value
　　mytitle=replace(mytitle,"|","|")
　　mytitle=replace(mytitle,"〈br〉","")
　　content=Fields("newcontent").value
　　src=Fields("newssrc").value
　　src=replace(src,"|","|")
　　src=replace(src,"〈br〉","")
　　id=trim(right(Fields("myid").value,12))
　　if len(mytitle)=0 then
　　Response.Write "〈script〉"
　　Response.Write "alert(‘出错!新闻标题不能为空!‘);"
　　Response.Write"location.href=history.go(-1);"
　　Response.Write "〈/script〉"
　　end if
　　if len(content)=0 then
　　Response.Write "〈script〉"
　　Response.Write "alert(‘出错!新闻内容不能为空!‘);"
　　Response.Write"location.href=history.go(-1);"
　　Response.Write "〈/script〉"
　　end if
　　if len(src)=0 then
　　Response.Write "〈script〉"
　　Response.Write "alert(‘出错!新闻来源不能为空!‘);"
　　Response.Write"location.href=history.go(-1);"
　　Response.Write "〈/script〉"
　　end if
　　‘############################################################################################图片更该功能的实现
　　newfile="client1"
　　If Fields(newfile).FileName〈〉"" Then
　　set file_0=Server.CreateObject("Scripting.FileSystemObject")
　　dim contextname
　　contextname=right(Fields("client1").FileName,4)
　　imageid=id&contextname
　　if contextname〈〉".gif" and contextname〈〉".jpg" then ‘#########判断上传文件格式
　　Response.Write "〈script〉"
　　Response.Write "alert(‘出错!上传文件格式不对 只能为jpg/gif图片格式!‘);"
　　Response.Write"location.href=history.go(-1);"
　　Response.Write "〈/script〉"
　　end if
　　file_name=Server.MapPath("./images/"&imageid&"")
　　‘#####################################上海诚凯男子医院程序提醒：如果原来有图片文件主名为id的则删除该图片
　　if file_0.fileexists(server.MapPath ("./images/"&id&".gif")) then
　　Set f3 = file_0.GetFile(server.MapPath ("./images/"&id&".gif"))
　　f3.Delete
　　end if
　　if file_0.fileexists(server.MapPath ("./images/"&id&".jpg")) then
　　Set f3 = file_0.GetFile(server.MapPath ("./images/"&id&".jpg"))
　　f3.Delete
　　end if
　　‘########################################写入图片
　　set outstream=file_0.openTextFile(file_name,8,-1)
　　binstr=Fields("client1").Value
　　binlen=1
　　varlen=lenb(binstr)
　　for i=1 to varlen
　　clow = MidB(binstr,i,1)
　　If AscB(clow) = 255 then
　　outstream.write chr(255)
　　binlen=binlen+1
　　if (i mod 2)=0 then
　　notes=gnote
　　exit for
　　end if
　　elseif AscB(clow) 〉 128 then
　　clow1=MidB(binstr,i+1,1)
　　if AscB(clow1) 〈64 or AscB(clow1) =127 or AscB(clow1) = 255 then
　　binlen=binlen+1
　　‘if (binlen mod 2)=0 then
　　binlen=binlen+1
　　outstream.write Chr(AscW(ChrB(128)&clow))
　　‘end if
　　notes=bnote
　　exit for
　　else
　　outstream.write Chr(AscW(clow1&clow))
　　binlen=binlen+2
　　i=i+1
　　if (i mod 2)=0 then
　　notes=gnote
　　exit for
　　end if
　　end if
　　else
　　outstream.write chr(AscB(clow))
　　binlen=binlen+1
　　if (i mod 2)=0 then
　　notes=gnote
　　exit for
　　end if
　　end if
　　next
　　outstream.close
　　set outstream=file_0.OpenTextFile(file_name,8,false,-1)
　　outstream.write midb(Fields(newfile).Value,binlen)
　　outstream.close
　　if notes=bnote then notes=notes&(binlen-1)&"字节处。"
　　End If
　　‘#######################################################################################################
　　dim myfso,mywrite ‘#######修改新闻详细内容
　　set myfso=createobject("scripting.filesystemobject")
　　if myfso.FileExists(server.mappath("./news_content/"&id&".txt")) then
　　myfso.DeleteFile (server.mappath("./news_content/"&id&".txt"))
　　end if
　　set mywrite=myfso.createtextfile(server.mappath("./news_content/"&id&".txt"),-1,0)
　　mywrite.write content
　　dim mytext2,myread2 ‘#########修改新闻的标题来源
　　set myread2=myfso.opentextfile(server.mappath("./new_list.asp"),1,0)
　　mytext2=myread2.readall
　　dim listarray,i,h,count,sf
　　listarray=split(mytext2,"|") ‘#########读取记录并以#分割成listarray数组
　　count=ubound(listarray)
　　for i=0 to count ‘###########根据ID找到该新闻记录
　　sf=split(listarray(i),",")
　　if right(sf(0),7)=right(id,7) then
　　sf(1)=mytitle
　　sf(3)=src
　　‘#######为6说明上传了图片,存储新的数组实现查看记录点击次数加1
　　if ubound(sf)=6 then
　　If Fields(newfile).FileName〈〉"" Then
　　sf(6)=imageid
　　end if
　　listarray(i)=sf(0)&","&sf(1)&","&sf(2)&","&sf(3)&","&sf(4)&","&sf(5)&","&sf(6)
　　else
　　listarray(i)=sf(0)&","&sf(1)&","&sf(2)&","&sf(3)&","&sf(4)&","&sf(5)
　　end if
　　‘##################
　　exit for
　　end if
　　next
　　function htmlencode2(str) ‘#############字符处理函数
　　dim result
　　dim l
　　l=len(str)
　　result=""
　　dim i
　　for i = 1 to l
　　select case mid(str,i,1)
　　case chr(34)
　　result=result+"‘‘"
　　case "&"
　　result=result+"&"
　　case chr(13)
　　result=result+"〈br〉"
　　case " "
　　result=result+" "
　　case chr(9)
　　result=result+" "
　　case chr(32)
　　if i+1〈=l and i-1〉0 then
　　if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
　　result=result+" "
　　else
　　result=result+" "
　　end if
　　else
　　result=result+" "
　　end if
　　case else
　　result=result+mid(str,i,1)
　　end select
　　next
　　htmlencode2=result
　　end function
　　‘##########################
　　dim k,mytext,mappath
　　mappath=server.mappath("./")
　　set mytext=myfso.createtextfile(mappath&"\new_list.asp",-1,0)
　　for i=0 to ubound(listarray)‘ ##########把所有数据重新写入文件
　　if i=ubound(listarray) then
　　mytext.write htmlencode2(listarray(i))
　　else
　　mytext.write htmlencode2(listarray(i)&"|")
　　end if
　　next
　　%〉
　　〈script language="javascript"〉
　　alert("更改成功");
　　window.location=("news_admin1.asp");
　　〈/script〉