多个表单和多个图片一起上传完美解决方案
upload.inc
<!---------------------> <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> <!----------------------------------------------------> 在提交的叶面使用 <form method="POST" enctype="multipart/form-data"> 上一篇：用EasyMailObject组件处理Exchange邮件源代码(7) 下一篇：asp实现k线图(在线) 更多相关文章
|
推荐文章
精彩文章
|
