Enviar email pelo programa - AtualizaÃ§Ã£o

ricardomouramarques · January 16, 2011

Olha sÃ³, antes de mais nada informo que o cÃ³digo original Ã© do "Alessandro Seribeli Barreto - Ale SB", eu sÃ³ fiz algumas modificaÃ§Ãµes e inclui alguas opÃ§Ãµes.

Ao Ale SB, parabÃ©ns pelo cÃ³digo.

O que modifiquei:

- Possibilidade de enviar email de de vÃ¡rios Servidores (hotmail, bol, uol, gmail, yahoo, etc).

- Envio de email para mais de um destinatÃ¡rio

- CC (com cÃ³pia)

- CCO (com cÃ³pia oculta)

- Escolha do(s) arquivo(s) a indexar

- Editar o assunto

- Editar a mensagem

Pra quem precisa, acredito que seja um bom ponto de partida.

***********************************************************

#include "fivewin.ch"

Static cAttach := ""

Static aAttach := {}

********************************************************************************

Function Main()

local cUser := Space(50), cPass := Space(15), cRemt := Space(50), ;

cDest := Space(250), cTime, cTxt := Space(10), cAssunto := Space(100),;

cCC := Space(250), cCCO := Space(250)

local lSair := .f.

local oDlg, oGet[ 8 ], oSay[12], oBtn[2], nItem := 0

local cDados, i

Private aServs := { {"@hotmail.com", "smtp.live.com", 25, .t. },;

{"@yahoo.com.br", "smtp.mail.yahoo.com.br", 25, .f. },;

{"@gmail.com.br", "smtp.gmail.com.br", 465, .t. },;

{"@uol.com.br", "smtp.uol.com.br", 25, .f. },;

{"@bol.com.br", "smtp.bol.com.br", 25, .f. },;

{"@terra.com.br", "smtp.terra.com.br", 25, .f. },;

{"@ig.com.br", "smtp.ig.com.br", 465, .t. },;

{"@ibest.com.br", "smtp.ibest.com.br", 465, .t. },;

{"@itelefonica.com.br","smtp.itelefonica.com.br", 25, .f. } }

Private aDomin := {}, nServ := 1

for i := 1 to len( aServs )

AADD( aDomin, aServs[1] )

next

if file("dadosmail.dat")

cDados := StrTran(MemoRead( "dadosmail.dat" ), "@hotmail.com", "")

cUser := Memoline( cDados, 250, 1)

cRemt := Memoline( cDados, 250, 2)

if MlCount( cDados ) >= 3

nServ := Val(Alltrim(Memoline(cDados, 250, 3)))

endif

DEFINE DIALOG oDlg TITLE "Envio de eMail" From 0, 0 to 620, 600 Pixel

*****--- SAY's ---**************************************************************

@ 002, 006 SAY oSay[1] PROMPT "UsuÃ¡rio - Somente o Nome" OF oDlg SIZE 100, 08 COLOR CLR_BLUE PIXEL

@ 022, 006 SAY oSay[3] PROMPT "Senha" OF oDlg SIZE 50, 08 COLOR CLR_BLUE PIXEL

@ 042, 006 SAY oSay[4] PROMPT "Remetente - Somente o Nome" OF oDlg SIZE 100, 08 COLOR CLR_BLUE PIXEL

@ 052, 088 SAY oSay[2] PROMPT aDomin[nServ] OF oDlg SIZE 50, 08 COLOR CLR_BLACK PIXEL

@ 064, 006 SAY oSay[5] PROMPT "Para:" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL

@ 074, 006 SAY oSay[10] PROMPT "C/C:" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL

@ 084, 006 SAY oSay[11] PROMPT "C/CO:" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL

@ 094, 006 SAY oSay[9] VAR "Assunto" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL update

@ 124,006 SAY oSay[7] VAR "Mensagem" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update

@ 210,006 SAY oSay[ 8 ] VAR "Anexos" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update

@ 270,006 SAY oSay[6] VAR cTime OF oDlg SIZE 50, 08 COLOR CLR_RED PIXEL update

*****OUTROS*************************************************************

@ 010, 006 GET oGet[1] VAR cUser SIZE 80, 10 PIXEL OF oDlg PICTURE "@" Update

oGet[1]:bValid := {|lRet| if(lRet := !Empty(cUser),(oGet[3]:VarPut(cUser), oGet[3]:Refresh()), ), .t. }

@ 010, 088 COMBOBOX oComb VAR nServ ITEMS aDomin OF oDlg SIZE 100, 80 PIXEL;

ON CHANGE (oSay[2]:SetText( aDomin[nServ] ) )

@ 030, 006 GET oGet[2] VAR cPass SIZE 80, 10 PIXEL OF oDlg Update

oGet[2]:lPassWord := .T.

@ 050, 006 GET oGet[3] VAR cRemt SIZE 80, 10 PIXEL OF oDlg PICTURE "@" Update

@ 062, 040 GET oGet[4] VAR cDest SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

@ 072, 040 GET oGet[5] VAR cCC SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

@ 082, 040 GET oGet[6] VAR cCCO SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

@ 092, 040 GET oGet[6] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

