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〉
　　//新闻列表显示