中文XML论坛--[转帖]用文本+ASP打造新闻发布系统

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

作者：中国论坛网收集来源：http://www.51one.net
----------------------------------------------------------
用文本+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>
----------------------------------------------------------------------
用文本+ASP打造新闻发布系统(二)新闻添加

<html>
<head>

//-->
</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

<%
'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>
----------------------------------------------------------------------------------------

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

用文本+ASP打造新闻发布系统(三)新闻列表显示
<%
    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

%>
--------------------------------------------------------------------------------
用文本+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%>

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

用文本+ASP打造新闻发布系统(五)新闻修改
‘#######news_update.asp

<SCRIPT ID=clientEventHandlersJS LANGUAGE=javascript>
<!--

//-->
</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>

    <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


<%
'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

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>
---------------------------------------------------------------------------------------------

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

用文本+ASP打造新闻发布系统。几点补充
1。这里略去密码验证
密码保存在一个password_admin.asp的文件里
我的是这样的：
<%response.end%>|mysoso|mysoso
注意要加<%response.end%>作用相信大家都懂
2.要注意"|"编码防子用户输入|导致程序读取出错
3。程序中字符处理函数是刘子良写的在此感谢（我做了一点点修改)
4。关于那个动态数组的问题如果大家有办法请，告诉我谢谢
联系
so8so@21cn.com

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

大数据量性能如何？偶发现用文本文件记录留言信息，大数据量速度很慢。

姓名：(无权查看)
城市：(无权查看)
院校：(无权查看)

不好意思，这个我没有试过。
不过。如果你的数据库真的很大的话。
可以与SQL连接。
谢谢！！


	W 3 C h i n a ( since 2003 ) 旗下站点苏ICP备05006046号《全国人大常委会关于维护互联网安全的决定》《计算机信息网络国际联网安全保护管理办法》	296.875ms