打印本文 打印本文  关闭窗口 关闭窗口
中文的无组件文件上传ASP函数
作者:采集员 文章来源:来源于网络 点击数: 更新时间:2005/9/10 14:20:13
1:
    <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"

上一页  [1] [2] [3]  下一页



打印本文 打印本文  关闭窗口 关闭窗口