WEB开发网
开发学院WEB开发ASP 中文的无组件文件上传ASP函数 阅读

中文的无组件文件上传ASP函数

 2002-09-18 11:09:33 来源:WEB开发网   
核心提示:说明:持中文的无组件文件上传asp函数,由于ASP不支持二进制写入文件,中文的无组件文件上传ASP函数,所以存成文件时必须使用组件,本函数只提供截取上传文件的数据,减2是因为分隔标志串前有一个CRLFDataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
说明:持中文的无组件文件上传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
}

示例

【woozhj】 于 00-4-17 上午 09:37:43 加贴在 Joy ASP ↑:

文件:uploadtest.asp
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>

<body bgcolor="#FFFFFF">
<form method="post" name="form1" enctype="multipart/form-data" action="showdata.asp">
 <p>text1:
  <input type="text" name="text1">
 </p>
 <p>text2:
  <input type="text" name="text2">
 </p>
 <p>txtarea:
  <textarea name="textfield" cols="20" rows="10"></textarea>
 </p>
 <p>file:
  <input type="file" name="newfile">
 </p>
 <p>
  <input type="submit" name="Submit" value="Submit">
  <input type="reset" name="Reset" value="Reset">
 </p>
</form>
</body>
</html>

文件:showdata.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
   FormSize=Request.TotalBytes
   FormData=Request.BinaryRead(FormSize)
   Set Fields = GetUpload(FormData)
   response.write "text1:" & Fields("text1").Value & "<br>" & VbCrLf
   response.write "text2:" & Fields("text2").Value & "<br>" & VbCrLf
   response.write "textarea:" & Fields("textfield").Value & "<br>" & VbCrLf
   response.write Fields("newfile").FileName
   response.write Fields("newfile").ContentType
   Response.ContentType = Fields("newfile").ContentType
   If Fields("newfile").FileName<>"" Then
     Response.ContentType = Fields("newfile").ContentType
     response.binarywrite Fields("newfile").Value
   End If

   'Response.BinaryWrite FormData
  %>

wakeful】 于 00-4-15 下午 08:30:49 加贴在 Joy ASP ↑:
file:upload.asp
<%
' Author Philippe Collignon
' Email PhCollignon@email.com

Sub BuildUploadRequest(RequestBin)
  'Get the boundary
  PosBeg = 1
  PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
  boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
  boundaryPos = InstrB(1,RequestBin,boundary)
  'Get all data inside the boundaries
  Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
    'Members variable of objects are put in a dictionary object
    Dim UploadControl
    Set UploadControl = CreateObject("Scripting.Dictionary")
    'Get an object name
    Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
    Pos = InstrB(Pos,RequestBin,getByteString("name="))
    PosBeg = Pos+6
    PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
    Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
    PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
    PosBound = InstrB(PosEnd,RequestBin,boundary)
    'Test if object is of file type
    If PosFile<>0 AND (PosFile<PosBound) Then
      'Get Filename, content-type and content of file
      PosBeg = PosFile + 10
      PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
      FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
      'Add filename to dictionary object
      UploadControl.Add "FileName", FileName
      Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
      PosBeg = Pos+14
      PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
      'Add content-type to dictionary object
      ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
      UploadControl.Add "ContentType",ContentType
      'Get content of object
      PosBeg = PosEnd+4
      PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
      Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
      Else
      'Get content of object
      Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
      PosBeg = Pos+4
      PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
      Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
    End If
    'Add content to dictionary object
  UploadControl.Add "Value" , Value
    'Add dictionary object to main dictionary
  UploadRequest.Add name, UploadControl
    'Loop to next object
    BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
  Loop

End Sub

'String to byte string conversion
Function getByteString(StringStr)
For i = 1 to Len(StringStr)
   char = Mid(StringStr,i,1)
  getByteString = getByteString & chrB(AscB(char))
Next
End Function

