Ariston Santos

Olá, amigos. Pelo visto a obrigatoriedade de informar o CEST será prorrogada de novo. Favor analisar este link sobre o assunto. http://www.spedbrasil.net/forum/topics/cest-nova-data-janeiro-2017

Testei a dica do WinExec(CurDrive()+":\"+CURDIR()+"\"+AllTrim(cFileName(HB_ARGV(0)))), acima, mas não funcionou. Vou continuar usando esta: cAtuInf := "@ECHO OFF"+CRLF+; "COLOR F1"+CRLF+; "TASKKILL /IM "+cFileName(HB_ARGV(0))+" /F"+CRLF+; "START "+cFileName(HB_ARGV(0))+CRLF+; "EXIT" if file(".\Executa.bat") ; ferase(".\Executa.bat") ; endif arq2 := fcreate(".\Executa.bat") fwrite(arq2, cAtuInf) fclose(arq2) WAITRUN( GetEnv( 'ComSpec' )+' /C START .\Executa.bat"', 0 ) SYSWAIT(3) PostQuitMessage( 0 ) QUIT

Que tal tirar os <p> (paragrafos) e substituir os CRLF por <br /> (quebra de linha em HTML). Ex: cMsg := STRTRAN(cMsg, CRLF, "<br /><br />") // Pulando uma linha Detalhe: Se iniciar um parágrafo com <p>, tem que finalzar com </p>. No seu exemplo acima estou vendo o </p> so no final de todos os parágrafos. Assim, apesar do uso da HB_OsNewLine(), que retorna Chr(13)+Chr(10) (ou apenas Chr(10), dependendo do S.O.), todo o seu texto consiste em apenas um parágrafo, a não ser que você também converta o HB_OsNewLine(). Ex: cMsg := STRTRAN(cMsg, HB_OsNewLine(), "<br /><br />")

Teste o ESCRITA FISCAL da NetSpeed e achei muito bom. Gera todos os arquivos (SPED, SINTEGRA, ETC) e importa de vários formados (XML, TDM...). Pelo que notei, é desenvolvido com xHarbour 123 simplex e Fivewin (FWH 15.07).

Tem um contador que solicita esse arquivo eu sempre envio o TDM e ele aceita. Até o momento imagino que seja a mesma coisa. Se for, pelo BEMATOOLS PRO dá para gerar.

Só criando o cálculo na munheca. Dica: http://www.wikihow.com/Calculate-Cube-Root-by-Hand

Não entendo muito de TRIGGER mas dando uma olhada no código já deu para ver um aparente erro: A instrução "DROP TRIGGER /*!50032 IF EXISTS */ `tr_vendas`$" existe nos dois códigos. Se esta instrução serve para excluir a TRIGGER `tr_vendas`, ela só existirá para a o evento AFTER UPDATE, pois está sendo excluída imediatamente após ser criada para o evento AFTER DELETE. Se minha observação estiver certo, experimente usar nomes diferentes para cada evento. Ex: "DROP TRIGGER /*!50032 IF EXISTS */ `tr_vendas_del`$" -> Para o evento AFTER DELETE "DROP TRIGGER /*!50032 IF EXISTS */ `tr_vendas_upd`$" -> Para o evento AFTER UPDATE E crie TRIGGERS com nomes distintos para cada evento, tipo: TRIGGER `tr_vendas_del` AFTER DELETE ON `vendas` TRIGGER `tr_vendas_upd` AFTER UPDATE ON `vendas` Acertei?

Olá. Não sei se ainda é valida a notícia deste link sobre o assunto: http://www.projetoacbr.com.br/forum/topic/26663-prorroga%C3%A7%C3%A3o-bloco-k-c%C3%B3digo-cest-e-base-%C3%BAnica-no-c%C3%A1lculo-da-difal/ Se for, ganhamos mais um tempinho.

Já passei por isso antes. No meu caso era em apenas um dos DBFs que estava demorando. Para descobrir isso, fiz algo do tipo: SysRefresh() ; MsgInfo("Ja passei do DBF tal","Ok") Quando descobrir qual o DBF que estava demorando, melhorei o tipo de filtro. Parei de usar SET FILTER TO e passei a usar um filtro de índice temporário, tipo INDEX ON DATA TAG... WHILE( DATA >= DataInicial .AND. DATA <= DataFinal) no DBF que estava demorando. No meu caso, isso resolveu.

Kkk Good LUCK fou you too. I like you guy. I am you fan.

Amigo, se você conseguir vou dizer que "VOCÊ É O CARA!". Pesquisando descobri que para gerar esse código na imagem é usado algo do tipo: <?php session_start(); $codigoCaptcha = substr(md5( time()) ,0,9); $_SESSION['captcha'] = $codigoCaptcha; $imagemCaptcha = imagecreatefrompng("fundocaptch.png"); $fonteCaptcha = imageloadfont("anonymous.gdf"); $corCaptcha = imagecolorallocate($imagemCaptcha,255,0,0); imagestring($imagemCaptcha,$fonteCaptcha,15,5,$codigoCaptcha,$corCaptcha); header("Content-type: image/png"); imagepng($imagemCaptcha); imagedestroy($imagemCaptcha); ?> Depois de dar um SUBMIT no formulário é usado outro .php para validar o código. Portanto, é preciso não só saber de antemão qual é o código como também enviar isso via parâmetro para o .php validador capturar e validar. Até onde sei, só os administradores do site poderão fornecer essa informação, se isso for permitido. Só espero estar errado.

Obrigado, amigo. Para não usar o ON CHANGE, descobri esta outra maneira: REDEFINE COMBOBOX oCtr67 VAR cOriPr ID 67 OF oFld:aDialogs[3] UPDATE ITEMS aOrigPr oCtr67:cToolTip := {|cTip|cTip:=oCbxToolTip(oCtr67)} //---------------------------------------------------------------------------// FUNCTION oCbxToolTip(oCtr67) RETURN oCtr67:GetText()

Olá. Embora meio tardio mas aqui está: FUNCTION SqlBackup() cMySqlFl := "C:\Program Files\VertrigoServ\Mysql\bin" cBkpFldr := cGetDir() cBkpFile := "backup-"+DTOS(DATE())+"-"+ALLTRIM(STR(SECS(LEFT(TIME(),5))))+".sql" cServ := "localhost" cUser := "root" cSenh := "vertrigo" cBanc := "test" cDirAtu := CurDrive()+":\"+CurDir() if file(cDirAtu+"\CriarBkp.bat") ferase(cDirAtu+"\CriarBkp.bat") endif cAtuInf := '@echo off'+CRLF+; 'color f1'+CRLF+; 'cls'+CRLF+; 'echo.'+CRLF+; 'echo.'+CRLF+; 'echo Criando backup do banco de dados. Aguarde...'+CRLF+; '"'+cMySqlFl+'\mysqldump.exe" -h'+cServ+' -u'+cUser+' -p'+cSenh+' --triggers'+' '+cBanc+' > '+cBkpFldr+'\'+cBkpFile+CRLF+; 'echo.'+CRLF+; 'echo.'+CRLF+; 'echo Criacao do backup concluida com exito. Tecle [Enter] para fechar...'+CRLF+; 'PAUSE > NUL'+CRLF+; 'EXIT' arq2 := fcreate(cDirAtu+"\CriarBkp.bat") fwrite(arq2, cAtuInf) fclose(arq2) WAITRUN( GetEnv( "ComSpec" )+" /C START "+cDirAtu+"\CriarBkp.bat", 0 ) RETURN NIL

Olá, amigos. Como faço para mostrar o conteudo do item selecionado como tooltip do COMBOBOX? E se selecionar outro item, mudar o tip para o novo item selecionado? Grato!

Amigos, eu não tenho rotina de atualização automática via ftp. A atualização no servidor eu mesmo faço e somente com todos terminais fechados. Apenas os terminais executam a rotina de atualização automática pegando os arquivos atualizados do servidor. Isto é feito na primeira execução após a atualização do servidor. Em breve pretendo desenvolver uma rotina para atualização via ftp. Minha idéia é deixar um programinha rodando no tray que fará verificação periódica no ftp. Se detectar uma atualização ele vai baixar o instalador e apenas avisar. A atualização só será feita mediante confirmação. E se algum terminal ainda estiver com o sistem rodando, não vou deixar fazer a atualização.

Ah, tá. Eu não tinha percebido que ele estava querendo para ftp.

Oi, Kleyber. Ainda não faço backup em FTP. O exemplo acima, conforme você pode notar, só serve para rede local com pasta compartilhada. Mas tenho um programinha que faz leitura em FTP periodicamente, só que com outra finalidade. A função abaixo mostra um exemplo de como ele funciona. *------------------------------------------------------------------------------* STATIC FUNCTION ChecaEntTxt() LOCAL cFldEn := ALLTRIM(GetPvProfString( "ENTIRE_CFG", "PastaEntrada", " ", cAppPath+"\SISCOM.INI")) LOCAL c_Ftp := GetPvProfString( "CONNECTION", "eFtp", " ", ".\siscomon.ini") LOCAL c_Usr := GetPvProfString( "CONNECTION", "eLog", " ", ".\siscomon.ini") LOCAL c_Psw := GetPvProfString( "CONNECTION", "ePsw", " ", ".\siscomon.ini") LOCAL c_Fld := GetPvProfString( "CONNECTION", "eDir", " ", ".\siscomon.ini") LOCAL cMsg := "", lNovo := .F. Count1 ++ if Count1 < nWait1 ; RETURN NIL ; ENDIF // Só verificar se decorrido o tempo de espera definido em nWait1 Count1 := 0 // Resetar o tempo decorrido nWait1 := 600 // Apos a primeira vez, verificar a cada 10*60 segundas (10 minutos) * ShowMsgTray("Verificando FTP", "Aguarde...") TRY oFTP := qFTPClient():New(c_Ftp, 21, {|cMessage| Logfile("logftp.txt",{cMessage})},,c_Usr, c_Psw) oFTP:lPassive := .T. if oFTP:Connect() if oFTP:Cd(c_Fld) if oFTP:Dir() a_Fls := {} FOR nLin := 1 TO LEN(oFTP:acDir) IF ".TXT" $ Alltrim(Substr(oFTP:acDir[nLin],40,256)) // Não pegar se não for txt (ex: index.php) n_At := AT("ARPED_", oFTP:acDir[nLin]) AADD(a_Fls, Alltrim(Substr(oFTP:acDir[nLin],n_At,256)) ) ENDIF NEXT IF LEN(a_Fls) > 0 for nPd := 1 TO LEN(a_Fls) c_Arq := a_Fls[nPd] IF ! EMPTY(c_Arq) IF ! FILE(cFldEn+"\"+c_Arq) lRtr := oFTP:Retr(c_Arq, cFldEn+"\"+c_Arq) // c_Fld+"/"+ IF lRtr lNovo := .T. ShowMsgTray(c_Arq, "Novo pedido") ELSE ShowMsgTray(c_Arq+": Não recuperado", "Pedido externo") ENDIF ENDIF ENDIF next ELSE * ShowMsgTray("Próxima verivicação em 10 minutos.", "Sem novos pedidos") * SysWait(3) * ShowMsgTray() ENDIF oFTP:Quit() oFTP:End() else * ShowMsgTray("Próxima verivicação em 10 minutos.", "Sem novos pedidos") oFTP:Quit() oFTP:End() * SysWait(3) * ShowMsgTray() endif else oFTP:Quit() oFTP:End() endif endif CATCH oErr ShowMsgTray(oErr:Description, "Erro de FTP") END TRY IF ! lNovo // Sem novos pedidos. Apenas avisar se existir algum não importado na pasta. cEntFld := ALLTRIM(GetPvProfString( "ENTIRE_CFG", "PastaEntrada", " ", cAppPath+"\SISCOM.INI")) IF lIsDir(cEntFld) aFiles := Array( ADir( cEntFld+"\SDZ*.TXT" ) ) ADir := ADir( cEntFld+"\SDZ*.TXT", aFiles ) IF LEN(aFiles) > 0 IF EMPTY(cMsg) ; cMsg += "Chegou pedido" ; ENDIF cMsg += " da SANDOZ" ENDIF aFiles := DIRECTORY(cEntFld+"\ARPED*.TXT") IF LEN(aFiles) > 0 IF EMPTY(cMsg) ; cMsg += "Chegou pedido" ; ELSE ; cMsg += "e" ; ENDIF cMsg += " do SISCOMDroid" ENDIF ENDIF SysRefresh() IF ! EMPTY(cMsg) ShowMsgTray(cMsg, "Novo pedido") ENDIF ENDIF RETURN NIL Se te interessar, me avisa que posto is prgs por email.

No próprio EXE. • Gravo em DBF local o endereço do executável no servidor: Exemplo: \\servidor\siscom • Antes do menu principal executo a codificação acima. Portanto, isso é feito no momento da execução do programa. Como você pode ver, basta inserir o código acima em algum ligar antes do seu menu principal. Atribua à variável "cDirSrv" o endereço (pasta compartilhada) do seu EXE no servfidor e à "cExeName" o nome do seu executável. Para mais detalhes me chame pelo Whats: 9691281920 (Sem o 9 adicional)

O modo como uso atualmente foi melhorado. Comparo pelo MD5 do executável no servidor. Dou um TASKILL no EXE local para garantiar a atualização. Após a copia abro o EXE atualizado com START para a tela do DOS não ficar aberta. Uso instrução em INI para veriricar automaticamente a base de dados local após a atualização. Reveja abaixo e vê se dá para aproveitar alguma coisa. // Descomente as 3 linhas abaixo para checar por MD5 (Comente o teste por data e hora) cMd5This := HB_MD5File( cExeName ) cMd5That := HB_MD5File( cDirSrv+"\"+cExeName ) IF cMd5This != cMd5That // Vai atualizar cDirAtu := CurDrive()+":\"+CurDir() if file(cDirAtu+"\ATUALIZA.BAT") ferase(cDirAtu+"\ATUALIZA.BAT") endif WritePProString("ACESSOS", "ChecarDbf", "T", ".\SISCOM.INI") cAtuInf := "TASKKILL /IM "+cExeName+" /F"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\bitmaps\*.* "+cDirAtu+"\bitmaps\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\bitmaps\papel\*.* "+cDirAtu+"\bitmaps\papel\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\modelos\*.* "+cDirAtu+"\modelos\"+CRLF+; "XCOPY /S /Y /D "+cDirSrv+"\manual\*.* "+cDirAtu+"\manual\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\DLL32\*.dll "+cDirAtu+"\DLL32\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\*.dll "+cDirAtu+"\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\"+cExeName+" "+cDirAtu+CRLF+; "START "+cExeName+CRLF+; "EXIT" arq2 := fcreate(cDirAtu+"\ATUALIZA.BAT") fwrite(arq2, cAtuInf) fclose(arq2) WAITRUN( GetEnv( "ComSpec" )+" /C START "+cDirAtu+"\ATUALIZA.BAT", 0 ) SYSWAIT(3) ELSE // Não precisa atualizar. Exclui o ATUALIZA.BAT se existir. IF FILE(".\ATUALIZA.BAT") ferase(".\ATUALIZA.BAT") ENDIF ENDIF

Amigo, um conselho: Tira esse monte de SysRefresh daí, pelo amor de Deus!!!! (kkk) Simplificando sua rotina, deixa ela assim: SELECT ARQ_BALCAO ARQ_BALCAO->(DBSETORDER(1)) TRY ARQ_BALCAO->(dbappend()) // Não precisa RLOCK() depois de DBAPPEND() REPLACE ARQ_BALCAO->ESTADO WITH " ",ARQ_BALCAO->OPERADOR WITH USER000,ARQ_BALCAO->DESCONTOS WITH DESCTO,ARQ_BALCAO->CLIENTE WITH STRZERO(COD_CLI,6),ARQ_BALCAO->VENDEDOR WITH STRZERO(COD_VEND,6),ARQ_BALCAO->COMPLEMENT WITH MM_COMP,ARQ_BALCAO->EMBALAGEM WITH UNID,ARQ_BALCAO->ORIGINAL WITH A04 REPLACE ARQ_BALCAO->SALDO_ATUA WITH SDA,ARQ_BALCAO->COD_VENDA WITH STR(NUME,13),ARQ_BALCAO->DATA_MOV WITH DATE(),ARQ_BALCAO->HORA_MOV WITH TIME(),ARQ_BALCAO->CODIGO WITH A01,ARQ_BALCAO->UNITARIO1 WITH A044,ARQ_BALCAO->VAL_TOTAL1 WITH A04,ARQ_BALCAO->DESC_INDIV WITH DES_AVI REPLACE ARQ_BALCAO->QUANTIDADE WITH 1,ARQ_BALCAO->UNITARIO WITH A04,ARQ_BALCAO->VAL_TOTAL WITH A04,ARQ_BALCAO->TERMINAL WITH STR(T_MAQ,3),ARQ_BALCAO->DATA_CAD WITH DATE(),ARQ_BALCAO->HORA_CAD WITH TIME(),ARQ_BALCAO->QUEM_CAD WITH USER000,arq_balcao->forma_pag with SO_ER SELPROD:=ARQ_BALCAO->(RECNO()) ARQ_BALCAO->(dbcommit()) // Tá certo. Usar antes do DBUNLOCK() para garantir a integridade dos dados. ARQ_BALCAO->(dbunlock()) CATCH oErr SysRefresh() MsgStop("Ocorreu este erro ao tentar salvar os dados:"+CRLF+; "Erro: " + Transform(oErr:GenCode, nil) + ";" +CRLF+ ; "SubC: " + Transform(oErr:SubCode, nil) + ";" +CRLF+ ; "OSCode: " + Transform(oErr:OsCode, nil) + ";" +CRLF+ ; "SubSystem: " + Transform(oErr:SubSystem, nil) + ";" +CRLF+ ; "Mensagem: " + oErr:Description, "Atenção! - "+ProcName()+"("+AllTrim(Str(ProcLine()))+")") END TRY Em adição: • Não use SysRefresh() em conjunto com comandos de manipulação de dados (já tive problema com isso também). Prefira usar SysRefresh() antes de mostrar mensagens ou de atualizar METERs; • Mude para DBFCDX. Corrompe menos e, pelo menos no meu caso, resolveu 99% dos problemas; • Faça revisão na rede. Pode ter cabo com conector mal crimpado ou Switch com defeito. Se estiver usando Wi-Fi então ferrou tudo. Esse tipo de rede é campeã em corrompimento de índices devido às constantes perdas de conexão. Se este for o caso, outro conselho: mude imediatamente para rede cabeada. • Na medida do possível, mude para um banco de dados relacional. O Firebird e o MySQL são ótimas alternativas e muita gente aqui já manja bem deles e pode ajudar. Tem a SQLRDD e a SQLLIB que te permitirão entrar nesse mundo - SGBD.

Acabei de testar. Como funcionou, compara a rotina que uso com a tua para ver se tem alguma diferença. a *************************************************************** * Enviando emails * * * * Desenvolvedor: Ricardo de Moura Marques * * email: ricardomouramarques@hotmail.com * * * * Agradecimentos ao Alessandro Seribeli Barreto - "Ale SB" * * pelo código inicial, sem o qual, esse projeto * * não seria possível * * * *************************************************************** #include "fivewin.ch" #include "vlib.ch" *Static cAttach := "" Static aAttach ******************************************************************************** Function MailMain(_Dest, _Subj, _Msge, _File) local cUser := Space(50), cRemt := Space(50), ; cDest := Space(250), cTime, cTxt := Space(10), cAssunto := Space(100),; cCC := Space(250), cCCO := Space(250), n_Area := SELECT() local oDlg, oGet[8], oSay[12], oBtn[2], nItem := 0 local cDados, i Private oCab, oGru, oCon, oCod, oMenu, lSair := .f., oM2, lCheck := .t. aAttach := {} DEFAULT _Dest := "", _Subj := "", _Msge := "", _File:="" cDest := LEFT(_Dest+SPACE(250), 250) cAssunto := LEFT(_Subj+SPACE(100), 100) cTxt := _Msge IF VALTYPE(_File) = "C" IF FILE(_File) AADD(aAttach, _File) ENDIF ELSEIF VALTYPE(_File) = "A" aAttach := _File ENDIF cUser := GetPvProfString( "EMAILCFG", "Usuario", " ", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(50) cDomi := GetPvProfString( "EMAILCFG", "Dominio", "", ALLTRIM(cPasta)+"\CONFIG.INI") ArqsDBF() DEFINE FONT oFONT1 NAME "Ms Sans Serif" SIZE 0, -12 DEFINE DIALOG oDlg TITLE "Envio de eMail" From 0, 0 to 530, 600 Pixel @ 002,006 SAY oSay[1] PROMPT "Eviar usando este remetente" OF oDlg SIZE 150, 08 COLOR CLR_BLUE PIXEL @ 010, 006 SAY oGet[1] PROMPT alltrim(cUser) + alltrim(cDomi) SIZE 190, 10 PIXEL OF oDlg BORDER COLORS CLR_BLACK, CLR_HGRAY UPDATE @ 008, 200 BtnBmp oCfg File ".\bitmaps\engrena.bmp" Prompt "" size 20,12 OF oDlg Pixel Action SMTPConfig(@cUser, @cDomi, oDlg) NOBORDER @ 022, 040 GET oGet[4] VAR cDest SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update @ 022, 006 SBUTTON oBt1 File ".\bitmaps\mail.bmp" Prompt "Para" size 32,10 Pixel RIGHT Action Inclui( oGet[4], @cDest ) NOBORDER @ 032, 006 SBUTTON oBt2 File ".\bitmaps\mail.bmp" Prompt "CC" size 32,10 Pixel RIGHT Action Inclui( oGet[5], @cCC ) NOBORDER @ 032, 040 GET oGet[5] VAR cCC SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update @ 042, 006 SBUTTON oBt3 File ".\bitmaps\mail.bmp" Prompt "CCO" size 32,10 Pixel RIGHT Action Inclui( oGet[6], @cCCO ) NOBORDER @ 042, 040 GET oGet[6] VAR cCCO SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update @ 056, 006 SAY oSay[9] VAR "Assunto" OF oDlg SIZE 32, 08 COLOR CLR_BLUE PIXEL update @ 056, 040 GET oGet[7] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update @ 068,006 SAY oSay[7] VAR "Mensagem" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update @ 078,006 GET oGet[8] VAR cTxt OF oDlg SIZE 288,125 COLOR CLR_BLUE, CLR_WHITE PIXEL update MEMO @ 210,006 SAY oSay[8] VAR "Anexos" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update @ 218,006 ListBox oList Var nItem ITEMS aAttach Size 268,28 Pixel *****--- BOTÕES ---************************************************************* @ 242, 006 BUTTONBMP oBtn[1] PROMPT "Enviar" OF oDlg ; SIZE 30,10 PIXEL ; ACTION (cTime := "Aguarde...", oSay[6]:Refresh(), ; if(lRet := Config_Mail(Lower(Alltrim(cDest)),Lower(Alltrim(cCC)),Lower(Alltrim(cCCO)), cTxt, cAssunto ), ; (MsgInfo("Mensagem enviada com êxito!","Atençao"), oDlg:End()), nil),; cTime := "", oSay[6]:Refresh() ) @ 242, 050 BUTTONBMP oBtn[2] PROMPT "Sair" OF oDlg ; SIZE 30,10 PIXEL ; ACTION ( lSair := .t., oDlg:End() ) oBtn[2]:lCancel := .t. @ 218, 274 Button "ADD" Size 20,08 Pixel Action ADDItem() @ 228, 274 Button "DEL" Size 20,08 Pixel Action DELItem() @ 270,006 SAY oSay[6] VAR cTime OF oDlg SIZE 50, 08 COLOR CLR_RED PIXEL update ACTIVATE DIALOG oDlg CENTERED On Init Inicio( oDlg ) Codigos->(DBCLOSEAREA()) CabGrupo->(DBCLOSEAREA()) Grupos->(DBCLOSEAREA()) Contatos->(DBCLOSEAREA()) SELECT(n_Area) Return Nil //------------------------------------------------------------------------------ Function Inicio( oDlg ) Menu oMenu MenuItem "&Sistema" MENU MenuItem "&Gerenciar Contatos" Action Contatos() MenuItem oM2 Prompt "&Salvar contatos automaticamente" CHECK; Action if( oM2:lChecked, oM2:SetCheck(.f.), oM2:SetCheck(.t.) ) Separator MenuItem "Sai&r" Action ( oDlg:End() ) ENDMENU ENDMENU oM2:SetCheck( lCheck ) oDlg:SetMenu(oMenu) Return Nil ******************************************************************************** Function Config_Mail(cDest, cCC, cCCO, cTxt, cSubject) local lRet := .f. local oCfg, oError local cServ := alltrim(GetPvProfString( "EMAILCFG", "Servidor", " ", ALLTRIM(cPasta)+"\CONFIG.INI")) //--> SERVIDOR SMTP - "smtp.servidor.com.br" local cPass := ALLTRIM(GetPvProfString( "EMAILCFG", "UsrPswrd", " ", ALLTRIM(cPasta)+"\CONFIG.INI")) local nPort := val(alltrim(GetPvProfString( "EMAILCFG", "SmtpPort", "", ALLTRIM(cPasta)+"\CONFIG.INI"))) local lAut := IIF(GetPvProfString( "EMAILCFG", "SmtpAuth", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S", .T., .F.) local lSSL := IIF(GetPvProfString( "EMAILCFG", "SmtpSSL", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S", .T., .F.) local cReply:= GetPvProfString( "EMAILCFG", "EmailResposta", " ", ALLTRIM(cPasta)+"\CONFIG.INI") _cUser := ALLTRIM(GetPvProfString( "EMAILCFG", "Usuario", "", ALLTRIM(cPasta)+"\CONFIG.INI")) _cDomi := ALLTRIM(GetPvProfString( "EMAILCFG", "Dominio", "", ALLTRIM(cPasta)+"\CONFIG.INI")) _cRemt := ALLTRIM(_cUser) + ALLTRIM(_cDomi) if Empty(cPass) .or. Empty(_cRemt) .or.; ( Empty(cDest) .and. Empty( cCC ) .and. Empty(cCCO) ) ? "Preencha todos Campos" return .f. endif cUser := _cRemt cRemt := _cRemt nTot := 1 nReg := 0 n_Pos3 := 0 cSay := "Enviando a mensagem. Aguarde..." DEFINE DIALOG oDmtr1 FROM 0,0 TO 4, 35 TITLE "Enviando..." oDmtr1:lHelpIcon := .F. @05,05 SAY oSay PROMPT cSay PIXEL SIZE 130, 10 OF oDmtr1 UPDATE @15,05 METER oMeter VAR n_Pos3 TOTAL nTot SIZE 130, 12 OF oDmtr1 UPDATE PIXEL ACTIVATE DIALOG oDmtr1 CENTER NOWAIT VALID (!GetKeyState( VK_ESCAPE ) .AND. !GetKeyState( VK_MENU )) TRY oCfg := CREATEOBJECT( "CDO.Configuration" ) WITH OBJECT oCfg:Fields :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServ :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := nPort :Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ):Value := 30 :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := 1 // 0=anonima, 1=basica, 2=ntlm :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lSSL :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := cUser :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := cPass :Update() END WITH lRet := .t. CATCH oError MsgInfo( "Não Foi possível Enviar o e-Mail!" +CRLF+ ; "Erro: " + Transform(oError:GenCode, nil) + ";" +CRLF+ ; "SubC: " + Transform(oError:SubCode, nil) + ";" +CRLF+ ; "OSCode: " + Transform(oError:OsCode, nil) + ";" +CRLF+ ; "SubSystem: " + Transform(oError:SubSystem, nil) + ";" +CRLF+ ; "Mensagem: " + oError:Description, "Atenção" ) END //--> FIM DAS CONFIGURAÇOES. if lRet lRet := Envia_Mail(oCfg, cRemt, cReply, cDest, cCC, cCCO, cTxt, cSubject) endif nReg ++ oMeter:Set(nTot) Inkey(0.5) oDmtr1:End() SysRefresh() Return lRet ******************************************************************************** Function Envia_Mail(oCfg, cFrom, cReply, cTo, cCC, cBCC, cMsg, cSubject) local cToken local lRet := .f. cTo := Destinatarios( cTo ) //--> PARA cCC := Destinatarios( cCC ) //--> COM COPIA cBCC := Destinatarios( cBCC ) //--> COM COPIA OCULTA TRY oMsg := CREATEOBJECT ( "CDO.Message" ) WITH OBJECT oMsg :Configuration := oCfg :From := cFrom :ReplyTo := cReply :To := cTo :CC := cCC :BCC := cBCC :Subject := cSubject :TextBody := cMsg For x := 1 To Len( aAttach ) if aAttach[x] <> NIL :AddAttachment(AllTrim(aAttach[x])) endif Next :Send() END WITH lRet := .t. CATCH oErr MsgInfo("Não foi possível enviar a mensagem. Favor verificar:"+CRLF+CRLF+; "• As configurações estão corretas?"+CRLF+; "• Sua senha está correta?"+CRLF+; "• O e-mail do destinatário está correto?"+CRLF+; "• A Internet está funcionando corretamente?"+CRLF+CRLF+; "Para maiores esclarecimentos contate o suporte @rSoft", oErr:Description) lRet := .f. END Return lRet //---------------------------------------------------------------- Function ADDItem() Local cArq := cGetFile32("*.*", "ADD Anexo", , ,.f.) if file(cArq) oList:ADD(Alltrim(cArq)) oList:Hide() oList:Refresh() oList:Show() endif Return NIL //---------------------------------------------------------------- Function DELItem() Local nIT := oList:GetSel() oList:DEL( nIT ) oList:Hide() oList:Refresh() oList:Show() Return NIL //------------------------------------------------------------ Function Destinatarios( cVar ) local i, x,cGrupo, nCod local aCars := {",", "/", "\", ";"} local cLista := "" local lSalva := .t., lAll := .f. Private aTp := {} for i := 1 to len( aCars ) cVar := StrTran( cVar, aCars[i], CRLF ) next for i := 1 to MLCount(cVar, 250) AADD(aTp, Alltrim(MemoLine(cVar, 250, i))) next for i := 1 to len(aTp) cTemp := aTp[i] if left(cTemp, 2) = "<<" .and. right(cTemp, 2) = ">>" cGrupo := StrTran(cTemp, "<<", "") cGrupo := StrTran(cGrupo, ">>", "") cGrupo := cGrupo+Space(20-Len(cGrupo)) if !oCab:Seek(cGrupo) Msginfo('Grupo "'+Alltrim(cGrupo)+'" não encontrado') else oGru:Gotop() do While !oGru:Eof() oGru:Load() cLista += ";"+NomeCont(oGru:CodC) oGru:Skip() enddo endif else cLista += ";"+cTemp if lCheck if !oCon:Seek(cTemp+Space(100-Len(cTemp))) oCon:Blank() oCon:Contato := cTemp oCod:Load() nCod := oCod:CodC+1 oCod:CodC := nCod oCod:Save() oCon:CodC := nCod oCon:Append() oCon:Save() endif endif endif next Return cLista //---------------------------------------------------------- Function ArqsDBF() local aEstG, aEstR, aEstC, aEstCods aEstCods := { { "CODG", "N", 10, 0 },; { "CODC", "N", 10, 0 } } aEstG := { { "CODG", "N", 10, 0 },; { "GRUPO", "C", 20, 0 } } aEstR := { { "CODG", "N", 10, 0 },; { "CODC", "N", 10, 0 } } aEstC := { { "CODC", "N", 10, 0 },; { "CONTATO", "C", 100, 0 } } If !File( "Codigos.dbf") DBCreate( "Codigos.dbf", aEstCods ) endif If !File( "CabGrupo.dbf") DBCreate( "CabGrupo.dbf", aEstG ) endif If !File( "Grupos.dbf") DBCreate( "Grupos.dbf", aEstR ) endif If !File( "Contatos.dbf") DBCreate( "Contatos.dbf", aEstC ) endif Use Codigos New DATABASE oCod Use CabGrupo New Index on CabGrupo->Grupo to GCabGru DATABASE oCab Use Grupos New Set Filter to Grupos->CodG = CabGrupo->CodG DATABASE oGru Use Contatos New Index on Contatos->CodC to CodCont Index on Contatos->Contato to cCont Set index to cCont, CodCont DATABASE oCon if oCod:RecCount() = 0 oCod:Append() oCod:Save() endif oCab:bBoF := NIL ; oCab:bEoF := NIL oGru:bBoF := NIL ; oGru:bEoF := NIL oCon:bBoF := NIL ; oCon:bEoF := NIL oCod:bBoF := NIL ; oCod:bEoF := NIL Return NIL //----------------------------------------------------------------------- Function Contatos() Private oBrw1, oBut1, oBut2, oBut3, oBrw2,; oBut4, oBut5, oBrw3, oBut6, oBut7,; oBut8, lInicio := .f. Select Contatos Set index to cCont, CodCont Define DIALOG oDlgCont TITLE "Gerenciar Contatos" ; FROM 0, 0 to 484, 791 PIXEL COLOR 0, 15790320 ACTIVATE DIALOG oDlgCont ON INIT Ini_oDlgCont() CENTER Return NIL //---------------------------------------------------------------------------- Function Ini_oDlgCont() @ 11, 14 LISTBOX oBrw1; FIELDS CONTATOS->CONTATO; HEADERS "CONTATOS"; SIZE 406, 409 PIXEL OF oDlgCont FONT oFont1 ALIAS "CONTATOS" oBrw1:nClrText := {|| iif( OrdKeyNo()%2=0, 0, 0 ) } oBrw1:nClrPane := {|| iif( OrdKeyNo()%2=0, 15790320, 16777215 ) } oBrw1:nClrForeHead := 16777215 oBrw1:nClrBackHead := 8421504 oBrw1:nClrForeFocus := 16777215 oBrw1:nClrBackFocus := 8388608 @ 444, 14 BUTTON oBut1 Prompt "&Novo" SIZE 70, 24 PIXEL; OF oDlgCont ACTION CadContato(.t.) FONT oFont1 @ 444, 93 BUTTON oBut2 Prompt "&Alterar" SIZE 70, 24 PIXEL; OF oDlgCont ACTION CadContato(.f.) FONT oFont1 @ 444, 172 BUTTON oBut3 Prompt "&Excluir" SIZE 70, 24 PIXEL; OF oDlgCont ACTION DeleteCon() FONT oFont1 @ 11, 444 LISTBOX oBrw2; FIELDS CABGRUPO->GRUPO; HEADERS "GRUPOS"; SIZE 300, 171 PIXEL OF oDlgCont FONT oFont1 ALIAS "CABGRUPO"; ON Change if( lInicio, (oBrw3:Hide(), oBrw3:GoTop(), oBrw3:Refresh(), oBrw3:Show()), NIL) oBrw2:nClrText := {|| iif( OrdKeyNo()%2=0, 0, 0 ) } oBrw2:nClrPane := {|| iif( OrdKeyNo()%2=0, 15790320, 16777215 ) } oBrw2:nClrForeHead := 16777215 oBrw2:nClrBackHead := 8421504 oBrw2:nClrForeFocus := 16777215 oBrw2:nClrBackFocus := 8388608 @ 26, 750 BUTTON oBut4 Prompt "New" SIZE 30, 26 PIXEL; OF oDlgCont ACTION CadastraGru( .t. ) FONT oFont1 @ 52, 750 BUTTON oBut5 Prompt "Alt" SIZE 30, 26 PIXEL; OF oDlgCont ACTION CadastraGru( .f. ) FONT oFont1 @ 78, 750 BUTTON oBut5a Prompt "Del" SIZE 30, 26 PIXEL; OF oDlgCont ACTION DeletaGru() FONT oFont1 @ 186, 444 LISTBOX oBrw3; FIELDS NomeCont(GRUPOS->CODC); HEADERS "INTEGRANTES DO GRUPO"; SIZE 300, 234 PIXEL OF oDlgCont FONT oFont1 ALIAS "GRUPOS" oBrw3:nClrText := {|| iif( OrdKeyNo()%2=0, 0, 0 ) } oBrw3:nClrPane := {|| iif( OrdKeyNo()%2=0, 15790320, 16777215 ) } oBrw3:nClrForeHead := 16777215 oBrw3:nClrBackHead := 8421504 oBrw3:nClrForeFocus := 16777215 oBrw3:nClrBackFocus := 8388608 @ 268, 422 BUTTON oBut6 Prompt ">" SIZE 21, 21 PIXEL; OF oDlgCont ACTION ADDCont() FONT oFont1 @ 290, 422 BUTTON oBut7 Prompt "<" SIZE 21, 21 PIXEL; OF oDlgCont ACTION RemoveCont() FONT oFont1 @ 444, 675 BUTTON oBut8 Prompt "Sai&r" SIZE 70, 24 PIXEL; OF oDlgCont ACTION oDlgCont:End() FONT oFont1 lInicio := .t. oBrw3:Hide(); oBrw3:GoTop(); oBrw3:Refresh(); oBrw3:Show() Return NIL //---------------------------------------------------------------- Function CadContato( lNovo ) if lNovo oCon:Blank() else oCon:Load() endif Define dialog oDlgCadCon Title if(lNovo, "Novo Contato", 'Alterando "'+oCon:Contato+'"'); From 0,0 to 200,300 Pixel @ 20,20 Say "Contato" Size 40,10 Pixel @ 32,20 Get oGetCon Var oCon:Contato Size 110,10 Pixel @ 70, 25 Button "&Salvar" Size 40,10 Pixel Action SalvaCon( lNovo ) @ 70, 85 Button "&Desistir" Size 40,10 Pixel Action oDlgCadCon:End() Activate dialog oDlgCadCon Center Return NIL //---------------------------------------------------------------- Function SalvaCon( lNovo ) Local nCod if lNovo oCod:Load() nCod := oCod:CodC+1 oCod:CodC := nCod oCod:Save() oCon:CodC := nCod oCon:Append() endif oCon:Contato := Lower( oCon:Contato) oCon:Save() oBrw1:Hide() oBrw1:Refresh() oBrw1:Show() oDlgCadCon:End() Return NIL //---------------------------------------------------------------- Function DeleteCon() oCon:Load() if MsgNoYes( 'Excluir o contato "'+Alltrim(oCon:Contato)+'"?', "Atenção") oCon:Delete() oBrw1:Hide() oBrw1:Refresh() oBrw1:Show() endif Return NIL //------------------------------------------------------------ Function CadastraGru( lNovo ) if lNovo oCab:Blank() else oCab:Load() endif Define dialog oDlgCadGru Title if(lNovo, "Novo Grupo", 'Alterando "'+oCab:Grupo+'"'); From 0,0 to 200,300 Pixel @ 20,20 Say "GRUPO" Size 40,10 Pixel @ 32,20 Get oGetGru Var oCab:Grupo Size 110,10 Pixel @ 70, 25 Button "&Salvar" Size 40,10 Pixel Action SalvaGru( lNovo ) @ 70, 85 Button "&Desistir" Size 40,10 Pixel Action oDlgCadGru:End() Activate dialog oDlgCadGru Center Return NIL //------------------------------------------------------- Function SalvaGru( lNovo ) Local nCod if lNovo oCod:Load() nCod := oCod:CodG+1 oCod:CodG := nCod oCod:Save() oCab:CodG := nCod oCab:Append() endif oCab:Grupo := Lower(oCab:Grupo) oCab:Save() oBrw2:Hide() oBrw2:Refresh() oBrw2:Show() oDlgCadGru:End() Return NIL //---------------------------------------------------------------- Function DeletaGru() oCab:Load() if MsgNoYes( 'Excluir o grupo "'+Alltrim(oCab:Grupo)+'"?', "Atenção") oCab:Delete() oBrw2:Hide() oBrw2:Refresh() oBrw2:Show() endif Return NIL //------------------------------------------------------------ Function ADDCont() oCab:Load() if oCab:CodG = 0 MsgInfo("Selecione um GRUPO") Return NIL endif oCon:Load() if oCon:CodC = 0 MsgInfo("Selecione um contato") Return NIL endif oGru:Blank() oGru:CodC := oCon:CodC oGru:CodG := oCab:CodG oGru:Append() oGru:Save() oBrw3:Hide() oBrw3:Refresh() oBrw3:Show() Return NIL //------------------------------------------------------------- Function RemoveCont() oGru:Load() if MsgNoYes( 'Remover o contato selecionado?') oGru:Delete() oBrw3:Hide() oBrw3:Gotop() oBrw3:Refresh() oBrw3:Show() endif Return Nil //----------------------------------------------------------------- Function NomeCont(nCod) Local nRec := oCon:RecNo() Local cNome := "" Select Contatos Set index to CodCont, cCont if oCon:Seek( nCod ) cNome := oCon:Contato endif Select Contatos Set index to cCont, CodCont oCon:GoTo(nRec) Return cNome //--------------------------------------------------------------- Function Inclui( oGet, cVar ) nRad := 1 Define Dialog oDlgInc Title "Incluir contato" From 0,0 to 200, 300 Pixel @ 20,20 Radio oRad Var nRad Prompt "Inluir Contato", "Incluir Grupo" Size 80,10 Pixel @ 70, 25 Button "&Ok" Size 40,10 Pixel Action IncluiCont( nRad, oGet, @cVar ) @ 70, 85 Button "&Desistir" Size 40,10 Pixel Action oDlgInc:End() Activate Dialog oDlgInc CENTER //----------------------------------------------------------- Function IncluiCont( nRad, oGet, cVar ) if nRad = 1 BuscaCont(oGet, @cVar) else BuscaGru(oGet, @cVar) endif //---------------------------------------------------------- Function BuscaCont( oGet, cVar ) aListCont := {} nListCont := 1 Define Dialog oDlgCon Title "Contatos" From 0,0 to 484, 792 Pixel @ 11, 14 LISTBOX oBrw; FIELDS CONTATOS->CONTATO; HEADERS "CONTATOS"; SIZE 203, 205 PIXEL OF oDlgCon FONT oFont1 ALIAS "CONTATOS" @ 10,219 Button ">" Size 10, 10 Pixel; Action (oCon:Load(), oListCont:ADD(oCon:Contato), oListCont:Refresh()) @ 21,219 Button "<" Size 10, 10 Pixel; Action (oListCont:Del(nListCont), oListCont:Refresh()) @ 11, 232 ListBox oListCont Var nListCont Items aListCont; size 150, 206 pixel of oDlgCon Font oFont1 @ 226, 148 Button "&OK" Size 40,10 Pixel Action ConfCont( oGet, @cVar ) @ 226, 208 Button "&Desistir" Size 40,10 Pixel Action oDlgCon:End() Activate dialog oDlgCon CENTER //----------------------------------------------------------- Function ConfCont( oGet, cVar ) local i oCon:Load() cVar := Alltrim(cVar) if len(cVar) > 0 cVar := Alltrim(cVar)+";" endif for i := 1 to len( oListCont:aItems ) cVar := cVar+if(i>1,";", "")+Alltrim(oCon:Contato) next cVar+=Space(100) oGet:SetText( cVar ) oDlgCon:End() oDlgInc:end() Return NIL //---------------------------------------------------------- Function BuscaGru( oGet, cVar ) Define Dialog oDlgGru Title "Grupos" From 0,0 to 484, 450 Pixel @ 11, 14 LISTBOX oBrw; FIELDS CABGRUPO->GRUPO; HEADERS "GRUPOS"; SIZE 203, 205 PIXEL OF oDlgGru FONT oFont1 ALIAS "CABGRUPO" @ 226, 071 Button "&OK" Size 40,10 Pixel Action ConfGru( oGet, @cVar ) @ 226, 131 Button "&Desistir" Size 40,10 Pixel Action oDlgGru:End() Activate dialog oDlgGru CENTER //----------------------------------------------------------- Function ConfGru( oGet, cVar ) oCab:Load() if len(Alltrim(cVar)) > 0 cVar := Alltrim(cVar)+";" endif cVar := Alltrim(cVar)+"<<"+Alltrim(oCab:Grupo)+">>"+Space(100) oGet:SetText( cVar ) oDlgGru:End() oDlgInc:end() Return NIL STATIC FUNCTION SMTPConfig(cUser, cDomi, oDlg) LOCAL cServ, cPort, cPswr, lAuth, l_Ssl, lApply /* Private aServs:= {{"@hotmail.com", "smtp.live.com", 587, .f. },; {"@yahoo.com.br", "smtp.mail.yahoo.com.br", 25, .f. },; {"@gmail.com", "smtp.gmail.com", 465, .t. },; {"@uol.com.br", "smtps.uol.com.br", 465, .t. },; {"@bol.com.br", "smtps.bol.com.br", 587, .f. },; {"@terra.com.br", "smtp.terra.com.br", 25, .f. },; {"@ig.com.br", "smtp.ig.com.br", 465, .t. },; {"@ibest.com.br", "smtp.ibest.com.br", 465, .t. },; {"@itelefonica.com.br", "smtp.itelefonica.com.br", 25, .f. },; {"@autoboxlubrificantes.com.br","smtp.autoboxlubrificantes.com.br", 587, .f. },; {"@pop.com.br", "smpt.pop.com.br", 25, .f. } } */ cUser := GetPvProfString( "EMAILCFG", "Usuario", " ", ALLTRIM(cPasta)+"\CONFIG.INI") cDomi := GetPvProfString( "EMAILCFG", "Dominio", "", ALLTRIM(cPasta)+"\CONFIG.INI") cMail := ALLTRIM(cUser)+ALLTRIM(cDomi)+SPACE(50) cServ := GetPvProfString( "EMAILCFG", "Servidor", "", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(50) cPort := GetPvProfString( "EMAILCFG", "SmtpPort", "", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(5) cPswr := ALLTRIM(GetPvProfString( "EMAILCFG", "UsrPswrd", " ", ALLTRIM(cPasta)+"\CONFIG.INI"))+SPACE(15) lAuth := IIF(GetPvProfString( "EMAILCFG", "SmtpAuth", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S",.T., .F.) l_Ssl := IIF(GetPvProfString( "EMAILCFG", "SmtpSSL", "N", ALLTRIM(cPasta)+"\CONFIG.INI")=="S",.T., .F.) cReply:= GetPvProfString( "EMAILCFG", "EmailResposta", " ", ALLTRIM(cPasta)+"\CONFIG.INI")+SPACE(50) lApply:= .F. DEFINE DIALOG oDSmtp RESOURCE "SMTP_CFG" REDEFINE GET oId38 VAR cMail ID 38 OF oDSmtp REDEFINE GET oId44 VAR cServ ID 44 OF oDSmtp REDEFINE GET oId39 VAR cPort ID 39 OF oDSmtp REDEFINE GET oId41 VAR cPswr ID 41 OF oDSmtp REDEFINE CHECKBOX oId37 VAR lAuth ID 37 OF oDSmtp REDEFINE CHECKBOX oId40 VAR l_Ssl ID 40 OF oDSmtp REDEFINE GET oId36 VAR cReply ID 36 OF oDSmtp REDEFINE BUTTON oId46 ID 46 OF oDSmtp ACTION (lApply := .t., oDSmtp:End()) REDEFINE BUTTON oId47 ID 47 OF oDSmtp ACTION (lApply := .f., oDSmtp:End()) ACTIVATE DIALOG oDSmtp CENTERED IF ! lApply ; RETURN NIL ; ENDIF cMail := ALLTRIM(cMail) IF ! ("@" $ cMail) SysRefresh() MsgAlert("E-mail incorreto. Deve conter pelo menos 6 caracteres incluindo @ e . (ponto)", "Aviso") RETURN NIL ENDIF IF ! ("." $ cMail) SysRefresh() MsgAlert("E-mail incorreto. Deve conter pelo menos 6 caracteres incluindo @ e . (ponto)", "Aviso") RETURN NIL ENDIF IF LEN(cMail) < 6 SysRefresh() MsgAlert("E-mail incorreto. Deve conter pelo menos 6 caracteres incluindo @ e . (ponto)", "Aviso") RETURN NIL ENDIF IF EMPTY(cServ) SysRefresh() MsgAlert("Servidor SMTP não informado", "Aviso") RETURN NIL ENDIF IF EMPTY(cPort) SysRefresh() MsgAlert("Porta nao informada", "Aviso") RETURN NIL ENDIF IF EMPTY(cPswr) SysRefresh() MsgAlert("Senha nao informada", "Aviso") RETURN NIL ENDIF cUser := SUBSTR(cMail, 1, AT("@", cMail)-1) cDomi := SUBSTR(cMail, AT("@", cMail), LEN(cMail)) WritePProString("EMAILCFG", "Usuario", ALLTRIM(cUser), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "Dominio", ALLTRIM(cDomi), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "Servidor", ALLTRIM(cServ), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "SmtpPort", ALLTRIM(cPort), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "UsrPswrd", ALLTRIM(cPswr), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "SmtpAuth", IIF(lAuth, "S", "N"), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "SmtpSSL", IIF(l_Ssl, "S", "N"), ALLTRIM(cPasta)+"\CONFIG.INI") WritePProString("EMAILCFG", "EmailResposta", ALLTRIM(cReply), ALLTRIM(cPasta)+"\CONFIG.INI") oDlg:Update() RETURN NIL RC da configuração: #define SMTP_CFG SMTP_CFG SMTP_CFG DIALOG 66, 25, 250, 184 STYLE DS_MODALFRAME | 0x4L | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU CAPTION "Configuração da conta SMTP" FONT 11, "Verdana" { GROUPBOX "", 34, 3, 2, 244, 102, BS_GROUPBOX RTEXT "E-mail:", -1, 6, 17, 54, 8 EDITTEXT 38, 63, 15, 178, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP RTEXT "Servidor SMTP:", -1, 5, 34, 55, 8 EDITTEXT 44, 63, 32, 178, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP RTEXT "Porta:", -1, 4, 50, 55, 8 EDITTEXT 39, 63, 47, 30, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP RTEXT "Senha:", -1, 96, 50, 72, 8 EDITTEXT 41, 171, 47, 70, 12, ES_AUTOHSCROLL | ES_PASSWORD | WS_BORDER | WS_TABSTOP CHECKBOX " Servidor requer autenticação", 37, 63, 63, 182, 12, BS_AUTOCHECKBOX | WS_TABSTOP CHECKBOX " SSL/TLS (Segurança da conexão)", 40, 63, 75, 182, 12, BS_AUTOCHECKBOX | WS_TABSTOP LTEXT "Obs: Ainda não há suporte para STARTTLS", -1, 73, 89, 155, 8 GROUPBOX "", IDC_GROUPBOX6, 3, 108, 244, 53, BS_GROUPBOX CTEXT "Digite o e-amil para onde serão encaminhadas às respostas às mensagens que você enviar, caso deseje que tais respostas sejam enviadas para um e-mail diferente do informado acima.", -1, 20, 116, 210, 24 EDITTEXT 36, 35, 144, 180, 12, ES_AUTOHSCROLL | WS_BORDER | WS_TABSTOP PUSHBUTTON "Aplicar", 46, 84, 166, 40, 14 PUSHBUTTON "Ca&ncelar", 47, 126, 166, 40, 14 }

Recentemente tive problemas com Gmail ao enviar emails embora antes eu conseguisse enviar. Como parou de enviar sem eu sequer ter mexido nas configurações que antes funcionavam normalmente, resolver dar uma olhada na conta do GMail pelo site. Ao entrar na conta recebi logo a notificação de que tinha havido tentativa de uso da conta por um aplicativo desconhecido e que, por isso, o acesso foi bloqueado. Tinha os botões para eu confirmar se tinha sido realmente eu e se era para desbloquear. Confirmei e passou a funcionar novamente. Recomendo que você faça o mesmo: entre em sua conta do GMail pelo site e veja se não há algumas notificações que requerem sua confirmação.

Iniciativa interessante. No que eu puder, também ajudo.

Por experiência próprio recomendo: • Usar um computador como servidor de banco dados; • Instalar uma cópia do sistema completa em cada estação; • Compartilhar a pasta de dados no servidor para acesso completo (leitura e gravação); • Configurar o sistema em cada estação para acessar os dados nessa pasta com SET DEFAULT TO &(cPasta), onde cPasta é o endereço da pasta de dados compartilhada: Ex: cPasta := .\DADOS; cPasta := \\SERVIDOR\MEUPROG\DADOS

Uso este e parece bem prático: http://www.helpmaker.com.br/