說明：持中文的無組件文件上傳ASP函數(shù)，由于ASP不支持二進(jìn)制寫入文件，所以存成文件時(shí)必須使用組件，本函數(shù)只提供截取上傳文件的數(shù)據(jù)，可以寫入到數(shù)據(jù)庫。

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Function GetUpload(FormData)
    Dim DataStart,DivStr,DivLen,DataSize,FormFieldData
    '分隔標(biāo)志串(+CRLF)
    DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)
    '分隔標(biāo)志串長度
    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是因?yàn)閇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

       '數(shù)據(jù)起始位置：2個(gè)CRLF開始
       DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4
       If FormFileName <> "" Then
          '數(shù)據(jù)長度，減1是因?yàn)閿?shù)據(jù)文件的存取字節(jié)數(shù)問題(可能是AppendChunk方法的問題)：
          '由于字節(jié)數(shù)為奇數(shù)的圖象存到數(shù)據(jù)庫時(shí)會去掉最后一個(gè)字符導(dǎo)致圖象不能正確顯示,
          '字節(jié)數(shù)為偶數(shù)的數(shù)據(jù)文件就不會出現(xiàn)這個(gè)問題，因此必須保持字節(jié)數(shù)為偶數(shù)。
          DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1
          FormFieldData = MidB(FormData,DataStart,DataSize)
       Else
          '數(shù)據(jù)長度，減2是因?yàn)榉指魳?biāo)志串前有一個(gè)CRLF
          DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
          FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))
       End If

       '建立一個(gè)Dictionary集存儲Form中各個(gè)Field的相關(guān)數(shù)據(jù)
       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

'把二進(jìn)制字符串轉(zhuǎn)換成普通字符串函數(shù)
Function bin2str(binstr)
   Dim varlen,clow,ccc,skipflag
   '中文字符Skip標(biāo)志
   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會把二進(jìn)制的中文雙字節(jié)字符高位和低位反轉(zhuǎn)，所以要先把中文的高低位反轉(zhuǎn)
                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


'把普通字符串轉(zhuǎn)成二進(jìn)制字符串函數(shù)
Function str2bin(varstr)
   str2bin=""
   For i=1 To Len(varstr)
       varchar=mid(varstr,i,1)
       varasc = Asc(varchar)
       ' asc對中文字符求出來的值可能為負(fù)數(shù)，
       ' 加上65536就可求出它的無符號數(shù)值
       ' -1在機(jī)器內(nèi)是用補(bǔ)碼表示的0xffff,
       ' 其無符號值為65535,65535=-1+65536
       ' 其他負(fù)數(shù)依次類推。
       If varasc<0 Then
          varasc = varasc + 65535
       End If
       '對中文的處理：把雙字節(jié)低位和高位分開
       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)的數(shù)據(jù)長度
      'Fields("xxx").Value 取得Form中xxx(Form Object)的數(shù)據(jù)內(nèi)容
      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>