fupload.inc

OFFICE办公自动化

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Function GetUpload()
  Dim Result
  Set Result = Nothing
  If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST"
    Dim CT, PosB, Boundary, Length, PosE
    CT = Request.ServerVariables("HTTP_Content_Type")
    If LCase(Left(CT, 19)) = "multipart/form-data" Then
      PosB = InStr(LCase(CT), "boundary=")
      If PosB > 0 Then Boundary = Mid(CT, PosB + 9)
      Length = CLng(Request.ServerVariables("HTTP_Content_Length"))
      If Length > 0 And Boundary <> "" Then
        Boundary = "--" & Boundary
        Dim Head, Binary
        Binary = Request.BinaryRead(Length) 'Reads binary data from client
        Set Result = SeparateFields(Binary, Boundary)
        Binary = Empty
      End If
    End If
  End If
  Set GetUpload = Result
End Function



Function SeparateFields(Binary, Boundary)
  Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
  Dim Fields
  Boundary = StringToBinary(Boundary)
  PosOpenBoundary = InstrB(Binary, Boundary)
  PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

  Set Fields = CreateObject("Scripting.Dictionary")
  Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
   Dim HeaderContent, FieldContent
   Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
   Dim Field, TwoCharsAfterEndBoundary
   PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
   HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)
   FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)
   GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

   Set Field = CreateUploadField()
   Field.Name = FormFieldName
   Field.ContentDisposition = Content_Disposition
   Field.FilePath = SourceFileName
   Field.FileName = GetFileName(SourceFileName)
   Field.ContentType = Content_Type
   Field.Value = FieldContent
   Field.Length = LenB(FieldContent)

   Fields.Add FormFieldName, Field


   TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
   isLastBoundary = TwoCharsAfterEndBoundary = "--"
   If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
      PosOpenBoundary = PosCloseBoundary
      PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
   End If
  Loop
  Set SeparateFields = Fields
End Function


Function BinaryToString(str)
strto = ""
for i=1 to lenb(str)
if AscB(MidB(str, i, 1)) > 127 then
        strto = strto & Chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
        i = i + 1
     else
        strto = strto & Chr(AscB(MidB(str, i, 1)))
     end if
next
BinaryToString=strto
End Function

Function StringToBinary(String)
    Dim I, B
    For I=1 to len(String)
        B = B & ChrB(Asc(Mid(String,I,1)))
    Next 
    StringToBinary = B
End Function


Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
  Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
  Name = (SeparateField(Head, "name=", ";")) 'ltrim
  If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
  FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
  If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
  Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function


Function SeparateField(From, ByVal sStart, ByVal sEnd)
  Dim PosB, PosE, sFrom
  sFrom = LCase(From)
  PosB = InStr(sFrom, sStart)
  If PosB > 0 Then
    PosB = PosB + Len(sStart)
    PosE = InStr(PosB, sFrom, sEnd)
    If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
    If PosE = 0 Then PosE = Len(sFrom) + 1
    SeparateField = Mid(From, PosB, PosE - PosB)
  Else
    SeparateField = Empty
  End If
End Function


Function GetFileName(FullPath)
  Dim Pos, PosF
  PosF = 0
  For Pos = Len(FullPath) To 1 Step -1
    Select Case Mid(FullPath, Pos, 1)
      Case "/", "\": PosF = Pos + 1: Pos = 0
    End Select
  Next
  If PosF = 0 Then PosF = 1
  GetFileName = Mid(FullPath, PosF)
End Function
</SCRIPT>


<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
//The function creates Field object.
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
  this.Name = null
  this.ContentDisposition = null
  this.FileName = null
  this.FilePath = null
  this.ContentType = null
  this.Value = null
  this.Length = null
}
</SCRIPT>