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

  //图片上传
  〈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〉
  //新闻列表显示

郑重声明:本站内容如果来自互联网及其他传播媒体,其版权均属原媒体及文章作者所有。转载目的在于传递更多信息及用于网络分享,并不代表本站赞同其观点和对其真实性负责,也不构成任何其他建议。