Codigos ADVPL

MV_WFSMTP= SMTP.MEUDOMINIO.COM.BR:25;MV_WFMAIL= informativo@meudominio.com.br;MV_WFPASSWD= ESCOLHEUMASENHAInicio cdigo Funo EnvMail*****************************************************************************#include "rwmake.ch"#include "ap5mail.ch"

/************************************************* Progrma: EnvMail Autor: Eduardo Pessoa ** Descrio: Rotina para envio de emails. ** Data: 06/12/2007 ** Parametros: EMail Origem, EMail Destino, ** Subject, Body, Anexo, .T., Bcc *************************************************/

User Function ENVMAIL(_pcOrigem,_pcDestino,_pcSubject,_pcBody,_pcArquivo,_plAutomatico,_pcBcc)// Variaveis da funo//**************************************************************Private _nTentativas := 0Private _cSMTPServer := GetMV("MV_WFSMTP")Private _cAccount := GetMV("MV_WFMAIL")Private _cPassword := GetMV("MV_WFPASSW")Private _lEnviado := .F.Private _cUsuario := Upper(AllTrim(cUserName))

// Validao dos campos do email//**************************************************************If _pcBcc == NIL_pcBcc := ""EndIf

_pcBcc := StrTran(_pcBcc," ","")

If _pcOrigem == NIL_pcOrigem := GetMV("MV_WFMAIL")EndIf

_pcOrigem := StrTran(_pcOrigem," ","")

If _pcDestino == NIL_pcDestino := "seuemail@dominio.com.br"EndIf

_pcDestino := StrTran(_pcDestino," ","")

If _pcSubject == NIL_pcSubject := "Sem Subject (ENVMAIL)"EndIf

If _pcBody == NIL_pcBody := "Sem Body (ENVMAIL)"EndIf

If _pcArquivo == NIL_pcArquivo := ""EndIf

For _nAux := 1 To 10_pcOrigem := StrTran(_pcOrigem," ;","")_pcOrigem := StrTran(_pcOrigem,"; ","")Next

If _plAutomatico == NIL_plAutomatico := .F.EndIf

// Executa a funo, mostrando a tela de envio (.T.) ou no (.F.)//**************************************************************If !_plAutomaticoProcessa({||EnviaEmail(_pcOrigem,_pcDestino,_pcSubject,_pcBody,_pcArquivo,_plAutomatico,_pcBcc)},"Enviando EMail(s)...")ElseEnviaEmail(_pcOrigem,_pcDestino,_pcSubject,_pcBody,_pcArquivo,_plAutomatico,_pcBcc)EndIf

If !_plAutomaticoIf !_lEnviadoMsgStop("Ateno: Erro no envio de EMail!!!")EndIfElseConOut("Ateno: Erro no envio de Email!")Endif

Return _lEnviado

/************************************************* Progrma: EnviaEmail Autor: Eduardo Pessoa ** Descrio: Subrotina para envio de email. ** Data: 06/12/2007 ** Parametros: EMail Origem, EMail Destino, ** Subject, Body, Anexo, .T., Bcc *************************************************/ Static Function EnviaEmail(_pcOrigem,_pcDestino,_pcSubject,_pcBody,_pcArquivo,_plAutomatico,_pcBcc)// Veriaveis da funo//**************************************************************Local _nTentMax := 50 // Tentativas mximasLocal _nSecMax := 30 // Segundos mximos Local _cTime := (Val(Substr(Time(),1,2))*60*60)+(Val(Substr(Time(),4,2))*60)+Val(Substr(Time(),7,2))Local _nAuxTime := 0

// O que ocorrer primeiro (segundos ou tentativas), ele para.//**************************************************************_cTime += _nSecMax

If !_plAutomaticoProcRegua(_nTentMax)EndIf

// Exibe mensagem no console/Log//**************************************************************ConOut("ENVMAIL=> ***** Envio de Email ***** "+AllTrim("DE:"+_pcOrigem)+"*"+AllTrim("P/:"+_pcDestino)+"*"+AllTrim("S:"+_pcSubject)+"*"+AllTrim("A:"+_pcArquivo))

