Upload & Send Mail Attachments

答案：<%
' This is coded by nick@stilwell.ws
'using the upload.asp example from asp101.com
' and combining it with the mail object to allow
' you upload a pic from your pc and email to anyone anywhere
' at anytime maybe it should be called martini mail
Response.Buffer = true
Function BuildUpload(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
          UploadControl.Add "Value" , Value    
          UploadRequest.Add name, UploadControl    
          BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
    Loop
End Function

Function getByteString(StringStr)
    For i = 1 to Len(StringStr)
          char = Mid(StringStr,i,1)
          getByteString = getByteString & chrB(AscB(char))
    Next
End Function

Function getString(StringBin)
    getString =""
    For intCount = 1 to LenB(StringBin)
          getString = getString & chr(AscB(MidB(StringBin,intCount,1))) 
    Next
End Function

If request("Action")="1" then
    Response.Clear
    byteCount = Request.TotalBytes
    
    RequestBin = Request.BinaryRead(byteCount)
    
    Set UploadRequest = CreateObject("Scripting.Dictionary")

    BuildUpload(RequestBin)
    
    If UploadRequest.Item("blob").Item("Value") <> "" Then

          contentType = UploadRequest.Item("blob").Item("ContentType")
          filepathname = UploadRequest.Item("blob").Item("FileName")
          filename = Right(filepathname,Len(filepathname)-InstrRev(filepathname,"\"))
          FolderName = UploadRequest.Item("where").Item("Value")
          'Response.Write "FolderName: " & FolderName & "<BR>"
          Path = Mid(Request.ServerVariables("PATH_TRANSLATED"), 1, Len(Request.ServerVariables
("PATH_TRANSLATED")) - Len(Request.ServerVariables("PATH_INFO"))) & "\" 
          'Response.Write "Path:" & Path & "<BR>"
     &

上一个：CDONTS & DHCP发E-mail例子
下一个：用cdonts发送邮件的两个函数