//图片上传 <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> Function GetUpload(FormData) Dim DataStart,DivStr,DivLen,DataSize,FormFieldData '分隔标志串(+CRLF) DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1) '分隔标志串长度 DivLen = LenB(DivStr) PosOpenBoundary = InStrB(FormData,DivStr) PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr) Set Fields = CreateObject("Scripting.Dictionary")
While PosOpenBoundary > 0 And PosCloseBoundary > 0 'name起始位置(name="xxxxx"),加6是因为[name="]长度为6 FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6 FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart '(")的ASC值=34 FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))
'filename起始位置(filename="xxxxx") FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10 If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart '(")的ASC值=34 FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize)) Else FormFileName = "" End If
'Content-Type起始位置(Content-Type: xxxxx) FieldFileCTStart = InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14 If FieldFileCTStart < PosCloseBoundary And FieldFileCTStart > PosOpenBoundary Then FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize)) Else FormFileCT = "" End If
'数据起始位置:2个CRLF开始 DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4 If FormFileName <> "" Then '数据长度,减1是因为数据文件的存取字节数问题(可能是AppendChunk方法的问题): '由于字节数为奇数的图象存到数据库时会去掉最后一个字符导致图象不能正确显示, '字节数为偶数的数据文件就不会出现这个问题,因此必须保持字节数为偶数。 DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1 FormFieldData = MidB(FormData,DataStart,DataSize) Else '数据长度,减2是因为分隔标志串前有一个CRLF DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2 FormFieldData = bin2str(MidB(FormData,DataStart,DataSize)) End If
'建立一个Dictionary集存储Form中各个Field的相关数据 Set Field = CreateUploadField() Field.Name = FormFieldName Field.FilePath = FormFileName Field.FileName = GetFileName(FormFileName) Field.ContentType = FormFileCT Field.Length = LenB(FormFieldData) Field.Value = FormFieldData
Fields.Add FormFieldName, Field
PosOpenBoundary = PosCloseBoundary PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr) Wend Set GetUpload = Fields End Function
'把二进制字符串转换成普通字符串函数 Function bin2str(binstr) Dim varlen,clow,ccc,skipflag '中文字符Skip标志 skipflag=0 ccc = "" If Not IsNull(binstr) Then varlen=LenB(binstr) For i=1 To varlen If skipflag=0 Then clow = MidB(binstr,i,1) '判断是否中文的字符 If AscB(clow) > 127 Then 'AscW会把二进制的中文双字节字符高位和低位反转,所以要先把中文的高低位反转 ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow)) skipflag=1 Else ccc = ccc & Chr(AscB(clow)) End If Else skipflag=0 End If Next End If bin2str = ccc End Function
'把普通字符串转成二进制字符串函数 Function str2bin(varstr) str2bin="" For i=1 To Len(varstr) varchar=mid(varstr,i,1) varasc = Asc(varchar) ' asc对中文字符求出来的值可能为负数, ' 加上65536就可求出它的无符号数值 ' -1在机器内是用补码表示的0xffff, ' 其无符号值为65535,65535=-1+65536 ' 其他负数依次类推。 If varasc<0 Then varasc = varasc + 65535 End If '对中文的处理:把双字节低位和高位分开 If varasc>255 Then varlow = Left(Hex(Asc(varchar)),2) varhigh = right(Hex(Asc(varchar)),2) str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh) Else str2bin = str2bin & chrB(AscB(varchar)) End If Next End Function
'取得文件名(去掉Path) Function GetFileName(FullPath) If FullPath <> "" Then FullPath = StrReverse(FullPath) FullPath = Left(FullPath, InStr(1, FullPath, "") - 1) GetFileName = StrReverse(FullPath) Else GetFileName = "" End If End Function </SCRIPT> <SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT> function CreateUploadField(){ return new uf_Init() } function uf_Init(){ this.Name = null this.FileName = null this.FilePath = null this.ContentType = null this.Value = null this.Length = null } </SCRIPT>
//新闻添加 <!--#include file="news_session.asp"--> <html> <head>
<meta http-equiv="Content-Language" content="zh-cn"> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <style type="text/css"> .buttonface { BACKGROUND-COLOR: #0079F2; BORDER-BOTTOM: #333333 1px outset; BORDER-LEFT: #333333 1px outset; BORDER-RIGHT: #ffffff 1px outset; BORDER-TOP: #ffffff 1px outset; COLOR: #ffffff; FONT-SIZE: 9pta { color: #000000; text-decoration: none} </style> <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> <title>新闻发布系统</title> </head> <body bgcolor=#EDF0F5 topmargin=10 marginheight=5 leftmargin=4 marginwidth=0>
<form method="POST" action="news_input.asp" name="form1" enctype="multipart/form-data" LANGUAGE=javascript onsubmit="return form1_onsubmit()"> <div align="left"> <table border="1" width="754" height="404"> <tr align="center"> <td width="754" height="28" colspan="3" style="font-size:11pt"><strong>新闻发布系统后台管理--新闻添加</strong></td> </tr>
<tr> <td width="121" height="16" align="center" style="font-size:9pt">新闻标题</td> <td width="617" height="16" colspan="2"> <input type="text" name="news_title" size="87"></td> </tr> <tr> <td width="121" height="165" align="center" style="font-size:9pt">新闻内容</td> <td width="617" height="165" colspan="2"><textarea rows="11" name="news_content" cols="85"></textarea></td> </tr> <tr> <td width="121" height="21" align="center" style="font-size:9pt">新闻来源</td> <td width="617" height="21" colspan="2"> <input type="text" name="news_src" size="87"></td> </tr> <tr> <td width="121" height="20" align="center" style="font-size:9pt" >图片上传</td> <td width="617" height="20" colspan="2"> <input type="file" name="client1" size="20" readonly LANGUAGE=javascript onblur="return client_onblur(1)" > <span style="font-size:9pt"></span> <INPUT type="hidden" name="server1"> <input type="hidden" value="mysession" name="mysession"> </td> </tr> </table> </div> <p> <input type="submit" value="递交" name="B1" class="buttonface"> <input type="reset" value="全部重写" name="B2" 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_admin1.asp'" name="B2" style="font-size:10pt;color:#000000;" class="buttonface"></p>
</form> </body> </html>
'################### news_input.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 news_title,news_content,news_src,mysession
mysession=Fields("mysession").value if len(mysession)=0 then Response.Write "非法登陆或超时请重新登陆" Response.End end if
news_title=Fields("news_title").value news_title=replace(news_title,"|","|") news_content=Fields("news_content").value news_src=Fields("news_src").value news_src=replace(news_src,"|","|") if len(news_title)=0 then%> <script> alert("出错!新闻标题不能为空"); history.go(-1); //window.location="news_add.asp"; </script> <%Response.end end if
if len(news_content)=0 then%> <script> alert("出错!新闻内容不能为空"); history.go(-1); </script> <%end if
if len(news_src)=0 then%> <script> alert("出错!新闻来源不能为空"); history.go(-1); </script> <%Response.end end if
dim varchar varchar=right(Fields("server1").value,3) if len(varchar)<>0 then if varchar<>"gif" and varchar<>"jpg" then %> <script> alert("出错!不能上传该图片类型"); history.go(-1); </script> <% Response.end else end if end if '###########将图片写入文件夹
set file_O=Server.CreateObject("Scripting.FileSystemObject")
'##########当前时间做图片名 dim newname,mytime,newfile,filename,id,image endname=right(fields("server1").value,4) mytime=now() id=Year(mytime)&Month(mytime)&Day(mytime)&Hour(mytime)&Minute(MyTime)&Second(MyTime) imageid=id&endname
'#############写入图片 newfile="client1" filename=Fields("server1").value
If Fields(newfile).FileName<>"" Then file_name=Server.MapPath("./images/"&imageid&"") set outstream=file_O.CreateTextFile(file_name,true,false) binstr=Fields(newfile).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_O.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
'###################################################################################### 把新闻数据结构写入newslist文件 dim mappath,mytext,myfso,contenttext,news_addtime,news_point news_point=1 news_addtime=mytime set myfso=createobject("scripting.filesystemobject") mappath=server.mappath("./")
set mytext=myfso.opentextfile(mappath&"new_list.asp",8,-1)
dim mytext2 if len(varchar)<>0 then mytext2=trim(id&","&news_title&","&id&".txt"&","&news_src&","&news_point&","&news_addtime&","&imageid&"|") else mytext2=trim(id&","&news_title&","&id&".txt"&","&news_src&","&news_point&","&news_addtime&"|") end if mytext.writeline(mytext2) mytext.close
'##############把新闻内容写入相应的文件中 set contenttext=myfso.OpenTextFile(mappath&"news_content"&id&".txt",8,-1) 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 '############################################################################
contenttext.write htmlencode2(news_content) contenttext.close set myfso=nothing %> <script> alert("发布成功"); window.location="news_add.asp"; </script> //新闻列表显示 <% 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="BACKGROUND-COLOR: #EDF0F5"><%=newscontent%></textarea> <br> </td> </tr> <tr> <td width="119" height="4" style="font-size:9pt">新闻来源</td> <td width="675" height="4"> <input type=text name="newssrc" value="<%=src%>" size="93" class="buttonface2 "> </td> </tr> <tr> <td width="119" height="5" style="font-size:9pt">图片上传</td> <td width="675" height="5"> <input type="file" name="client1" size="20" readonly LANGUAGE=javascript onblur="return client_onblur(1)" ></td> </tr> </table> </div> <p> <input type="submit" value="确认" name="B1" style="font-size: 10pt; 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> |
|