For _nTentativas := 1 To _nTentMaxIf !_plAutomaticoIncProc("Tentativa "+AllTrim(Str(_nTentativas)))EndIfConOut("ENVMAIL=> ***** Tentativa "+AllTrim(Str(_nTentativas))+" ***** "+AllTrim("DE:"+_pcOrigem)+"*"+AllTrim("P/:"+_pcDestino)+"*"+AllTrim("S:"+_pcSubject)+"*"+AllTrim("A:"+_pcArquivo))CONNECT SMTP SERVER _cSMTPServer ACCOUNT _cAccount PASSWORD _cPassword RESULT _lEnviadoIf _lEnviadoIf Empty(_pcBcc)If Empty(_pcArquivo)SEND MAIL FROM _pcOrigem TO _pcDestino SUBJECT _pcSubject BODY _pcBody FORMAT TEXT RESULT _lEnviadoElseSEND MAIL FROM _pcOrigem TO _pcDestino SUBJECT _pcSubject BODY _pcBody ATTACHMENT _pcArquivo FORMAT TEXT RESULT _lEnviadoEndIfElseIf Empty(_pcArquivo)SEND MAIL FROM _pcOrigem TO _pcDestino BCC _pcBcc SUBJECT _pcSubject BODY _pcBody FORMAT TEXT RESULT _lEnviadoElseSEND MAIL FROM _pcOrigem TO _pcDestino BCC _pcBcc SUBJECT _pcSubject BODY _pcBody ATTACHMENT _pcArquivo FORMAT TEXT RESULT _lEnviadoEndIfEndIfDISCONNECT SMTP SERVEREndIfIf _lEnviado .Or. _cTime ( dbGoTop() ) // Chamada da funo para gerao co Arq. CSVIf ApMsgYesNO('Gerar Planilha em Excel agora ?') MsAguarde({||GeraExcel()},"Aguarde","Gerando dados para a Planilha",.F.) Endif

DbSelectArea("TEMP1")dbCloseArea()

Return /***********************************/ Static Function GeraExcel()/***********************************/ // Cria arquivo temporariolocal cArqTrb1 := CriaTrab(NIL,.F.) local aStru := {}Local aHeader := {}_cAlias := "TEMP1"// array com os campos para a planilhaaadd(aHeader, {"EMP " ,"RA_EMPRESA" ,"@!",10,0,"","","C","TEMP1","R"})aadd(aHeader, {"C.Custo" ,"RA_CC" ,"@!",06,0,"","","C","TEMP1","R"})aadd(aHeader, {"Matricula" ,"RA_MAT" ,"@!",06,0,"","","C","TEMP1","R"})aadd(aHeader, {"Nome" ,"RA_NOME" ,"@!",45,0,"","","C","TEMP1","R"})aadd(aHeader, {"Admissao","RA_ADMISSA" ,"@!",10,0,"","","C","TEMP1","R"})aadd(aHeader, {"Demissao","RA_DEMISSA" ,"@!",10,0,"","","C","TEMP1","R"})aadd(aHeader, {"Cod func","RA_CODFUNC" ,"@!",05,0,"","","C","TEMP1","R"})aadd(aHeader, {"Descricao","RJ_DESC" ,"@!",45,0,"","","C","TEMP1","R"})aadd(aHeader, {"Salario","RA_SALARIO" ,"@E 999,999.99",09,2,"","","N","TEMP1","R"})aadd(aHeader, {" " ,"FIM" ,"@!",02,2,"","","N","TEMP1","R"}) // COLUNA DE CONTROLE DO ENCHOICE ( DELETADO OU NO )// Este ltimo campo o marcador de registro deletado, se no for criado a ltima coluna ser utilizada para tal e perdida na planilha gerada...

// Chamada da funo de converso para a planilhaMsAguarde({||GeraCSV(_cAlias,,aHeader)},"Aguarde","Gerando Planilha",.F.)

