y como dice Antonio, de esta forma el codigo siempre estara
disponible.
saludos..
Code: Select all | Expand
***************************************************************
* 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 'inkey.ch'
#include "fileio.ch"
#include "common.ch"
#define linebuff 1024
static lEof:=.F.
Static cAttach := ""
Static aAttach := {}
function Main()
ctext := ''
ctext := '<html xmlns="http://www.w3.org/1999/xhtml">'+CRLF
ctext += '<head>'+CRLF
ctext += '<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />'+CRLF
ctext += '<title>Untitled Document</title>'+CRLF
ctext += '<style type="text/css">'+CRLF
ctext += '<!--'+CRLF
ctext += '.style1 {'+CRLF
ctext += ' font-family: Arial, Helvetica, sans-serif;'+CRLF
ctext += ' font-size: 13px;'+CRLF
ctext += '}'+CRLF
ctext += '.style2 {font-family: Arial, Helvetica, sans-serif; font-size: 13px; font-weight: bold; }'+CRLF
ctext += '.style3 {color: #FFFFFF}'+CRLF
ctext += '.style4 {font-family: Arial, Helvetica, sans-serif; font-size: 13px; color: #FFFFFF; }'+CRLF
ctext += '-->'+CRLF
ctext += '</style>'+CRLF
ctext += '</head>'+CRLF
ctext += '<body>'+CRLF
ctext += '<table width="550">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td><div align="left" class="style1">'+CRLF
ctext += ' <div align="left"><strong>Data de emissão: 23-08-2012 Horário: 12:25:36 </strong></div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '<table width="550">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td><div align="left" class="style1">'+CRLF
ctext += ' <div align="center"><strong>Tabela de preços </strong></div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '<table width="550" border="1" cellpadding="0">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td width="18%"><div align="left" class="style1">'+CRLF
ctext += ' <div align="left">Código</div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' <td width="58%"><div align="left" class="style1">Descrição do Produto </div></td>'+CRLF
ctext += ' <td width="24%"><div align="left" class="style1">Preço</div></td>'+CRLF
ctext += ' </tr>'+CRLF
// aqui entra os dados dos produtos...................................
ctext += '</table>'+CRLF
ctext += '<table width="550" border="1" bgcolor="#6C88A1">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td width="18%"><div align="left" class="style1">'+CRLF
ctext += ' <div align="left" class="style3">12345</div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' <td width="58%"><div align="left" class="style4">Teste do produto </div></td>'+CRLF
ctext += ' <td width="24%"><div align="left" class="style4">125,35</div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '<table width="550" border="0">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td width="18%"><div align="left" class="style1">'+CRLF
ctext += ' <div align="left"></div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
// aqui entra os dados da empresa.....................................
ctext += '<table width="550">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td><div align="left" class="style2">'+CRLF
ctext += ' <div align="center">Nome da Empresa </div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '<table width="550">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td><div align="left" class="style1">'+CRLF
ctext += ' <div align="center"><strong>Endereço:</strong> xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx, 1254 </div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '<table width="550">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td><div align="left" class="style1">'+CRLF
ctext += ' <div align="center"><strong>Bairro:</strong> Santo Inacio<strong> Cidade:</strong> Uberlândia/Minas Gerais <strong>Cep:</strong> 38.450-153 </div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '<table width="550">'+CRLF
ctext += ' <tr>'+CRLF
ctext += ' <td><div align="left" class="style1">'+CRLF
ctext += ' <div align="center"><strong>Telefone:</strong> (34) 3234-4986 <strong>E-mail:</strong> systemup@bol.com.br </div>'+CRLF
ctext += ' </div></td>'+CRLF
ctext += ' </tr>'+CRLF
ctext += '</table>'+CRLF
ctext += '</body>'+CRLF
ctext += '</html>'+CRLF
envia_email("Teste","",ctext)
return nil
********************************************************************************
Function envia_email(oassunto,odestino,otexto)
local cUser := Space(50), cPass := Space(15), cRemt := Space(50), ;
cDest := Space(250), cTime, cAssunto := Space(100),;
cCC := Space(250), cCCO := Space(250)
local oDlg, oSay[12], oBtn[2], nItem := 0
local cDados, i
private oGet[8]
private cTxt := space(10)
if IsInternet() == .f.
msgstop("Necessário conexão com internet."+CRLF+"Operação cancelada","Informação")
return .f.
endif
// para fechar os arquivos dbf's em aberto............................
close all
if !empty(oassunto)
cAssunto = oassunto
endif
if !empty(odestino)
cDest = odestino
endif
if !empty(otexto)
cTxt = otexto
endif
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", "smtp.uol.com.br", 25, .f. },;
{"@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 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
cPass := Memoline( cDados, 250, 5)
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
//@ 064, 006 SAY oSay[5] PROMPT "Para:" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL //-> Substituidos
//@ 074, 006 SAY oSay[10] PROMPT "C/C:" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL //-> por
//@ 084, 006 SAY oSay[11] PROMPT "C/CO:" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL //-> botões
@ 094, 006 SAY oSay[9] VAR "Assunto" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL update
@ 124,006 SAY oSay[7] VAR "Mensagem ou HTML" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update
@ 121,142 BUTTONBMP oSay[5] prompt "Importar codigo HTML" size 60,10 OF oDlg pixel action( importa_html() )
@ 121,204 BUTTONBMP oSay[12] prompt "Exibir no Browser o HTML" size 90,10 OF oDlg pixel action ( exibe_no_browser_o_html() )
@ 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 when .f.
@ 218,006 ListBox oList Var nItem ITEMS aAttach Size 268,50 Pixel
*****--- BOTÕES ---*************************************************************
@ 290, 010 BUTTONBMP oBtn[1] PROMPT "Enviar" 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!","Atençao"),), 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., 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, cPass) ) On Init Inicio( oDlg )
Return Nil
***-----------------------( Importa o arquivo HTML ) ------------------------***
function importa_html()
gcFile := cGetFile( "HTML (*.html)| *.html|";
,"Por favor localize o arquivo no formato HTML.", 4 )
if !Empty( gcFile ) .and. File( gcFile )
aa = gcfile
bb = ""
cc = ""
for xt = 1 to len(gcFile)
if substr(gcfile,xt,1) = ""
bb = ""
elseif substr(gcfile,xt,1) = "."
cc = ""
else
bb = bb + substr(gcfile,xt,1)
cc = cc + substr(gcfile,xt,1)
endif
next
if upper(cc) != "HTML"
if upper(cc) != "HTM"
msgstop("Somente arquivos HTML podem ser importados.","ATENÇÃO")
return nil
endif
endif
mnomearquivohtml = bb
mLocaldoarquivohtml = gcfile
if msgyesno("Deseja importar o arquivo: " + mnomearquivohtml,"ATENÇÃO")
if file(mLocaldoarquivohtml)
csource = mLocaldoarquivohtml
nsource:=fopen("&csource",0)
cInfo = ""
if ( nsource ) # -1
lEof:=.F.
nn = 1
do while !lEof
c := p_readln(nSource,linebuff)
if !lEof .and. c#chr(26)
if nn = 1
cInfo := c
++nn
else
cInfo+=CRLF+c
endif
endif
if alltrim(upper(c)) = "</HTML>"
lEof = .t.
endif
enddo
oGet[8]:ctext := cInfo
endif
else
msgstop("Erro na leitura do HTML... Tente novamente..","Atencao")
endif
endif
endif
return nil
Function p_readln(nHandle,nBuffSize)
local cRet:="", cBuff:="", nPos:=0, nEol:=0, nRead:=0
nBuffSize = 1024
cBuff:=space(nBuffSize)
nPos:=fseek(nHandle,0,FS_RELATIVE)
if ( nRead:=fread(nHandle,@cBuff,nBuffSize) ) > 0
if ( nEol:=at(CRLF,substr(cBuff,1,nRead)) ) == 0
cRet:=chr(26)
else
cRet:=substr(cBuff,1,nEol-1)
fseek(nHandle,nPos+nEol+1,FS_SET)
endif
else
lEof:=.T.
endif
return(cRet)
***--------------------( Verifica a conexÆo com a internet )-----------------***
function IsInternet()
local cip, cvret := .F.
wsastartup()
cip := gethostbyname("www.microsoft.com")
wsacleanup()
if cip = "0.0.0.0"
return .f.
else
return .t.
endif
***-------------------------( Visualiza o HTML ) ----------------------------***
function exibe_no_browser_o_html()
private odlhtml, oactivex, cevents:="", oexplorer
if empty(cTxt)
msgstop("Importe o codigo HTML.","ATENÇÃO")
return nil
endif
MemoWrit("imagem_visualiza.html", cTxt )
define brush obrushhtml COLOR rgb(245,235,223)
define dialog odlhtml from 0,0 to 550,1020 pixel title " ..:: | Visualizando o HTML:" brush obrushhtml //transparent
odlhtml:lhelpicon:=.F.
oactivex:=tactivex():new( odlhtml, "Shell.Explorer",0,0,510,275 )
odlhtml:oclient:=oactivex
activate dialog odlhtml centered;
on init( oactivex:Do( "Navigate", CurDrive()+ ":" + CurDir() + "" + "imagem_visualiza.html" ) )
release brush obrushhtml
ferase(CurDrive() + ":" + CurDir() + "" + "imagem_visualiza.html")
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, cPass)
MemoWrit("dadosmail.dat", cUSER+CRLF+cREMT+CRLF+Str(nServ)+CRLF+if(oM2:lChecked, "1", "0")+CRLF+cPass )
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
:HTMLBody = 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")
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
