用文本+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 οnsubmit="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 οnblur="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="帐号修改" οnclick="location.href='admin/news_chadmin.asp'" name="B2" style="font-size:10pt;color:#000000;" class="buttonface"〉
〈input type="button" value="新闻修改" οnclick="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