用文本+ASP打造旧事发布系统
用文本+ASP打造旧事发布系统
//图片上传
〈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〉〈li〉〈/SPAN〉〈span〉〈a href='news_view.asp?id=" & j(0) & "' target=blank〉" & j(1) & "(图)〈/a〉 点击:" & j(4)&"次 最后发布工夫:"&j(5)&"〈/span〉"
else
b(i)="〈SPAN〉〈li〉〈/SPAN〉〈span〉〈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〉旧事起源:〈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〉
