Jump to content
Fivewin Brasil

Erro ao enviar e-mail via CDOMessage


Edu

Recommended Posts

Prezados,

Bom dia!

Não estou conseguindo enviar e-mail via CDO.Message. O erro diz que não encontrou o método [send()].

Obs.: O registro da cdosys.dll está ok!

Tentei utilizar a HB_SendMail(), onde me retorna o seguinte erro no log:

20150902-12:09:45 :INETRECVLINE( 1723924, , 512 )
>> 530 5.7.0 Must issue a STARTTLS command first. d60sm1547769qga.30 - gsmtp <<
Tentei utilizar a classe TSmpt, onde não retorna erro algum porém não envia a mensagem.
Alguém teria uma solução?
Link to comment
Share on other sites

Kapiaba,

Eu vi todos os posts e o erro continua. Onde estou errando?

Segue o código:

Function SendMailCDO()
LOCAL objMsg, cHtml
LOCAL msgConf
//' Server Configuration
TRY
msgConf := CreateObject("CDO.Configuration")
WITH OBJECT msgConf:Fields
:Update()
END WITH
CATCH oError
MsgInfo("Configuration instance object error " + ";" + 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+ ;
"Message: " + oError:Description )
END
//' Email
TRY
objMsg := CreateObject("CDO.Message")
WITH OBJECT objMsg
:Configuration = msgConf
:From = "sistemas.cyclonet@gmail.com"
:To = "eduardo.sp6@gmail.com"
:Subject = "Test send with Gmail account"
:TextBody = "Teste"
:MDNRequested = .F. // Indicates whether a Message Disposition Notification is requested on a message.
:Send()
END WITH
// objMsg:Send()
CATCH oError
MsgInfo("Could not send message" + ";" + 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+ ;
"Message: " + oError:Description )
END
Return nil
Link to comment
Share on other sites


#include "FiveWin.ch"

Function SendMailCDO()

LOCAL objMsg, cHtml, oError
LOCAL msgConf

//' Server Configuration

TRY

msgConf := CreateObject("CDO.Configuration")

WITH OBJECT msgConf:Fields

:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := "smtp.pleno.com.br"
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := 587
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := .T.
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := .F.
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := "joao@pleno.com.br" //<seu_email>
:Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := // "sua_senha"
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") :Value = 30

:Update()

END WITH

CATCH oError

MsgInfo("Configuration instance object error " + ";" + 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+ ;
"Message: " + oError:Description )

END

//' Email

TRY
objMsg := CreateObject("CDO.Message")
WITH OBJECT objMsg

:Configuration = msgConf
:From = "sistemas.cyclonet@gmail.com"
:To = "eduardo.sp6@gmail.com"
:Subject = "Test send with Gmail account"
:TextBody = "Teste"
:MDNRequested = .F. // Indicates whether a Message Disposition Notification is requested on a message.
:Send()

END WITH

// objMsg:Send()

CATCH oError

MsgInfo("Could not send message" + ";" + 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+ ;
"Message: " + oError:Description )

RETURN NIL

END

? "FOI MANO... EU SOU PHODINHA... PHODA E MEU PAI! KKKKKKKKKKK"

Return nil


Link to comment
Share on other sites

Estou tentando enviar assim:

Function ENVIA_ERRO(cSub,cBodyError)
 
   LOCAL oSmtp, oEMail
   LOCAL cSmtpUrl
   LOCAL cSubject, cFrom, cTo, cBody, cFile
 
   /*
   cSmtpUrl := "smtp://meuemail:senha@smtp.mail.yahoo.com.br"
   cFrom  := "meuemail@yahoo.com.br"
   cTo   := "meuemail@ymail.com"
   */
   
   cSmtpUrl := "smtp://ronecoura@gmail.com:SENHA@smtp.gmail.com"
   cFrom    := "rone@rl-informatica.net"
   cTo      := "errosys@rl-informatica.net"
 
   cSubject := cSub
 
   cFile  := ""
 
   cBody  := cBodyError
 
   oEMail := TIpMail():new()
   oEMail:setHeader( cSubject, cFrom, cTo )
   oEMail:setBody( cBody )
   oEMail:attachFile( cFile )
 
   //oEMail:hHeaders[ "Disposition-Notification-To" ] := cFrom // solicita confirmacao
 
   oSmtp := TIpClientSmtp():new( cSmtpUrl )
   
   oSmtp:nConnTimeout := 2000
 
   IF oSmtp:open()
 
oSmtp:sendMail( oEMail )
 
      oSmtp:close()
 
      MSGINFO( [Email enviado com sucesso], [RL Informatica] )
 
   ELSE
 
      MSGINFO( oSmtp:lastErrorMessage(), "ERRO"  )
 
   ENDIF
 
RETURN Nil
Link to comment
Share on other sites

Recentemente tive problemas com Gmail ao enviar emails embora antes eu conseguisse enviar.

Como parou de enviar sem eu sequer ter mexido nas configurações que antes funcionavam normalmente, resolver dar uma olhada na conta do GMail pelo site.

