Alain da Silva Posted November 13, 2015 Report Share Posted November 13, 2015 bom dia pessoal, de segunda pra ca não estou conseguindo enviar mais email, alguem sabe se mudou alguma configuração. detalhe uso windows xp. Uso o provedor uol mas não estou conseguindo também com o terra. *************************************************************** * 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 := {} ******************************************************************************** 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.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", "smtp.bol.com.br", 25, .f. },; {"@terra.com.br", "smtp.terra.com.br", 25, .f. },; {"@ig.com.br", "smtp.ig.com.br", 465, .t. },; {"@ibest.com.br", "smtp.ibest.com.br", 465, .t. },; {"@itelefonica.com.br","smtp.itelefonica.com.br", 25, .f. },; {"@pop.com.br", "smpt.pop.com.br", 25, .f. } } 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 Ronaldbuch 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted November 13, 2015 Report Share Posted November 13, 2015 Uma imagem fala por si... Quote Link to comment Share on other sites More sharing options...
kapiaba Posted November 13, 2015 Report Share Posted November 13, 2015 *************************************************************** * 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 Quote Link to comment Share on other sites More sharing options...
Alain da Silva Posted November 13, 2015 Author Report Share Posted November 13, 2015 Obrigado pela resposta João, pois é, funcionava normal. Será que é em função do windows XP. Até o outlook não esta funcionando, apenas recebendo mensagens no outlook. Como falei, meu provedor é o uol, se eu entro pelo Webmail normal. att alain Quote Link to comment Share on other sites More sharing options...
kapiaba Posted November 13, 2015 Report Share Posted November 13, 2015 Crie um email no www.bol.com.br e teste para ver. Testei e funcionou perfeito. Funcionando ai, ligue para o uol, pois eles podem estar com algum problema. abs. Quote Link to comment Share on other sites More sharing options...
Alain da Silva Posted November 13, 2015 Author Report Share Posted November 13, 2015 vou testar em outra máquina pra ver. ja testei no terra e dá o mesmo erro. mas valeu. abs Quote Link to comment Share on other sites More sharing options...
frkiko Posted November 15, 2015 Report Share Posted November 15, 2015 Pode ser que o provedor esteja barrando acesso externo. O Hotmail já tinha barrado isso, a pouco tempo o Gmail barrou também. Quote Link to comment Share on other sites More sharing options...
marcioe Posted January 20, 2016 Report Share Posted January 20, 2016 Alguem sabe se o gmail ando barrando isso Quote Link to comment Share on other sites More sharing options...
VLNUNES Posted January 20, 2016 Report Share Posted January 20, 2016 Uso esta rotina, e envia normalmente, mas só por rede cabeada, em wifi não envia e dá o aviso de mensagem não enviada. Testei em vários computadores em redes diferentes, só envia através de rede cabeada. kapiaba 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted January 26, 2016 Report Share Posted January 26, 2016 Alguem sabe se o gmail ando barrando isso gmail e hotmail, não consegui enviar nem a Pau! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.