enviar correo desde prg

[LuisPonce]

Antonio, Amigos

Me parece que falta el fichero de cabecera CdoSys.ch

Verificar que la cuenta de Gmail exista, y el password sea el correcto, el usuario es el texto que precede a "@"

El problema es el usuario y la contraseña, ya lo repliqué

Alex te pasé un mail, con el mismo

[karinha]

CDOSYS.CH

Code: Select all  Expand view

#ifndef _CDOSYS_CH
#define _CDOSYS_CH
#define cdoSMTPServer       "http://schemas.microsoft.com/cdo/configuration/smtpserver"
#define cdoSMTPServerPort   "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
#define cdoSendUsing        "http://schemas.microsoft.com/cdo/configuration/sendusing"
#define cdoSMTPPickupFolder "http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory"
#define cdoSMTPAuthenticate "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
#define cdoSendUserName     "http://schemas.microsoft.com/cdo/configuration/sendusername"
#define cdoSendPassword     "http://schemas.microsoft.com/cdo/configuration/sendpassword"
#define cdoSMTPUseSSL       "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
#endif
 

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=14663

Salu2

[horacio]

Verificar parámetros de gmail también,

viewtopic.php?f=6&t=30758&p=177128#p177128

Saludos

[MarioG]

A mi tampoco me funciona.
Primero probé con la cuenta GMail, luego con la Yahoo
Esto recibí de respuesta:


Que se haga la Luz!!

[LuisPonce]

Mario

en servidor de correo: smtp.gmail.com
en Autenticacion:Usuario: cuentagmail .......(sin @gmail.com)
en Contraseña: tu contraseña

En cuerpo: cualquier cosa

Y lo comentas

Saludos

[MarioG]

Luis;
gracias por responder.
He leido todos los post y pongo cuidado en todas indicaciones, pero no hay caso
Lo único que noto es que si mando con servidor gmail, tarda bastante menos en responder con el msg de error, que si mando con yahoo.
En ambos casos me da error 1001

[karinha]

Mário, use un otro proveedor. Acá, funciona perfecto. Saludos.

[nnicanor]

Para configurar tu cuenta para el acceso desde fuera de gmail hay que ir a la configuración de la cuenta -> comprobación de seguridad -> Inhabilitar el acceso para las aplicaciones menos seguras. ponerla en activo ademas hay que activar el acceso POP.

En esta funcion puedo enviar el cuerpo del mensaje y un archivo adjunto, funciona perfectamente.

Code: Select all  Expand view

#include "CdoSys.ch"
#include "hbcompat.ch"

// 314 444 1832 maria.
#ifndef _CDOSYS_CH
#define _CDOSYS_CH
#define cdoSMTPServer            "http://schemas.microsoft.com/cdo/configuration/smtpserver"
#define cdoSMTPServerPort        "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
#define cdoSendUsing             "http://schemas.microsoft.com/cdo/configuration/sendusing"
#define cdoSMTPPickupFolder      "http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory"
#define cdoSMTPAuthenticate      "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
#define cdoSendUserName          "http://schemas.microsoft.com/cdo/configuration/sendusername"
#define cdoSendPassword          "http://schemas.microsoft.com/cdo/configuration/sendpassword"
#define cdoSMTPUseSSL            "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
#define cdoSMTPConnectionTimeout "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
#endif


.......
.....


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

Function AUDITS( cTextoC, cAdjunto, nCual )

Local oEmailCfg,oEmailMsg,oError,cHtml
Local cDestino := "destinatario@gmail.com"
Local cAsunto  
Local cTexto   :=  "El sistema de Soporte ha recibido la siguiente Notificacion "+CRLF+CRLF+CRLF+cTextoC+CRLF+CRLF+CRLF+"Atentamente,"+CRLF+CRLF+CRLF+"Soporte Aplicaciones"


DEFAULT cTextoC  := ""
DEFAULT nCual  := 1

If nCual == 1

  cAsunto:= "NOTIFICACION DE ACCESO "+cFileNoPath(GetModuleFileName( GetInstance() ))
 
Elseif nCual== 2
 
  cAsunto := "NOTIFICACION DE ERROR "+cFileNoPath(GetModuleFileName( GetInstance() ))
 
Endif    

if Empty(cDestino )
   MsgWait("No ha puesto un destinatario")
   Return .f.
endif

TRY

    oEmailCfg := CREATEOBJECT( "CDO.Configuration" )
   
     WITH OBJECT oEmailCfg:Fields
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value           := "smtp.gmail.com"
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value       := 465
         :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value            := 2 // Remote SMTP = 2, local = 1
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value     := .T.
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value           := .T.
         :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value         := "lacuenta@dominio.com" // hosteado con gmail o gmail.com
         :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value         := "laclave"
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"):Value := 60
         :Update()
    END WITH

