//图片上传

〈 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