'Byte string to string conversion
Function getString(StringBin)
getString =""
For intCount = 1 to LenB(StringBin)
  getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function
%>

outputfile.asp

<%
' Author Philippe Collignon
' Email PhCollignon@email.com


Response.Expires=0
Response.Buffer = TRUE
Response.Clear
'Response.BinaryWrite(Request.BinaryRead(Request.TotalBytes))
byteCount = Request.TotalBytes
'Response.BinaryWrite(Request.BinaryRead(varByteCount))

RequestBin = Request.BinaryRead(byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

email = UploadRequest.Item("email").Item("Value")

contentType = UploadRequest.Item("blob").Item("ContentType")
filepathname = UploadRequest.Item("blob").Item("FileName")
filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
value = UploadRequest.Item("blob").Item("Value")

'Create FileSytemObject Component
Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")

'Create and Write to a File
pathEnd = Len(Server.mappath(Request.ServerVariables("PATH_INFO")))-14
Set MyFile = ScriptObject.CreateTextFile(Left(Server.mappath(Request.ServerVariables("PATH_INFO")),pathEnd)&"uploaded"&filename)

For i = 1 to LenB(value)
   MyFile.Write chr(AscB(MidB(value,i,1)))
Next

MyFile.Close
%>
<b>Uploaded file : </b><%="uploaded"&filename%><BR>
<img src="<%="uploaded"&filename%>">
<!--#include file="upload.asp"-->

outputclient.asp

<%
' Author Philippe Collignon
' Email PhCollignon@email.com

Response.Buffer = TRUE
Response.Clear

byteCount = Request.TotalBytes

RequestBin = Request.BinaryRead(byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

email = UploadRequest.Item("email").Item("Value")

contentType = UploadRequest.Item("blob").Item("ContentType")
filepathname = UploadRequest.Item("blob").Item("FileName")
filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
value = UploadRequest.Item("blob").Item("Value")
%>

Your email is : <%= email %><BR>
File name of you picture is <%=filepathname%><BR>
File type of your picture is <%=contentType%><BR>

<!--#include file="upload.asp"-->
binaryoutputclient.asp

<%
' Author Philippe Collignon
' Email PhCollignon@email.com

Response.Buffer = TRUE
Response.Clear
byteCount = Request.TotalBytes

RequestBin = Request.BinaryRead(byteCount)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

email = UploadRequest.Item("email").Item("Value")

contentType = UploadRequest.Item("blob").Item("ContentType")
filepathname = UploadRequest.Item("blob").Item("FileName")
filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
picture = UploadRequest.Item("blob").Item("Value")

Response.ContentType = contentType
Response.binaryWrite picture

%>
<!--#include file="upload.asp"-->
uploadform.htm

<!-- Author Philippe Collignon -->
<!-- Email PhCollignon@email.com -->
<HTML>
<HEAD>
  <TITLE>Upload Form</TITLE>
</HEAD>
<BODY>
<B>Output to client</b>
<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="outputClient.asp">
Email : <INPUT TYPE="Text" NAME="email" VALUE="PhCollignon@email.com"><BR>
Picture : <INPUT TYPE="file" NAME="blob"><BR>
<INPUT TYPE="submit" NAME="Enter">
</FORM>
<B>Binary output to client</b>
<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="binaryOutputClient.asp">
Email : <INPUT TYPE="Text" NAME="email" VALUE="PhCollignon@email.com"><BR>
Picture : <INPUT TYPE="file" NAME="blob"><BR>
<INPUT TYPE="submit" NAME="Enter">
</FORM>
<B>Output to file system</b>
<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="outputFile.asp">
Email : <INPUT TYPE="Text" NAME="email" VALUE="PhCollignon@email.com"><BR>
Picture : <INPUT TYPE="file" NAME="blob"><BR>
<INPUT TYPE="submit" NAME="Enter">
</FORM>
</BODY>
</HTML>

Tags:中文 组件 文件

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接