Ao entrar na conta recebi logo a notificação de que tinha havido tentativa de uso da conta por um aplicativo desconhecido e que, por isso, o acesso foi bloqueado.

Tinha os botões para eu confirmar se tinha sido realmente eu e se era para desbloquear. Confirmei e passou a funcionar novamente.

Recomendo que você faça o mesmo: entre em sua conta do GMail pelo site e veja se não há algumas notificações que requerem sua confirmação.

Link to comment
Share on other sites

Acabei de testar. Como funcionou, compara a rotina que uso com a tua para ver se tem alguma diferença.

a

***************************************************************
* 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                                         *
*                                                             *
***************************************************************

#include "fivewin.ch"
#include "vlib.ch"

*Static cAttach := ""
Static aAttach
********************************************************************************
Function MailMain(_Dest, _Subj, _Msge, _File)
 
  local cUser := Space(50), cRemt := Space(50), ;
        cDest := Space(250), cTime, cTxt := Space(10), cAssunto := Space(100),;
		  cCC := Space(250), cCCO := Space(250), n_Area := SELECT()
  local oDlg, oGet[8], oSay[12], oBtn[2], nItem := 0
  local cDados, i
  
   Private oCab, oGru, oCon, oCod, oMenu, lSair := .f., oM2, lCheck := .t.
   aAttach := {}

   DEFAULT _Dest := "", _Subj := "", _Msge := "", _File:=""
   cDest := LEFT(_Dest+SPACE(250), 250)
   cAssunto := LEFT(_Subj+SPACE(100), 100)
   cTxt := _Msge
  
   IF VALTYPE(_File) = "C"
      IF FILE(_File)
         AADD(aAttach, _File)
      ENDIF
   ELSEIF VALTYPE(_File) = "A"
      aAttach := _File
   ENDIF

   cUser := GetPvProfString( "EMAILCFG", "Usuario", " ", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(50)
   cDomi := GetPvProfString( "EMAILCFG", "Dominio", "", ALLTRIM(cPasta)+"\CONFIG.INI")

   ArqsDBF()

   DEFINE FONT oFONT1 NAME "Ms Sans Serif" SIZE   0, -12
  
   DEFINE DIALOG oDlg TITLE "Envio de eMail" From 0, 0 to 530, 600 Pixel
 
   @ 002,006 SAY oSay[1] PROMPT "Eviar usando este remetente" OF oDlg SIZE 150, 08 COLOR CLR_BLUE PIXEL
	@ 010, 006 SAY oGet[1] PROMPT alltrim(cUser) + alltrim(cDomi) SIZE 190, 10 PIXEL OF oDlg BORDER COLORS CLR_BLACK, CLR_HGRAY UPDATE

	@ 008, 200 BtnBmp oCfg File ".\bitmaps\engrena.bmp" Prompt "" size 20,12 OF oDlg Pixel Action SMTPConfig(@cUser, @cDomi, oDlg) NOBORDER

	@ 022, 040 GET oGet[4] VAR cDest SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update
	@ 022, 006 SBUTTON oBt1 File ".\bitmaps\mail.bmp" Prompt "Para" size 32,10 Pixel RIGHT Action Inclui( oGet[4], @cDest ) NOBORDER

	@ 032, 006 SBUTTON oBt2 File ".\bitmaps\mail.bmp" Prompt "CC"   size 32,10 Pixel RIGHT Action Inclui( oGet[5], @cCC   ) NOBORDER
	@ 032, 040 GET oGet[5] VAR cCC SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

	@ 042, 006 SBUTTON oBt3 File ".\bitmaps\mail.bmp" Prompt "CCO"  size 32,10 Pixel RIGHT Action Inclui( oGet[6], @cCCO  ) NOBORDER
	@ 042, 040 GET oGet[6] VAR cCCO SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update

	@ 056, 006 SAY oSay[9] VAR "Assunto" OF oDlg SIZE 32, 08 COLOR CLR_BLUE PIXEL update
	@ 056, 040 GET oGet[7] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update
	 
	@ 068,006 SAY oSay[7] VAR "Mensagem" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update
	@ 078,006 GET oGet[8] VAR cTxt OF oDlg SIZE 288,125 COLOR CLR_BLUE, CLR_WHITE PIXEL update MEMO
    	
	@ 210,006 SAY oSay[8] VAR "Anexos" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update
   @ 218,006 ListBox oList Var nItem ITEMS aAttach Size 268,28 Pixel
 	 
*****--- BOTÕES ---*************************************************************
   @ 242, 006 BUTTONBMP oBtn[1] PROMPT "Enviar" OF oDlg ;
              SIZE 30,10 PIXEL ;
              ACTION (cTime := "Aguarde...", oSay[6]:Refresh(), ;
					        if(lRet := Config_Mail(Lower(Alltrim(cDest)),Lower(Alltrim(cCC)),Lower(Alltrim(cCCO)), cTxt, cAssunto ), ;
					              (MsgInfo("Mensagem enviada com êxito!","Atençao"), oDlg:End()), nil),;
                       cTime := "", oSay[6]:Refresh() )

   @ 242, 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()
   @ 270,006 SAY oSay[6] VAR cTime OF oDlg SIZE 50, 08 COLOR CLR_RED PIXEL update

   ACTIVATE DIALOG oDlg CENTERED On Init Inicio( oDlg )
   
   Codigos->(DBCLOSEAREA())
   CabGrupo->(DBCLOSEAREA())
   Grupos->(DBCLOSEAREA())
   Contatos->(DBCLOSEAREA())
   SELECT(n_Area)
Return Nil

//------------------------------------------------------------------------------
Function Inicio( oDlg )
   Menu oMenu
   	MenuItem "&Sistema"
   	MENU
   		MenuItem "&Gerenciar Contatos" Action Contatos()
   		MenuItem oM2 Prompt "&Salvar contatos automaticamente" CHECK;
   		         Action if( oM2:lChecked, oM2:SetCheck(.f.), oM2:SetCheck(.t.) )
   		Separator
   		MenuItem "Sai&r" Action ( oDlg:End() )
   	ENDMENU
   ENDMENU
   oM2:SetCheck( lCheck )
   oDlg:SetMenu(oMenu)
Return Nil
********************************************************************************
Function Config_Mail(cDest, cCC, cCCO, cTxt, cSubject)
   local lRet := .f.
   local oCfg, oError
   local cServ := alltrim(GetPvProfString( "EMAILCFG", "Servidor", " ", ALLTRIM(cPasta)+"\CONFIG.INI"))  //--> SERVIDOR SMTP - "smtp.servidor.com.br"
   local cPass := ALLTRIM(GetPvProfString( "EMAILCFG", "UsrPswrd", " ", ALLTRIM(cPasta)+"\CONFIG.INI"))
   local nPort := val(alltrim(GetPvProfString( "EMAILCFG", "SmtpPort", "", ALLTRIM(cPasta)+"\CONFIG.INI")))
   local lAut  := IIF(GetPvProfString( "EMAILCFG", "SmtpAuth", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S", .T., .F.)
   local lSSL  := IIF(GetPvProfString( "EMAILCFG", "SmtpSSL", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S", .T., .F.)
   local cReply:= GetPvProfString( "EMAILCFG", "EmailResposta", " ", ALLTRIM(cPasta)+"\CONFIG.INI")

   _cUser := ALLTRIM(GetPvProfString( "EMAILCFG", "Usuario", "", ALLTRIM(cPasta)+"\CONFIG.INI"))
   _cDomi := ALLTRIM(GetPvProfString( "EMAILCFG", "Dominio", "", ALLTRIM(cPasta)+"\CONFIG.INI"))
   _cRemt := ALLTRIM(_cUser) + ALLTRIM(_cDomi)

   if Empty(cPass) .or. Empty(_cRemt) .or.;
		( Empty(cDest) .and. Empty( cCC ) .and. Empty(cCCO) )
      ? "Preencha todos Campos"
      return .f.
   endif
   cUser := _cRemt
   cRemt := _cRemt
   nTot   := 1
   nReg   := 0
   n_Pos3 := 0
   cSay   := "Enviando a mensagem. Aguarde..."

   DEFINE DIALOG oDmtr1 FROM 0,0 TO 4, 35 TITLE "Enviando..."
   oDmtr1:lHelpIcon := .F.
   @05,05 SAY oSay PROMPT cSay PIXEL SIZE 130, 10 OF oDmtr1 UPDATE
   @15,05 METER oMeter VAR n_Pos3 TOTAL nTot SIZE 130, 12 OF oDmtr1 UPDATE PIXEL
   ACTIVATE DIALOG oDmtr1 CENTER NOWAIT VALID (!GetKeyState( VK_ESCAPE ) .AND. !GetKeyState( VK_MENU ))

   TRY
      oCfg := CREATEOBJECT( "CDO.Configuration" )
      WITH OBJECT oCfg:Fields
           :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing"        ):Value := 2
           :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/smtpconnectiontimeout" ):Value := 30
           :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := 1 // 0=anonima, 1=basica, 2=ntlm
           :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+ ;
             "Erro: "      + Transform(oError:GenCode,   nil) + ";" +CRLF+ ;
             "SubC: "      + Transform(oError:SubCode,   nil) + ";" +CRLF+ ;
             "OSCode: "    + Transform(oError:OsCode,    nil) + ";" +CRLF+ ;
             "SubSystem: " + Transform(oError:SubSystem, nil) + ";" +CRLF+ ;
             "Mensagem: "  + oError:Description, "Atenção" )

  END
  //--> FIM DAS CONFIGURAÇOES.
  if lRet
     lRet := Envia_Mail(oCfg, cRemt, cReply, cDest, cCC, cCCO, cTxt, cSubject)
  endif
  
  nReg ++
  oMeter:Set(nTot)
  Inkey(0.5)
  oDmtr1:End()
  SysRefresh()

Return lRet
 
********************************************************************************
Function Envia_Mail(oCfg, cFrom, cReply, 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
             :ReplyTo := cReply
			 	 :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 oErr
        MsgInfo("Não foi possível enviar a mensagem. Favor verificar:"+CRLF+CRLF+;
                "• As configurações estão corretas?"+CRLF+;
                "• Sua senha está correta?"+CRLF+;
                "• O e-mail do destinatário está correto?"+CRLF+;
                "• A Internet está funcionando corretamente?"+CRLF+CRLF+;
                "Para maiores esclarecimentos contate o suporte @rSoft", oErr:Description)
        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, x,cGrupo, nCod
local aCars := {",", "/", "\", ";"}
local cLista := ""
local lSalva := .t., lAll := .f.
Private aTp := {}

for i := 1 to len( aCars )
	cVar := StrTran( cVar, aCars[i], CRLF )
next

for i := 1 to MLCount(cVar, 250)
	AADD(aTp, Alltrim(MemoLine(cVar, 250, i)))
next	

for i := 1 to len(aTp)
	cTemp :=  aTp[i]	
	if left(cTemp, 2) = "<<" .and. right(cTemp, 2) = ">>"
		cGrupo := StrTran(cTemp, "<<", "")
		cGrupo := StrTran(cGrupo, ">>", "")
		cGrupo := cGrupo+Space(20-Len(cGrupo))				
		if !oCab:Seek(cGrupo)
			Msginfo('Grupo "'+Alltrim(cGrupo)+'" não encontrado')
		else
		   oGru:Gotop()
		   do While !oGru:Eof()
		      oGru:Load()
			  cLista += ";"+NomeCont(oGru:CodC)
			  oGru:Skip()
		   enddo
		endif
	else		
		cLista += ";"+cTemp
		
		if lCheck
			if !oCon:Seek(cTemp+Space(100-Len(cTemp)))			
				oCon:Blank()
				oCon:Contato := cTemp
				oCod:Load()
				nCod := oCod:CodC+1
				oCod:CodC := nCod
				oCod:Save()
				oCon:CodC := nCod
				oCon:Append()
				oCon:Save()			
			endif
		endif
		
	endif
next

		
Return cLista

//----------------------------------------------------------
Function ArqsDBF()
 
local aEstG, aEstR, aEstC, aEstCods

	aEstCods := { 	{ "CODG", "N", 10, 0 },;
					{ "CODC", "N", 10, 0 } }
	

	aEstG := { 	{ "CODG",   "N", 10, 0 },;
				{ "GRUPO",  "C", 20, 0 } }
				
	aEstR := { 	{ "CODG",   "N", 10, 0 },;
				{ "CODC",   "N", 10, 0 } }
				
	aEstC := { 	{ "CODC",     "N", 10, 0 },;
				{ "CONTATO",  "C", 100, 0 } }
	
	If !File( "Codigos.dbf")
		DBCreate( "Codigos.dbf", aEstCods )
	endif
	
	If !File( "CabGrupo.dbf")
		DBCreate( "CabGrupo.dbf", aEstG )
	endif
	
	If !File( "Grupos.dbf")
		DBCreate( "Grupos.dbf", aEstR )
	endif
	
	If !File( "Contatos.dbf")
		DBCreate( "Contatos.dbf", aEstC )
	endif
	
	Use Codigos New
	DATABASE oCod
	
	Use CabGrupo New
	Index on CabGrupo->Grupo to GCabGru
	DATABASE oCab
	
	Use Grupos New	
	Set Filter to Grupos->CodG = CabGrupo->CodG
	DATABASE oGru

	Use Contatos New
	Index on Contatos->CodC to CodCont	
	Index on Contatos->Contato to cCont
	Set index to cCont, CodCont
	DATABASE oCon
	
	if oCod:RecCount() = 0
		oCod:Append()		
		oCod:Save()
	endif
	
   oCab:bBoF := NIL ; oCab:bEoF := NIL
   oGru:bBoF := NIL ; oGru:bEoF := NIL
   oCon:bBoF := NIL ; oCon:bEoF := NIL
   oCod:bBoF := NIL ; oCod:bEoF := NIL
	
Return NIL	
//-----------------------------------------------------------------------
Function Contatos()

Private oBrw1, oBut1, oBut2, oBut3, oBrw2,;
        oBut4, oBut5, oBrw3, oBut6, oBut7,;
		oBut8, lInicio := .f.

Select Contatos
Set index to cCont, CodCont

Define DIALOG oDlgCont TITLE "Gerenciar Contatos" ;
       FROM 0, 0 to 484, 791 PIXEL COLOR 0, 15790320

ACTIVATE DIALOG oDlgCont ON INIT Ini_oDlgCont() CENTER

Return NIL

//----------------------------------------------------------------------------
Function Ini_oDlgCont()

   @  11,  14 LISTBOX oBrw1;
               FIELDS CONTATOS->CONTATO;
               HEADERS "CONTATOS";              
      SIZE 406, 409 PIXEL OF oDlgCont FONT oFont1 ALIAS "CONTATOS"

   oBrw1:nClrText := {|| iif( OrdKeyNo()%2=0,          0,          0 ) }
   oBrw1:nClrPane := {|| iif( OrdKeyNo()%2=0,   15790320,   16777215 ) }
   oBrw1:nClrForeHead  :=   16777215
   oBrw1:nClrBackHead  :=    8421504
   oBrw1:nClrForeFocus :=   16777215
   oBrw1:nClrBackFocus :=    8388608


   @ 444,  14 BUTTON oBut1 Prompt "&Novo" SIZE  70,  24 PIXEL;
              OF oDlgCont ACTION CadContato(.t.) FONT oFont1


   @ 444,  93 BUTTON oBut2 Prompt "&Alterar" SIZE  70,  24 PIXEL;
              OF oDlgCont ACTION CadContato(.f.) FONT oFont1


   @ 444, 172 BUTTON oBut3 Prompt "&Excluir" SIZE  70,  24 PIXEL;
              OF oDlgCont ACTION DeleteCon() FONT oFont1


   @  11, 444 LISTBOX oBrw2;
               FIELDS CABGRUPO->GRUPO;
               HEADERS "GRUPOS";              
      SIZE 300, 171 PIXEL OF oDlgCont FONT oFont1 ALIAS "CABGRUPO";
	  ON Change if( lInicio, (oBrw3:Hide(), oBrw3:GoTop(), oBrw3:Refresh(), oBrw3:Show()), NIL)
	  

   oBrw2:nClrText := {|| iif( OrdKeyNo()%2=0,          0,          0 ) }
   oBrw2:nClrPane := {|| iif( OrdKeyNo()%2=0,   15790320,   16777215 ) }
   oBrw2:nClrForeHead  :=   16777215
   oBrw2:nClrBackHead  :=    8421504
   oBrw2:nClrForeFocus :=   16777215
   oBrw2:nClrBackFocus :=    8388608


   @  26, 750 BUTTON oBut4 Prompt "New" SIZE  30,  26 PIXEL;
              OF oDlgCont ACTION CadastraGru( .t. ) FONT oFont1

   @  52, 750 BUTTON oBut5 Prompt "Alt" SIZE  30,  26 PIXEL;
              OF oDlgCont ACTION CadastraGru( .f. ) FONT oFont1
			  
   @  78, 750 BUTTON oBut5a Prompt "Del" SIZE  30,  26 PIXEL;
              OF oDlgCont ACTION DeletaGru() FONT oFont1


   @ 186, 444 LISTBOX oBrw3;
               FIELDS NomeCont(GRUPOS->CODC);
               HEADERS "INTEGRANTES DO GRUPO";              
      SIZE 300, 234 PIXEL OF oDlgCont FONT oFont1 ALIAS "GRUPOS"

   oBrw3:nClrText := {|| iif( OrdKeyNo()%2=0,          0,          0 ) }
   oBrw3:nClrPane := {|| iif( OrdKeyNo()%2=0,   15790320,   16777215 ) }
   oBrw3:nClrForeHead  :=   16777215
   oBrw3:nClrBackHead  :=    8421504
   oBrw3:nClrForeFocus :=   16777215
   oBrw3:nClrBackFocus :=    8388608


   @ 268, 422 BUTTON oBut6 Prompt ">" SIZE  21,  21 PIXEL;
              OF oDlgCont ACTION ADDCont() FONT oFont1


   @ 290, 422 BUTTON oBut7 Prompt "<" SIZE  21,  21 PIXEL;
              OF oDlgCont ACTION RemoveCont() FONT oFont1


   @ 444, 675 BUTTON oBut8 Prompt "Sai&r" SIZE  70,  24 PIXEL;
              OF oDlgCont ACTION oDlgCont:End() FONT oFont1


	lInicio := .t.
	oBrw3:Hide(); oBrw3:GoTop(); oBrw3:Refresh(); oBrw3:Show()
			  
Return NIL

//----------------------------------------------------------------
Function CadContato( lNovo )

if lNovo
	oCon:Blank()
else
	oCon:Load()
endif

Define dialog oDlgCadCon Title if(lNovo, "Novo Contato", 'Alterando "'+oCon:Contato+'"');
				From 0,0 to 200,300 Pixel
				
			@ 20,20 Say "Contato" Size 40,10 Pixel
			@ 32,20 Get oGetCon Var oCon:Contato Size 110,10 Pixel
			
			@ 70, 25 Button "&Salvar" Size 40,10 Pixel Action SalvaCon( lNovo )
			@ 70, 85 Button "&Desistir" Size 40,10 Pixel Action oDlgCadCon:End()
			
Activate dialog oDlgCadCon Center

Return NIL

//----------------------------------------------------------------
Function SalvaCon( lNovo )
Local nCod

if lNovo
	oCod:Load()
	nCod := oCod:CodC+1
	oCod:CodC := nCod
	oCod:Save()	
	oCon:CodC := nCod
	oCon:Append()
endif	

oCon:Contato := Lower( oCon:Contato)
oCon:Save()

oBrw1:Hide()
oBrw1:Refresh()
oBrw1:Show()
oDlgCadCon:End()

Return NIL

//----------------------------------------------------------------
Function DeleteCon()

oCon:Load()
if MsgNoYes( 'Excluir o contato "'+Alltrim(oCon:Contato)+'"?', "Atenção")
	oCon:Delete()
	oBrw1:Hide()
	oBrw1:Refresh()
	oBrw1:Show()
endif

Return NIL

//------------------------------------------------------------
Function CadastraGru( lNovo )

if lNovo
	oCab:Blank()
else
	oCab:Load()
endif	

Define dialog oDlgCadGru Title if(lNovo, "Novo Grupo", 'Alterando "'+oCab:Grupo+'"');
				From 0,0 to 200,300 Pixel
				
			@ 20,20 Say "GRUPO" Size 40,10 Pixel
			@ 32,20 Get oGetGru Var oCab:Grupo Size 110,10 Pixel
			
			@ 70, 25 Button "&Salvar" Size 40,10 Pixel Action SalvaGru( lNovo )
			@ 70, 85 Button "&Desistir" Size 40,10 Pixel Action oDlgCadGru:End()
			
Activate dialog oDlgCadGru Center

Return NIL

//-------------------------------------------------------
Function SalvaGru( lNovo )
Local nCod

  if lNovo
 	oCod:Load()
	nCod := oCod:CodG+1
	oCod:CodG := nCod
	oCod:Save()	
	oCab:CodG := nCod
	oCab:Append()
  endif
  
  oCab:Grupo := Lower(oCab:Grupo)
  oCab:Save()
	
  oBrw2:Hide()
  oBrw2:Refresh()
  oBrw2:Show()
  oDlgCadGru:End()

Return NIL
//----------------------------------------------------------------
Function DeletaGru()

oCab:Load()
if MsgNoYes( 'Excluir o grupo "'+Alltrim(oCab:Grupo)+'"?', "Atenção")
	oCab:Delete()
	oBrw2:Hide()
	oBrw2:Refresh()
	oBrw2:Show()
endif

Return NIL

//------------------------------------------------------------
Function ADDCont()

oCab:Load()
if oCab:CodG = 0
	MsgInfo("Selecione um GRUPO")
	Return NIL
endif
oCon:Load()
if oCon:CodC = 0
	MsgInfo("Selecione um contato")
	Return NIL
endif	


oGru:Blank()
oGru:CodC := oCon:CodC
oGru:CodG := oCab:CodG
oGru:Append()
oGru:Save()

oBrw3:Hide()
oBrw3:Refresh()
oBrw3:Show()

Return NIL

//-------------------------------------------------------------
Function RemoveCont()

oGru:Load()
if MsgNoYes( 'Remover o contato selecionado?')
  oGru:Delete()
  oBrw3:Hide()
  oBrw3:Gotop()
  oBrw3:Refresh()  
  oBrw3:Show()
endif

Return Nil

//-----------------------------------------------------------------
Function NomeCont(nCod)
Local nRec := oCon:RecNo()
Local cNome := ""

Select Contatos
Set index to CodCont, cCont

if oCon:Seek( nCod )
   cNome := oCon:Contato
endif

Select Contatos
Set index to cCont, CodCont
oCon:GoTo(nRec)

Return cNome

//---------------------------------------------------------------
Function Inclui( oGet, cVar )

nRad := 1

Define Dialog oDlgInc Title "Incluir contato" From 0,0 to 200, 300 Pixel

		@ 20,20 Radio oRad Var nRad Prompt "Inluir Contato", "Incluir Grupo" Size 80,10 Pixel
		
		@ 70, 25 Button "&Ok" Size 40,10 Pixel Action IncluiCont( nRad, oGet, @cVar )
		@ 70, 85 Button "&Desistir" Size 40,10 Pixel Action oDlgInc:End()
		
Activate Dialog oDlgInc CENTER

//-----------------------------------------------------------
Function IncluiCont( nRad, oGet, cVar )

if nRad = 1
	BuscaCont(oGet, @cVar)
else
	BuscaGru(oGet, @cVar)
endif	

//----------------------------------------------------------
Function BuscaCont( oGet, cVar )

aListCont := {}
nListCont := 1

Define Dialog oDlgCon Title "Contatos" From 0,0 to 484, 792 Pixel
	   
	   @  11,  14 LISTBOX oBrw;
               FIELDS CONTATOS->CONTATO;
               HEADERS "CONTATOS";              
               SIZE 203, 205 PIXEL OF oDlgCon FONT oFont1 ALIAS "CONTATOS"

	   @ 10,219 Button ">" Size 10, 10 Pixel;
	            Action (oCon:Load(), oListCont:ADD(oCon:Contato), oListCont:Refresh())
				
	   @ 21,219 Button "<" Size 10, 10 Pixel;
				Action (oListCont:Del(nListCont), oListCont:Refresh())
	   
	   @  11, 232 ListBox oListCont Var nListCont Items aListCont;
				  size 150, 206 pixel of oDlgCon Font oFont1
 				  
			   
	   @ 226, 148 Button "&OK" Size 40,10 Pixel Action ConfCont( oGet, @cVar )
	   @ 226, 208 Button "&Desistir" Size 40,10 Pixel Action oDlgCon:End()
			   
Activate dialog oDlgCon CENTER

//-----------------------------------------------------------
Function ConfCont( oGet, cVar )
local i
	oCon:Load()
	
	cVar := Alltrim(cVar)
	if len(cVar) > 0
	   cVar := Alltrim(cVar)+";"
	endif
	
	for i := 1 to len( oListCont:aItems )	    
		cVar := cVar+if(i>1,";", "")+Alltrim(oCon:Contato)
	next
	
	cVar+=Space(100)
	oGet:SetText( cVar )
	oDlgCon:End()
	oDlgInc:end()
	
Return NIL

//----------------------------------------------------------
Function BuscaGru( oGet, cVar )

Define Dialog oDlgGru Title "Grupos" From 0,0 to 484, 450 Pixel
	   
	   @  11,  14 LISTBOX oBrw;
               FIELDS CABGRUPO->GRUPO;
               HEADERS "GRUPOS";              
               SIZE 203, 205 PIXEL OF oDlgGru FONT oFont1 ALIAS "CABGRUPO"	  
			   
	   @ 226, 071 Button "&OK" Size 40,10 Pixel Action ConfGru( oGet, @cVar )
	   @ 226, 131 Button "&Desistir" Size 40,10 Pixel Action oDlgGru:End()
			   
Activate dialog oDlgGru CENTER

//-----------------------------------------------------------
Function ConfGru( oGet, cVar )
	oCab:Load()
	if len(Alltrim(cVar)) > 0
	   cVar := Alltrim(cVar)+";"
	endif
	cVar := Alltrim(cVar)+"<<"+Alltrim(oCab:Grupo)+">>"+Space(100)
	oGet:SetText( cVar )
	oDlgGru:End()
	oDlgInc:end()
Return NIL

STATIC FUNCTION SMTPConfig(cUser, cDomi, oDlg)
   LOCAL cServ, cPort, cPswr, lAuth, l_Ssl, lApply
/* Private aServs:= {{"@hotmail.com",                "smtp.live.com",                    587, .f. },;
   					   {"@yahoo.com.br",               "smtp.mail.yahoo.com.br",            25, .f. },;
   					   {"@gmail.com",                  "smtp.gmail.com",                   465, .t. },;
   					   {"@uol.com.br",                 "smtps.uol.com.br",                 465, .t. },;
   					   {"@bol.com.br",                 "smtps.bol.com.br",                 587, .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. },;
   					   {"@autoboxlubrificantes.com.br","smtp.autoboxlubrificantes.com.br", 587, .f. },;
   					   {"@pop.com.br",                 "smpt.pop.com.br",                   25, .f. } } */

   cUser := GetPvProfString( "EMAILCFG", "Usuario", " ", ALLTRIM(cPasta)+"\CONFIG.INI")
   cDomi := GetPvProfString( "EMAILCFG", "Dominio", "", ALLTRIM(cPasta)+"\CONFIG.INI")
   cMail := ALLTRIM(cUser)+ALLTRIM(cDomi)+SPACE(50)
   cServ := GetPvProfString( "EMAILCFG", "Servidor", "", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(50)
   cPort := GetPvProfString( "EMAILCFG", "SmtpPort", "", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(5)
   cPswr := ALLTRIM(GetPvProfString( "EMAILCFG", "UsrPswrd", " ", ALLTRIM(cPasta)+"\CONFIG.INI"))+SPACE(15)
   lAuth := IIF(GetPvProfString( "EMAILCFG", "SmtpAuth", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S",.T., .F.)
   l_Ssl := IIF(GetPvProfString( "EMAILCFG", "SmtpSSL", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S",.T., .F.)
   cReply:= GetPvProfString( "EMAILCFG", "EmailResposta", " ", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(50)

   lApply:= .F.

   DEFINE DIALOG oDSmtp RESOURCE "SMTP_CFG"
   REDEFINE GET oId38 VAR cMail ID 38 OF oDSmtp
   REDEFINE GET oId44 VAR cServ ID 44 OF oDSmtp
   REDEFINE GET oId39 VAR cPort ID 39 OF oDSmtp
   REDEFINE GET oId41 VAR cPswr ID 41 OF oDSmtp
   REDEFINE CHECKBOX oId37 VAR lAuth ID 37 OF oDSmtp
   REDEFINE CHECKBOX oId40 VAR l_Ssl ID 40 OF oDSmtp
   REDEFINE GET oId36 VAR cReply ID 36 OF oDSmtp
   REDEFINE BUTTON oId46 ID 46 OF oDSmtp ACTION (lApply := .t., oDSmtp:End())
   REDEFINE BUTTON oId47 ID 47 OF oDSmtp ACTION (lApply := .f., oDSmtp:End())
   ACTIVATE DIALOG oDSmtp CENTERED
   IF ! lApply ; RETURN NIL ; ENDIF

   cMail := ALLTRIM(cMail)
   IF ! ("@" $ cMail)
      SysRefresh()
      MsgAlert("E-mail incorreto. Deve conter pelo menos 6 caracteres incluindo @ e . (ponto)", "Aviso")
      RETURN NIL
   ENDIF
   IF ! ("." $ cMail)
      SysRefresh()
      MsgAlert("E-mail incorreto. Deve conter pelo menos 6 caracteres incluindo @ e . (ponto)", "Aviso")
      RETURN NIL
   ENDIF
   IF LEN(cMail) < 6
      SysRefresh()
      MsgAlert("E-mail incorreto. Deve conter pelo menos 6 caracteres incluindo @ e . (ponto)", "Aviso")
      RETURN NIL
   ENDIF
   IF EMPTY(cServ)
      SysRefresh()
      MsgAlert("Servidor SMTP não informado", "Aviso")
      RETURN NIL
   ENDIF
   IF EMPTY(cPort)
      SysRefresh()
      MsgAlert("Porta nao informada", "Aviso")
      RETURN NIL
   ENDIF
   IF EMPTY(cPswr)
      SysRefresh()
      MsgAlert("Senha nao informada", "Aviso")
      RETURN NIL
   ENDIF

   cUser := SUBSTR(cMail, 1,  AT("@", cMail)-1)
   cDomi := SUBSTR(cMail, AT("@", cMail), LEN(cMail))
   WritePProString("EMAILCFG", "Usuario", ALLTRIM(cUser), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "Dominio", ALLTRIM(cDomi), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "Servidor", ALLTRIM(cServ), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "SmtpPort", ALLTRIM(cPort), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "UsrPswrd", ALLTRIM(cPswr), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "SmtpAuth", IIF(lAuth, "S", "N"), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "SmtpSSL", IIF(l_Ssl, "S", "N"), ALLTRIM(cPasta)+"\CONFIG.INI")
   WritePProString("EMAILCFG", "EmailResposta", ALLTRIM(cReply), ALLTRIM(cPasta)+"\CONFIG.INI")
   oDlg:Update()
RETURN NIL

RC da configuração:

#define SMTP_CFG	SMTP_CFG

SMTP_CFG DIALOG 66, 25, 250, 184
STYLE DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Configuração da conta SMTP"
FONT 11, "Verdana"
{
 GROUPBOX "", 34, 3, 2, 244, 102, BS_GROUPBOX
 RTEXT "E-mail:", -1, 6, 17, 54, 8
 EDITTEXT 38, 63, 15, 178, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP
 RTEXT "Servidor SMTP:", -1, 5, 34, 55, 8
 EDITTEXT 44, 63, 32, 178, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP
 RTEXT "Porta:", -1, 4, 50, 55, 8
 EDITTEXT 39, 63, 47, 30, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP
 RTEXT "Senha:", -1, 96, 50, 72, 8
 EDITTEXT 41, 171, 47, 70, 12, ES_AUTOHSCROLL | ES_PASSWORD | WS_BORDER | WS_TABSTOP
 CHECKBOX " Servidor requer autenticação", 37, 63, 63, 182, 12, BS_AUTOCHECKBOX | WS_TABSTOP
 CHECKBOX " SSL/TLS (Segurança da conexão)", 40, 63, 75, 182, 12, BS_AUTOCHECKBOX | WS_TABSTOP
 LTEXT "Obs: Ainda não há suporte para STARTTLS", -1, 73, 89, 155, 8
 GROUPBOX "", IDC_GROUPBOX6, 3, 108, 244, 53, BS_GROUPBOX
 CTEXT "Digite o e-amil para onde serão encaminhadas às respostas às mensagens que você enviar, caso deseje que tais respostas sejam enviadas para um e-mail diferente do informado acima.", -1, 20, 116, 210, 24
 EDITTEXT 36, 35, 144, 180, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP
 PUSHBUTTON "Aplicar", 46, 84, 166, 40, 14
 PUSHBUTTON "Ca&ncelar", 47, 126, 166, 40, 14
}

Link to comment
Share on other sites

  • 2 weeks later...

Tive muitos problemas como essa rotina de enviar e-mails,

então, resolvi usar a função da flexdocs, depois disso, nunca mais deu problema:

arquivos = N_PASTA+"\remessa"+STRZERO(CODEMP,3)+"\protocolos"+STRZERO(CODEMP,3)+"\"+mm_aa+"\"+Alltrim(n_cha)+"-can.xml" smtpCliente = cServ

smtpPorta = alltrim(str(nPort,3))
smtpSSL = if(lSSL,"1","0")
smtpUsuario = _cRemt
smtpSenha = cPass
HTML = "0"
confirmacao = "1"
msgResultado = ""
cResultado = 0

objNFeUtil := CreateObject("NFe_Util_2G.util")

cResultado := objNFeUtil:EnvEmail(eMailRemetente, nomeRemetente, eMailDestinatario, eMailBcc, assunto, mensagem, arquivos, smtpCliente, smtpPorta, smtpSSL, smtpUsuario, smtpSenha, HTML, confirmacao, msgResultado)

if cResultado=7100
return .t.
else
AADD(T_ERRO,"ERRO: "+ALLTRIM(STR(cResultado,5)))
return .f.
endif

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
×
  • Create New...