[Resolvido] Enviando email com Upload para anexo

[xanburzum 169]

Usando uma combinação do ASP pure file upload , combinado com um objeto de email agora você pode fazer upload de qualquer arquivo e enviá-lo via e-mail para alguém de sua escolha.

 

<%

Response.Buffer = true
Function BuildUpload(RequestBin)
     'Get boundary
     PosBeg = 1
     PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
     boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
     boundaryPos = InstrB(1,RequestBin,boundary)
     Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
           '  variável são colocados em um objeto dicionário variable of objects are put in a dictionary object
          Dim UploadControl
          Set UploadControl = CreateObject("Scripting.Dictionary")
          'Obter um nome de objeto
          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)
          'Testa Se o objeto for do tipo de arquivo
          If PosFile<>0 AND (PosFile<PosBound) Then
               'Get Filename, content-type e o conteúdo do arquivo
               PosBeg = PosFile + 10
               PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
               FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
               'Adiciona o filename para o objeto dictionary
               UploadControl.Add "FileName", FileName
               Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
               PosBeg = Pos+14
               PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
               'Adiciona content-type para o objeto dictionary
               ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
               UploadControl.Add "ContentType",ContentType
               'Get conteúdo do objeto
               PosBeg = PosEnd+4
               PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
               Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
               Else
               'Get conteúdo do objeto
               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>"
          ToFolder = Path & "\" & FolderName
          value = UploadRequest.Item("blob").Item("Value")
          filename = ToFolder & "\" & filename
          Set MyFileObject = Server.CreateObject("Scripting.FileSystemObject")
          Set objFile = MyFileObject.CreateTextFile(filename)
          'Response.Write "Caminho Salvo " & filename          
          For i = 1 to LenB(value)
               objFile.Write chr(AscB(MidB(value,i,1)))
          Next          
          objFile.Close
          Set objFile = Nothing
          Set MyFileObject = Nothing
     End If
' pega os elementos de outra forma agora
MySubject = UploadRequest.Item("MySubject").Item("Value")
MyTo = UploadRequest.Item("MyTo").Item("Value")
MyText = UploadRequest.Item("MyText").Item("Value")
MyFrom = UploadRequest.Item("MyFrom").Item("Value")
 Set UploadRequest = Nothing
 Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
ObjCDOMail.From = MyFrom
ObjCDOMail.To = MyTo
ObjCDOMail.BodyFormat = 0
ObjCDOmail.Mailformat = 0
ObjCDOMail.Subject = MySubject 
ObjCDOMail.Body = MyText 
'um if para chk para um anexo 
'Tenho certeza há outra maneira, mas isso faz um bom trabalho
If Len(filename) > 5 then 
objCDOMail.AttachFile filename,nikfile 
end if
ObjCDOMail.Send
Set ObjCDOMail = Nothing

Response.Write "seu e-mail foi enviado"
End If%>
<html>
<head>
<title>Email</title>

<style>
.text { font-family: Verdana,Arial;
color: black;
Font-size: 10pt
}
</style>
</head>
<body><form METHOD="POST" ENCTYPE="multipart/form-data" action="mailattachment.asp?Action=1" name="mailform" id="mailform">
<table border="0" align="center" width="350">
	<tr>
		<td class="text" colspan="2">
			<h3>Enviar um e-mail a qualquer pessoa com um anexo</h3>
		</td>
	</tr>
	<tr>
	<tr>
		<td class="text" align="left">De</td>
		<td class="text" align="right"><input class="text" type=text name=MyFrom size="30"></td>
	</tr>
	<tr>
		<td class="text" align="left">Para:</td>
		<td align="right"><input class="text" name="MyTo" size="30"></td>
	</tr>
	<tr>
		<td class="text" align="left">Assunto:</td>
		<td align="right"><input class="text" type=text name=MySubject size="30"></td>
	</tr>
	<tr>
		<td class="text" colspan="2">Digite o texto do seu e-mail abaixo</td>
	</tr>
	<tr>
		<td class="text" colspan="2" align="right"><textarea class="text" rows="7" name="MyText" cols="65"></textarea></td>
	</tr>
	<tr>
		<td colspan="2" class="text" align="center">
			Attach a file: <input TYPE="file" NAME="blob" value>
			<input TYPE="HIDDEN" NAME="where" value="images">
			<! - Alterar o valor deste campo oculto para alterar o diretório de uploads, onde são armazenados ->		</td>
	</tr>
	<tr>
		<td colspan="2" class="text">
			<input class="text" type="submit" Value="Enviar" id=submit1 name=submit1></td>
		</tr>
		<tr>
		
	</tr>
</table>
</form>
</body>
</html>