多个表单和多个图片一起上传完美解决方案

upload.inc

  1<script language="VBSCRIPT" runat="SERVER">   
  2Function GetUpload(FormData)   
  3Dim DataStart,DivStr,DivLen,DataSize,FormFieldData   
  4''分隔标志串(+CRLF)   
  5DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)   
  6''分隔标志串长度   
  7DivLen = LenB(DivStr)   
  8PosOpenBoundary = InStrB(FormData,DivStr)   
  9PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)   
 10Set Fields = CreateObject("Scripting.Dictionary")   
 11  
 12While PosOpenBoundary > 0 And PosCloseBoundary > 0   
 13''name起始位置(name="xxxxx"),加6是因为[name="]长度为6   
 14FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6   
 15FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart ''(")的ASC值=34   
 16FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))   
 17  
 18''filename起始位置(filename="xxxxx")   
 19FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10   
 20If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then   
 21FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart ''(")的ASC值=34   
 22FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))   
 23Else   
 24FormFileName = ""   
 25End If   
 26  
 27''Content-Type起始位置(Content-Type: xxxxx)   
 28FieldFileCTStart = InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14   
 29If FieldFileCTStart < PosCloseBoundary And FieldFileCTStart > PosOpenBoundary Then   
 30FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart   
 31FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))   
 32Else   
 33FormFileCT = ""   
 34End If   
 35  
 36''数据起始位置:2个CRLF开始   
 37DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4   
 38If FormFileName <> "" Then   
 39''数据长度,减1是因为数据文件的存取字节数问题(可能是AppendChunk方法的问题):   
 40''由于字节数为奇数的图象存到数据库时会去掉最后一个字符导致图象不能正确显示,   
 41''字节数为偶数的数据文件就不会出现这个问题,因此必须保持字节数为偶数。   
 42DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1   
 43FormFieldData = MidB(FormData,DataStart,DataSize)   
 44Else   
 45''数据长度,减2是因为分隔标志串前有一个CRLF   
 46DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2   
 47FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))   
 48End If   
 49  
 50''建立一个Dictionary集存储Form中各个Field的相关数据   
 51Set Field = CreateUploadField()   
 52Field.Name = FormFieldName   
 53Field.FilePath = FormFileName   
 54Field.FileName = GetFileName(FormFileName)   
 55Field.ContentType = FormFileCT   
 56Field.Length = LenB(FormFieldData)   
 57Field.Value = FormFieldData   
 58  
 59Fields.Add FormFieldName, Field   
 60  
 61PosOpenBoundary = PosCloseBoundary   
 62PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)   
 63Wend   
 64Set GetUpload = Fields   
 65End Function   
 66  
 67''把二进制字符串转换成普通字符串函数   
 68Function bin2str(binstr)   
 69Dim varlen,clow,ccc,skipflag   
 70''中文字符Skip标志   
 71skipflag=0   
 72ccc = ""   
 73If Not IsNull(binstr) Then   
 74varlen=LenB(binstr)   
 75For i=1 To varlen   
 76If skipflag=0 Then   
 77clow = MidB(binstr,i,1)   
 78''判断是否中文的字符   
 79If AscB(clow) > 127 Then   
 80''AscW会把二进制的中文双字节字符高位和低位反转,所以要先把中文的高低位反转   
 81ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow))   
 82skipflag=1   
 83Else   
 84ccc = ccc & Chr(AscB(clow))   
 85End If   
 86Else   
 87skipflag=0   
 88End If   
 89Next   
 90End If   
 91bin2str = ccc   
 92End Function   
 93  
 94  
 95''把普通字符串转成二进制字符串函数   
 96Function str2bin(varstr)   
 97str2bin=""   
 98For i=1 To Len(varstr)   
 99varchar=mid(varstr,i,1)   
100varasc = Asc(varchar)   
101'' asc对中文字符求出来的值可能为负数,   
102'' 加上65536就可求出它的无符号数值   
103'' -1在机器内是用补码表示的0xffff,   
104'' 其无符号值为65535,65535=-1+65536   
105'' 其他负数依次类推。   
106If varasc<0 Then   
107varasc = varasc + 65535   
108End If   
109''对中文的处理:把双字节低位和高位分开   
110If varasc>255 Then   
111varlow = Left(Hex(Asc(varchar)),2)   
112varhigh = right(Hex(Asc(varchar)),2)   
113str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)   
114Else   
115str2bin = str2bin & chrB(AscB(varchar))   
116End If   
117Next   
118End Function   
119  
120''取得文件名(去掉Path)   
121Function GetFileName(FullPath)   
122If FullPath <> "" Then   
123FullPath = StrReverse(FullPath)   
124FullPath = Left(FullPath, InStr(1, FullPath, "\") - 1)   
125GetFileName = StrReverse(FullPath)   
126Else   
127GetFileName = ""   
128End If   
129End Function   
130</script>
 1<script language="JSCRIPT" runat="SERVER">   
 2function CreateUploadField(){ return new uf_Init() }   
 3function uf_Init(){   
 4this.Name = null   
 5this.FileName = null   
 6this.FilePath = null   
 7this.ContentType = null   
 8this.Value = null   
 9this.Length = null   
10}   
11</script>

在提交的叶面使用

1<form enctype="multipart/form-data" method="POST">   
2保存的叶面   
3将upload.inc包含   
4<!--#include file="upload.inc"-->   

function lngConvert2(strTemp)
str1=leftb(strTemp,1)
str2=rightb(strTemp,1)
lngConvert2 = clng(ascb(str2) + ((ascb(str1) * 256)))
end function

function lngConvert(strTemp)
str1=leftb(strTemp,1)
str2=rightb(strTemp,1)
len1=ascb(str1)
len2=ascb(str2)
lngConvert = clng(ascb(str1) + ascb(str2) * 256)
end function

Dim FormData,FormSize
FormSize=Request.TotalBytes
FormData=Request.BinaryRead(FormSize)

Set Fields = GetUpload(FormData)
If Fields("newfile").FileName&lt;&gt;"" Then
tempstr=Leftb(Fields("newfile").Value,10)
tstr=chrb(255)&amp;chrb(216)&amp;chrb(255)&amp;chrb(224)&amp;chrb(0)&amp;chrb(16)&amp;chrb(74)&amp;chrb(70)&amp;chrb(73)&amp;chrb(70)
end if

'提交页面的表单内容
txt1=Fields("txt1").Value
txt2=Fields("txt2").Value
txt3=Fields("txt3").Value

Set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from news"
rs.open sql,conn,1,3
'插入纪录
rs.addnew
rs("title")=title
rs("body")=content
rs("pub")=from
rs("up_date")=now()
set field=rs.fields("pic")
field.appendchunk Fields("newfile").Value
'多个图片一样处理
Rs.Update
rs.close
conn.close
set rs=nothing
set conn=nothing

Published At
Categories with Web编程
Tagged with
comments powered by Disqus