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

网络整理 - 09-14
    
  
  关键词:ASP
  
  作者: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>
  
  (转自chinaasp)