CATCH oError
         MsgInfo( "Error Auditoria " + ";" + ;
                  "Error: " + TRANSFORM(oError:GenCode, NIL) + ";" + ;
                  "SubC: " + TRANSFORM(oError:SubCode, NIL) + ";" + ;
                  "OSCode: " + TRANSFORM(oError:OsCode, NIL) + ";" + ;
                  "SubSystem: " + TRANSFORM(oError:SubSystem, NIL) + ";" + ;
                  "Message: " + oError:Description )
END

oError:=NIL

TRY

   oEmailMsg := CREATEOBJECT ( "CDO.Message" )

   WITH OBJECT oEmailMsg

       :Configuration = oEmailCfg
       :From          := "remitenteo@dominio.com" // remitente o @gmail.com
       :To            := "destinatario@adonde.com"
       :Subject       := cAsunto
       :MDNRequested  := .T.
       :TextBody      := cTexto
       
         if !Empty(cAdjunto)
         
             :AddAttachment(alltrim(cAdjunto))
       
         endif

    END WITH

    oEmailMsg:Send()

CATCH oError

    MsgInfo( "Error Auditoria " + ";" + 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

//MsgInfo("Correo enviado correctamente")

Return .T.


 

[LuisPonce]

Me parece que toca revisar la configuracion de la cuenta, como dice nnicanor

[MarioG]

Gente;
Estoy buscando como llegar, en GMail, a: Inhabilitar el acceso para las aplicaciones menos seguras
Y no encuentro nada que me lleve a deshabilitar

Por otro lado la pregunta es:
Si un cliente no usa GMail?.
Como tengo otra cuenta en Yahoo, probé, y tampoco envia (quizás también tenga algo parecido a GMail y bloquea la salida).
Probaron con otro servidor?

[MarioG]

Esto es lo que obtengo ahora



a que se refiere?

[nnicanor]

Para las cuentas de yahoo se usa la misma configuración de puerto y seguridad de gmail inclusive con office365 corporativo tambien funciona, lo que no estoy seguro es si las cuentas gratuitas de yahoo permiten el acceso desde aplicaciones de terceros.

[George]

Inhabilitar el acceso para las aplicaciones menos seguras:
https://support.google.com/accounts/answer/6010255?hl=en

Saludos,

George

[FranciscoA]

Alex:

Horacio wrote: Verificar parámetros de gmail también,

George wrote: Inhabilitar el acceso para las aplicaciones menos seguras:

A mi me funciona (cuenta gmail).

Abrir tu correo Gmail.
Click sobre icono de tu cuenta google (arriba a la derecha)
Click boton mi cuenta
En inicio de sesion y seguridad, click Aplicaciones y sitios conectados
Bajar barra deslizante hasta : Permitir el acceso de aplicaciones menos seguras:
Aqui seleccionas Si, y listo...

[karinha]

otro ejemplo:

Code: Select all  Expand view

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

Static cAttach := ""
Static aAttach := {}
********************************************************************************

static oWnd

function Main()

   local oBar

   LOCAL nTop := 2, nLeft := 2, oBtn1, oBtn2
   LOCAL cUser := SPACE(50), cRemt := SPACE(50), cDest := SPACE(250), cTime, ;
         cTxt := SPACE(1000), cAssunto := SPACE(100), cCC := SPACE(250),     ;
         cCCO := SPACE(250)
   LOCAL oGet[8], oSay[12], oBtn[3], nItem := 0
   LOCAL cDados, i, oAdd, oDel, oFont, cTitle, o1, oTahoma, rCampo, oBrush
   LOCAL cServPOP3, cServSMTP, nServPORT, cServSEGU, oPlenoWin, oFntTest
   LOCAL cDSayDin
   LOCAL cNfe := .F., cTTP := "", CANEXO := ""

   cDest := SPACE(250)
   cTxt := SPACE(1000)
   cAssunto := SPACE(100)
   cCC := SPACE(250)
   cCCO := SPACE(250)

   cDest    := "joao@pleno.com.br" + SPACE(233)
   cAssunto := "TESTE DO ENVIADOR DE EMAIL DA NFE" + SPACE(67) // = 100
   cPass := SPACE(15)
   CTXT := cAssunto

   DEFINE WINDOW oWnd TITLE "3D objects"

   DEFINE BUTTONBAR oBar _3D OF oWnd

   DEFINE BUTTON OF oBar ;
          ACTION testmail(cDest,cCC,CTXT,cAnexo,cPass,cAssunto,cNfe,cTTP)

   SET MESSAGE OF oWnd TO "3D Objects" NOINSET CLOCK DATE KEYBOARD

   ACTIVATE WINDOW oWnd

return nil



Function testmail(cDest,cCC,CTXT,cAnexo,cPass,cAssunto,cNfe,cTTP)

  local cUser := Space(50), cRemt := Space(50), ;
        cTime, cList:=Space(100),nItem:=0,;
        cCCO := "valpanemaserraria@uol.com.br"
  local oDlg, oGet[8], oSay[12], oBtn[2]
  local cDados, i

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

   PRIVATE aServs := { {"@hotmail.com",       "smtp.live.com",            25, .T. },;
                       {"@yahoo.com",         "smtp.mail.yahoo.com",     465, .F. },;
                       {"@gmail.com",         "smtp.gmail.com",          465, .T. },;
                       {"@outlook.com.",      "smtp-mail.outlook.com",   465, .T. },;  // era hotmail.com
                       {"@uol.com.br",        "smtps.uol.com.br",        465, .T. },;
                       {"@bol.com.br",        "smtps.bol.com.br",        587, .F. },;  // mudou em: 06/08/2013-Marli-CGA.
                       {"@terra.com.br",      "smtp.terra.com.br",       465, .T. },;
                       {"@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. },;
                       {"@pleno.com.br",      "smtp.pleno.com.br",       587, .F. } }

  Private aDomin := {}, nServ := 1

  for i := 1 to len( aServs )
    AADD( aDomin, aServs[i][1] )
  next

  IF cNfe=.T.
     IF len(alltrim(cDest))==0
        MsgStop( "Email Não Cadastrado" +CRLF+;
                 "Envio Cancelado!!!")
        RETURN(.F.)
    endif
    IF !FILE(cAnexo)
        MsgStop( "Arquivo XML Não Encontrado" +CRLF+;
                 "Caminho:"                   +CRLF+;
                 cAnexo                       +CRLF+;
                 "Envio Cancelado!!!")
        RETURN(.F.)
    endif
  ENDIF
  if file("dadosmail.dat")
    cDados := StrTran(MemoRead( "dadosmail.dat" ), "@hotmail.com", "")
    cUser := Memoline( cDados, 250, 1)
    cRemt := Memoline( cDados, 250, 2)
    if MlCount( cDados, 250 ) >= 3
        nServ := Val(Alltrim(Memoline(cDados, 250, 3)))
    endif
    if MlCount( cDados, 250 ) >= 4
        if Alltrim(Alltrim(Memoline(cDados, 250, 4))) = "0"
            lCheck := .f.
        else
            lCheck := .t.
        endif
    endif
  endif

  if nServ = 0 .or. nServ > len(aServs)
     nServ := 1
  endif

  Set Delete ON

  ArqsDBF()
  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 "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
    @ 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[7] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update
    @ 132, 006 GET oGet[8] 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

    //oList:ADD(Alltrim(cAnexo))

    oList:Hide()
    oList:Refresh()
    oList:Show()

*****--- 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!","Confirmação de Envio"),DELItem(),ATUALIZA_CONFIRMACAO_EMAIL(cTTP),lSair := .t.,(Codigos->(dbCloseArea()),Cabgrupo->(dbCloseArea()),Grupos->(dbCloseArea()),Contatos->(dbCloseArea())),oDlg:End() ),), 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.,DELItem(),(Codigos->(dbCloseArea()),Cabgrupo->(dbCloseArea()),Grupos->(dbCloseArea()),Contatos->(dbCloseArea())),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 "_loc.bmp" Prompt "Para" size 32,10 Pixel Right Action Inclui( oGet[4], @cDest )
    @ 072, 006 BtnBmp oBt2 File "_loc.bmp" Prompt "CC"   size 32,10 Pixel Right Action Inclui( oGet[5], @cCC   )
    @ 082, 006 BtnBmp oBt3 File "_loc.bmp" Prompt "CCO"  size 32,10 Pixel Right Action Inclui( oGet[6], @cCCO  )

  ACTIVATE DIALOG oDlg CENTERED VALID ( Fim( cUser, cRemt, nServ) ) On Init Inicio( oDlg )

Return Nil

//------------------------------------------------------------------------------
Function ATUALIZA_CONFIRMACAO_EMAIL(cTTP)
   if cTTP==.t.
      SELE 17
      DO WHILE !RLOCK()
      ENDDO
      REPL SENDMAIL WITH "S"
      UNLOCK
      ARQNFE->(DBCOMMIT())
   endif
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 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]


  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.

  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. aqui")
           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

//-----------------------------------------------------------------
Static Function ArqBmp()
Local cHexa
if file("_loc.bmp")
    Return NIL
endif   

cHexa := "424df6000000000000003600000028000000080000000800000001001800"
cHexa += "00000000c0000000c30e0000c30e00000000000000000000ffffffffffff"
cHexa += "fffffffffffffffffff6f7fae9edf4ffffffffffffffffffffffffffffff"
cHexa += "f4f6fa9bb9d7749fc8d7e1edffffffebf2f7b7cfe4b1c9e18ab2d386bfdb"
cHexa += "71a4cacdd6e5ebf3f8a3c6ddc1d3e2dbe3e9abc9dd6fa6cec1d3e7ffffff"
cHexa += "c6deecbad4e2fff9effff7edfcf7f09ab8d5e5edf5ffffffc4ddedc7dce6"
cHexa += "fff6ebfbf2e9fff7efaec8dde4edf5ffffffdeedf5a9cee2e7ebeaf5f1eb"
cHexa += "d8e2e89ec0dbf1f6faffffffffffffd6e8f2acd0e4b5d4e6aacde2e2edf5"
cHexa += "ffffffffffff"

MemoWrit( "_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

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