@ 132,006 GET oGet[5] VAR cTxt OF oDlg SIZE 288, 70 COLOR CLR_BLUE, CLR_WHITE PIXEL update MEMO

@ 218,006 ListBox oList Var nItem ITEMS aAttach Size 268,50 Pixel

*****--- BOTÃ•ES ---*************************************************************

@ 290, 010 BUTTONBMP oBtn[1] PROMPT "Confirma" OF oDlg ;

SIZE 30,10 PIXEL ;

ACTION ( cTime := "Aguarde...", oSay[6]:Refresh(), ;

if( lRet := Config_Mail(Lower(alltrim(cUser)),Alltrim(cPass),Lower(Alltrim(cRemt)),;

Lower(Alltrim(cDest)),Lower(Alltrim(cCC)),Lower(Alltrim(cCCO)), cTxt, cAssunto ), ;

MsgInfo("Mensagem Enviada com Sucesso!","AtenÃ§ao"),), cTime := "", oSay[6]:Refresh() )

oBtn[1]:bWhen := {|| !Empty(cUser) }

@ 290, 050 BUTTONBMP oBtn[2] PROMPT "Sair" OF oDlg ;

SIZE 30,10 PIXEL ;

ACTION ( lSair := .t., oDlg:End() )

oBtn[2]:lCancel := .t.

@ 218, 274 Button "ADD" Size 20,08 Pixel Action ADDItem()

@ 228, 274 Button "DEL" Size 20,08 Pixel Action DELItem()

ACTIVATE DIALOG oDlg CENTERED VALID lSair

return nil

********************************************************************************

Function Config_Mail(_cUser,cPass,_cRemt,cDest, cCC, cCCO, cTxt, cSubject)

local lRet := .f.

local oCfg, oError

local cServ := aServs[nServ][2] //--> SERVIDOR SMTP - "smtp.servidor.com.br"

local nPort := aServs[nServ][3]

local lAut := .t.

local lSSL := aServs[nServ][4]

if Empty(cPass) .or. Empty(_cRemt) .or. Empty(cDest)

? "Preencha todos Campos"

return .f.

else

cUser := alltrim(_cUser) + aDomin[nServ]

cRemt := alltrim(_cRemt) + aDomin[nServ]

endif

TRY

oCfg := CREATEOBJECT( "CDO.Configuration" )

WITH OBJECT oCfg:Fields

:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServ

:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := nPort

:Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2

:Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := lAut

:Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lSSL

:Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := cUser

:Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := cPass

:Update()

END WITH

lRet := .t.

CATCH oError

MsgInfo( "NÃ£o Foi possÃvel Enviar o e-Mail!" +CRLF+ ;

"Error: " + Transform(oError:GenCode, nil) + ";" +CRLF+ ;

"SubC: " + Transform(oError:SubCode, nil) + ";" +CRLF+ ;

"OSCode: " + Transform(oError:OsCode, nil) + ";" +CRLF+ ;

"SubSystem: " + Transform(oError:SubSystem, nil) + ";" +CRLF+ ;

"Mensaje: " + oError:Description, "AtenÃ§Ã£o" )

END

//--> FIM DAS CONFIGURAÃ‡OES.

if lRet

lRet := Envia_Mail(oCfg,cRemt,cDest, cCC, cCCO, cTxt, cSubject)

MemoWrit("dadosmail.dat", _cUSER+CRLF+_cREMT+CRLF+Str(nServ))

endif

Return lRet

********************************************************************************

Function Envia_Mail(oCfg,cFrom, cTo, cCC, cBCC, cMsg, cSubject)

local cToken

local lRet := .f.

cTo := Destinatarios( cTo ) //--> PARA

cCC := Destinatarios( cCC ) //--> COM COPIA

cBCC := Destinatarios( cBCC ) //--> COM COPIA OCULTA

TRY

oMsg := CREATEOBJECT ( "CDO.Message" )

WITH OBJECT oMsg

:Configuration = oCfg

:From = cFrom

:To = cTo

:CC = cCC

:BCC = cBCC

:Subject = cSubject

:TextBody = cMsg

For x := 1 To Len( aAttach )

if aAttach[x] <> NIL

:AddAttachment(AllTrim(aAttach[x]))

endif

Next

:Send()

END WITH

lRet := .t.

CATCH

MsgInfo("NÃ£o Foi PossÃvel enviar a mensagem")

lRet := .f.

END

Return lRet

//----------------------------------------------------------------

Function ADDItem()

Local cArq := cGetFile32("*.*", "ADD Anexo", , ,.f.)

if file(cArq)

oList:ADD(Alltrim(cArq))

oList:Hide()

oList:Refresh()

oList:Show()

endif

Return NIL

//----------------------------------------------------------------

Function DELItem()

Local nIT := oList:GetSel()

oList:DEL( nIT )

oList:Hide()

oList:Refresh()

oList:Show()

Return NIL

//------------------------------------------------------------

Function Destinatarios( cVar )

local i

local aCars := {",", "/", "\"}

for i := 1 to len( aCars )

cVar := StrTran( cVar, aCars, ";" )

next

Return cVar

***********************************************************

id=code>id=code>

Ricardo Marques

Editado por - ricardomouramarques on 18/01/2011 02:35:56

ricardomouramarques · January 16, 2011