《支持中文的无组件文件上传》-- upload.inc


作者：woozhj

文件名：upload.inc

说明：支持中文的无组件文件上传ASP函数，由于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>