***************************************************************
* 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
Enviador de emails
Moderador: Moderadores
1 Mensagem • Página 1 de 1
Enviador de emails
por Kapiaba » 13 Nov 2015 09:44
-
Kapiaba Colaborador 
- Mensagens: 1766
- Data de registro: 07 Dez 2012 15:14
- Cidade/Estado: São Paulo
- Curtiu: 311 vezes
- Mens.Curtidas: 119 vezes
Ver tópicos ativos •
1 Mensagem • Página 1 de 1
Quem está online
Usuários vendo este fórum: Nenhum usuário registrado online e 12 visitantes

Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
