Rmail to Kapiaba.

jfaguiar · March 28, 2012

OlÃ¡ Kapiaba e amigos que puderem me ajudar.

Peguei a function Rmail() por indicaÃ§Ã£o do Kapiaba e gostei muito. Realmente ela Ã© fantÃ¡stica. Fiz algumas modificaÃ§Ãµes, permitindo o envio de parÃ¢metros e a leitura de uma tabela contendo os dominios utilizados.

A ultima alteraÃ§Ã£o que fiz foi para enviar o nome de um arquivo a anexar. Gostaria de saber como adicionar esse arquivo, recebido no parÃ¢metro cANEXO, ao objeto oList sem a necessidade de clicar no botÃ£o add.

Grato

JoÃ£o Freire de Aguiar

Segue o novo cÃ³digo:

/***************************************************************

Enviando emails

Desenvolvedor: Ricardo de Moura Marques

email: ricardomouramarques@hotmail.com

Agradecimentos ao Alessandro Seribeli Barreto - "Ale SB"

pelo cÃ³digo inicial, sem o qual, esse projeto

nÃ£o seria possÃvel

Veja exemplo de de envio de parÃ¢metros nessa versÃ£o:

RMail(cDest1,cDest2,cDest3,cASSUNT,cTEXTOMAIL,cUSUARIO,"portaria@boahora.com.br",PADR("boahora@123",15) )

***************************************************************/

#include "fivewin.ch"

Static cAttach := ""

Static aAttach := {}

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

Function RMail(cDest,cCC,cCCO,cAssunto,cTxt,,cMAILREM,cPASS,cANEXO)

local cUser := Space(50), cTime

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

local cDados, i,lCLOSEUSER := .F.,cAREAANT := ALIAS()

PRIVATE oList

//

IF !cMAILREM == NIl

nPOSI := AT("@",cMAILREM )

IF nPOSI = 0

cUser := PADR(cMAILREM,50)

ELSE

cUser := PADR( LEFT(cMAILREM,nPOSI-1),50)

cMAILREM := SUBSTR(cMAILREM,nPOSI)

ENDIF

DEFAULT cDest := Space(250)

DEFAULT cCC := Space(250)

DEFAULT cCCO := Space(250)

DEFAULT cTxt := Space(10)

DEFAULT cAssunto := Space(100)

DEFAULT cRemt := Space(50)

DEFAULT cPass := Space(15)

Private nServ := 1

IF !EMPTY(cDest)

cDest := PADR(cDest,250)

ENDIF

IF !EMPTY(cCC)

cCC := PADR(cCC,250)

ENDIF

IF !EMPTY(cCCO)

cCCO += SPACE(20)

ENDIF

IF !EMPTY(cAssunto)

cAssunto += SPACE(20)

ENDIF

//

Private oCab, oGru, oCon, oCod, oMenu, lSair := .f., oM2, lCheck := .t.

Private aServs := {}

IF !FILE("TBDRMAIL.DBF")

aServs := {{"@techlix.com.br", "smtp.techlix.com.br", 25, .f. },;

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

{"@hotmail.com", "smtp.live.com", 25, .t. },;

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

{"@gmail.com", "smtp.gmail.com", 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. },;

{"@pop.com.br", "smpt.pop.com.br", 25, .f. } }

ELSE

IF SELECT("TBDRMAIL") = 0

IF Netuse("TBDRMAIL","TBDRMAIL",.T.,.T.,15)

SET INDEX TO TBDRMAIL

ENDIF

DbSelectarea("TBDRMAIL")

DbGotop()

WHILE !EOF()

AADD(aServs,{TRIM(DOMINIO),TRIM(SMTP),PORTA,SSL} )

DbSkip()

ENDDO

ENDIF

Private aDomin := {}

FOR i := 1 to len( aServs )

AADD( aDomin, aServs[1] )

IF !cMAILREM == Nil .AND. cMAILREM $ aServs[1]

nServ := i

ENDIF

NEXT

if nServ = 0 .or. nServ > len(aServs)

nServ := 1

endif

Set Delete ON

ArqBmp()

DEFINE FONT oFONT1 NAME "Ms Sans Serif" SIZE 0, -12

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

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

@ 002, 006 SAY oSay[1] PROMPT "E-mail do Remetente" 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 "Nome do Remetente" OF oDlg SIZE 100, 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 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

@ 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 "@" WHEN .F. 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[7] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

@ 132,006 GET oGet 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 "Enviar" 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()

@ 062, 006 BtnBmp oBt1 File "&cDRIVE\SISCOM\BITMAPS\_loc.bmp" Prompt "Para" size 32,10 Pixel Right

@ 072, 006 BtnBmp oBt2 File "&cDRIVE\SISCOM\BITMAPS\_loc.bmp" Prompt "CC" size 32,10 Pixel Right

@ 082, 006 BtnBmp oBt3 File "&cDRIVE\SISCOM\BITMAPS\_loc.bmp" Prompt "CCO" size 32,10 Pixel Right

ACTIVATE DIALOG oDlg CENTERED

RETURN Nil

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

Function Fim(cUser, cRemt, nServ)

MemoWrit("dadosmail.dat", cUSER+CRLF+cREMT+CRLF+Str(nServ)+CRLF+if(oM2:lChecked, "1", "0") )

Return .t.

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

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] // Se Ã© servidor seguro

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

( Empty(cDest) .and. Empty( cCC ) .and. Empty(cCCO) )

? "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)

endif

Return lRet

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

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

local cToken

local lRet := .f.

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

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

Static Function ArqBmp()

Local cHexa

if file("&cDRIVE\SISCOM\BITMAPS\_loc.bmp")

Return NIL

endif

cHexa := "424df6000000000000003600000028000000080000000800000001001800"

cHexa += "00000000c0000000c30e0000c30e00000000000000000000ffffffffffff"

cHexa += "fffffffffffffffffff6f7fae9edf4ffffffffffffffffffffffffffffff"

cHexa += "f4f6fa9bb9d7749fc8d7e1edffffffebf2f7b7cfe4b1c9e18ab2d386bfdb"

cHexa += "71a4cacdd6e5ebf3f8a3c6ddc1d3e2dbe3e9abc9dd6fa6cec1d3e7ffffff"

cHexa += "c6deecbad4e2fff9effff7edfcf7f09ab8d5e5edf5ffffffc4ddedc7dce6"

cHexa += "fff6ebfbf2e9fff7efaec8dde4edf5ffffffdeedf5a9cee2e7ebeaf5f1eb"

cHexa += "d8e2e89ec0dbf1f6faffffffffffffd6e8f2acd0e4b5d4e6aacde2e2edf5"

cHexa += "ffffffffffff"

MemoWrit( "&cDRIVE\SISCOM\BITMAPS\_loc.bmp", _Binario(cHexa) )

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

Function _Binario( cHexa )

local i, nInd1, nInd2, nByte, cBin := ""

local aBase := {"0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"}

for i := 1 to len( cHexa ) STEP 2

nInd1 := aScan(aBase, SubStr( cHexa, i, 1 ))-1

nInd2 := aScan(aBase, SubStr( cHexa, i+1, 1 ))-1

nByte := nInd1*16+nInd2

cBin += Chr(nByte)

next

Return cBin

Return cHexa

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

id=code>id=code>

jfaguiar · March 28, 2012