Return

/******************************************************/Static Function geraCSV(_cAlias,_cFiltro,aHeader) /******************************************************/local cDirDocs := MsDocPath()Local cArquivo := CriaTrab(,.F.)Local cPath:= AllTrim(GetTempPath())Local oExcelAppLocal nHandleLocal cCrLf := Chr(13) + Chr(10)Local nXlocal _cArq:= ""_cFiltro := iif(_cFiltro==NIL, "",_cFiltro)if !empty(_cFiltro)(_cAlias)->(dbsetfilter({|| &(_cFiltro)} , _cFiltro))endifnHandle := MsfCreate(cDirDocs+"\"+cArquivo+".CSV",0)If nHandle > 0// Grava o cabecalho do arquivoaEval(aHeader, {|e, nX| fWrite(nHandle, e[1] + If(nX < Len(aHeader), ";", "") ) } )fWrite(nHandle, cCrLf ) // Pula linha(_cAlias)->(dbgotop())while (_cAlias)->(!eof())for _ni := 1 to len(aHeader)_uValor := ""if aHeader[_ni,8] == "D" // Trata campos data_uValor := dtoc(&(_cAlias + "->" + aHeader[_ni,2]))elseif aHeader[_ni,8] == "N" // Trata campos numericos_uValor := transform(&(_cAlias + "->" + aHeader[_ni,2]),aHeader[_ni,3])elseif aHeader[_ni,8] == "C" // Trata campos caracter_uValor := &(_cAlias + "->" + aHeader[_ni,2])endifif _ni len(aHeader)fWrite(nHandle, _uValor + ";" )endifnext _nifWrite(nHandle, cCrLf )(_cAlias)->(dbskip())enddofClose(nHandle)CpyS2T( cDirDocs+"\"+cArquivo+".CSV" , cPath, .T. )If ! ApOleClient( 'MsExcel' )MsgAlert( 'MsExcel nao instalado')ReturnEndIfoExcelApp := MsExcel():New()oExcelApp:WorkBooks:Open( cPath+cArquivo+".CSV" ) // Abre uma planilhaoExcelApp:SetVisible(.T.)ElseMsgAlert("Falha na criao do arquivo")Endif(_cAlias)->(dbclearfil())Return

Graficos em ADVPL

#include "TOTVS.CH" #include "MSGRAPHI.CH"#include "topconn.ch"

User Function TMSGraphic() DEFINE DIALOG oDlg TITLE "Exemplo TMSGraphic" FROM 180,180 TO 550,700 PIXEL

// Cria o grfico oGraphic := TMSGraphic():New( 01,01,oDlg,,,RGB(239,239,239),260,184) oGraphic:SetTitle('Titulo do Grafico', "Data:" + dtoc(Date()), CLR_HRED, A_LEFTJUST, GRP_TITLE ) oGraphic:SetMargins(2,6,6,6) oGraphic:SetLegenProp(GRP_SCRRIGHT, CLR_LIGHTGRAY, GRP_AUTO,.T.)

// Itens do Grfico nSerie := oGraphic:CreateSerie( GRP_PIE ) // GRP_PIE=10

oGraphic:Add(nSerie, 200, 'Item 01', CLR_HGREEN ) oGraphic:Add(nSerie, 180, 'Item 02', CLR_HRED ) oGraphic:Add(nSerie, 210, 'Item 03', CLR_YELLOW )

ACTIVATE DIALOG oDlg CENTERED Return

Envio de email advpl

////cVar1 - conta de email no campo FROM//cVar2 - conta de email no campo TO //cVar3//cVar4 - Mensagem do corpo do email //cVar5 - titullo do email//cVar6 - endereco do anexo//

User Function EnvMail(cVar1,cVar2,cVar3,cVar4,cVar5,cVar6)

Local lResult:= .f.// Resultado da tentativa de comunicacao com servidor de E-MailLocal cTitulo1:= Rtrim(cVar5)Local cEmailTo:= Rtrim(cVar2)Local cEmailBcc:= ""Local cError:= ""Local lRelauth := GetNewPar("MV_RELAUTH",.F.)// Parametro que indica se existe autenticacao no e-mailLocal lRet:= .F.Local cFrom:= GetMV("MV_RELACNT")//Iif(Empty(cVar1),GetMV("MV_RELACNT"),cVar1) alterado para sempre enviar da conta protheus@inforshopLocal cConta:= GetMV("MV_RELACNT")Local cSenhaa := GetMV("MV_RELPSW")Local cMensagem:= cVar4Local cAttachment := cVar6

If GetEnvServer() == "TESTE"cEmailTo:= aspassimplesmilton.nishimtoo@inforshop.com.braspassimples //GETMV("MV_WFADMIN")EndIf

//// Tenta conexao com o servidor de E-Mail //CONNECT SMTP;SERVER GetMV("MV_RELSERV"); // Nome do servidor de e-mailACCOUNT GetMV("MV_RELACNT"); // Nome da conta a ser usada no e-mailPASSWORD GetMV("MV_RELPSW") ; // SenhaRESULTlResult// Resultado da tentativa de conexo

// Se a conexao com o SMPT esta okIf lResult// Se existe autenticacao para envio valida pela funcao MAILAUTHIf lRelauthlRet := Mailauth(cConta,cSenhaa)ElselRet := .T.EndifIf lRetSEND MAIL FROM cFrom ;TO cEmailTo;BCCcEmailBcc;SUBJECT cTitulo1;BODY cMensagem;ATTACHMENT cAttachment;RESULT lResultIf !lResultIf lNWebConout("Erro no envio do email"+FunName())ElseGET MAIL ERROR cErrorHelp(" ",1,"ATENCAO",,cError+ " " + cEmailTo,4,5)EndIfEndifElseGET MAIL ERROR cErrorIf lNWebConout("Erro de autenticao"+FunName())ElseHelp(" ",1,"Autenticacao",,cError,4,5)MsgStop("Erro de autenticao","Verifique a conta e a senha para envio")EndIfEndifDISCONNECT SMTP SERVERElse//Erro na conexao com o SMTP ServerIf lNWebConout("Erro de conexao SMPT"+FunName())ElseGET MAIL ERROR cErrorHelp(" ",1,"Atencao",,cError,4,5)EndIfEndifReturn

Workflow

// --------------------------------------------------------------------------user Function SendMail (_sTo, _sSubject, _sBody, _aArq, _sReplyTo)local _lContinua := .T.local _oHtml:= NILlocal _oProcess := NILlocal _sArqHTM:= "\fontes\htm\Email_generico.htm"_aArq:= iif (_aArq== NIL, {}, _aArq)_sSubject := iif (_sSubject == NIL, "", _sSubject)_sBody:= iif (_sBody== NIL, "", _sBody)if empty (_sTo)_lContinua = .F.endifif _lContinua .and. ! file (_sArqHTM)msgalert ("Arquivo aspassimples" + _sArqHTM + "aspassimples necessario para o envio de e-mail nao foi encontrado.")_lontinua = .F.endifif _lContinuaprocregua (2)incproc ("Aguarde, enviando e-mail...")// Se o texto recebido tem quebras de linha, troca-as por tags de paragrafo em HTML._sBody = aspassimplesaspassimples + _sBody_sBody = strtran (_sBody, chr(10), "")_sBody = strtran (_sBody, chr(13), "")_sBody = _sBody + ""_oProcess := Nil_oProcess := TWFProcess():New("SendMail", "Envio de e-mail generico" )_oProcess:NewTask ("SendMail", "\fontes\htm\Email_generico.htm")for _nArq = 1 to len (_aArq)_oProcess:AttachFile (_aArq [_nArq])next_oProcess:cSubject := _sSubject_oHtml :=_oProcess:oHTMLif valtype (_oHtml) == "O"_oHtml:ValByName ("TITULO", _sSubject)_oHtml:ValByName ("TEXTO", _sBody)_oHtml:ValByName ("DataHora", dtoc (date ()) + " - " + time ())_oHtml:ValByName ("Usuario", cUserName)_oHtml:ValByName ("Rotina", FunName ())_oHtml:ValByName ("Environment", GetEnvServer ())_oProcess:cTo = _sToif valtype (_sReplyTo) == "C" .and. ! empty (_sReplyTo)_oProcess:cFromAddr = _sReplyToendif_oProcess:Start()endif_oProcess:Free()endifReturn

cSubject:= 'Acesso por ' + Alltrim(Capital(_cUser))cFrom:= 'Servidor Protheus 'cBCC:= ''cTo:= 'TEste 'cCC:= ''lHtml:= .f.cBody:= "Usuario : "+Alltrim(Capital(_cUser))+" "cBody+= "Estao : "+Alltrim(Capital(GetComputerName()))+ " - Ip : "+GetClientIp()+" "cBody+= "Ambiente do Servidor : "+Alltrim(Capital(GetEnvServer()))+" "

U_SduMandaEmail(cTo,cCC,cBCC,cSubject,cFrom,cBody,lHtml)

User Function SduMandaEmail(cPara,cCopia,cConhCopia,cAssunto,cDe,cTexto,lHtml,cFile)

Local lHtml:= Iif(ValType(lHtml)="U",.f.,lHtml)Local lOk:= .F.Local cAccount:= GetMv("MV_RELACNT") // o GetMv NAO FUNCIONA NO APSDULocal cPassword:= GetMv("MV_RELPSW")Local cServer:= GetMv("MV_RELSERV")Local cDe := Iif(cDe==Nil,'Servidor Protheus ',cDe)

SX6->( DbSeek( " "+"MV_RELACNT") )cAccount:= Alltrim(SX6->X6_CONTEUD)SX6->( DbSeek( " "+"MV_RELPSW" ) )cPassword:= Alltrim(SX6->X6_CONTEUD)SX6->( DbSeek( " "+"MV_RELSERV") )cServer:= Alltrim(SX6->X6_CONTEUD)

Connect Smtp Server cServer Account cAccount Password cPassword Result lOk

IflOkIf ! MailAuth(cAccount,cPassword)Get Mail Error cErrorMsgHelp("",1,"AVG0001056",,"Error: "+cErrorMsg,2,0)Disconnect Smtp Server Result lOkif !lOkGet Mail Error cErrorMsgHelp("",1,"AVG0001056",,"Error: "+cErrorMsg,2,0)endifReturn ( .f. )EndIfIf !Empty(cCopia)if lHtmlIf !Empty(cFile)Send Mail From cDe To cPara CC cCopia Subject cAssunto Body cTexto Attachment cFile Result lOkElseSend Mail From cDe To cPara CC cCopia Subject cAssunto Body cTexto Result lOkEndIfelseIf !Empty(cFile)Send Mail From cDe To cPara CC cCopia Subject cAssunto Body cTexto Format Text Attachment cFile Result lOkElseSend Mail From cDe To cPara CC cCopia Subject cAssunto Body cTexto Format Text Result lOkEndIfendifElseif lHtmlIf !Empty(cFile)Send Mail From cDe To cPara BCC cConhCopia Subject cAssunto Body cTexto Attachment cFile Result lOkElseSend Mail From cDe To cPara BCC cConhCopia Subject cAssunto Body cTexto Result lOkEndIfelseIf !Empty(cFile)Send Mail From cDe To cPara BCC cConhCopia Subject cAssunto Body cTexto Format Text Attachment cFile Result lOkElseSend Mail From cDe To cPara BCC cConhCopia Subject cAssunto Body cTexto Format Text Result lOkEndIfendifEndIfIf ! lOkGet Mail Error cErrorMsgHelp("",1,"AVG0001056",,"Error: "+cErrorMsg,2,0)EndIfElseGet Mail Error cErrorMsgHelp("",1,"AVG0001057",,"Error: "+cErrorMsg,2,0)EndIfDisconnect Smtp Server

Return