//Paso 1.

#DEFINE _ARCH_COR 'X:\AUTOSYS\CORREO' // DONDE SE GUARDAN LOS ARCHIVOS DE CORREO TEMPORALES

// --- Inicializa modo de operacion
init procedure PublicGetVent()

public _cUsuario  :=NIL        // usuario del sistema, NOMBRE QUE USUARIO QUE ENTRA AL SISTEMA (8 CARACTERES)

setkey(VK_F4, {||REnviCorreo()}) // TECLA DE FUNCION PARA ENVIO DE CORREO
setkey(VK_F5, {||RReceCorreo()}) // TECLA DE FUNCION PARA REVISAR CORREO

return


//Paso 2.

// --- Salir modo de operacion
exit procedure ExitGetVent()

BArchCorreo()
return


//Paso 3.

//En tu ventana principal define un timer, segun el tiempo que pasará para que el usuario vea su correo
//p.ej. 5 segundos

DEFINE TIMER oTimer INTERVAL 5000;
       ACTION RReceCorreo();
       OF oPrincipal
ACTIVATE TIMER oTimer


//Paso 4.

//Agregar a tus funciones principales las siguientes funciones, ABAJO INCLUIDAS, y listo, debe de funcionar el correo, que no es popup pero funciona
//REnviCorreo()
//RReceCorreo()
//TranTexto(xTexto,lEscritura,lEncabeza)
//EnviCorr(aCorr,cCorreo,cUsuCor)
//BArchCorreo()
//Ceros(cNum,n)


// --- Mandar correo a usuarios
function REnviCorreo()
local aCorr,cCorr,nCorr,bPant,cCorreo,cAbr,xNom,i,n
local bAliAnt:=AliasAnt(),cArchivo:=space(100),oBmp
local oGet,oCorreo,oFont,oFontb,nCentro,nTop,oBtn1,oBtn2,lEnvia:=.f.
static cUsuCor:=NIL

if _cUsuario==NIL
 return NIL
endif

aCorr:={'JUAN    ',; // FORMA TU ARREGRO DE USUARIOS A 8 CARACTERES, SIN ESPACIOS LOS NOMBRES
        'PEDRO   ',;
        'TERE    ',;
        'NOE     ',;
        'ADMIN   ',;
        'LEO_P   ',;
        'GAZCA   ',;
        'MIGUEL_L'}

/* AQUI FORMO DE MI ARCHIVO DE USUARIOS, EL ARREGLO
if !file(_ARCH_USU+DBFEXT)
 aviso('El archivo de usuarios no existe')
 return NIL
endif
AbreDBF('_USU_',_ARCH_USU,'usuario')
if !file(_ARCH_USU+INDEXT)
 INDEX ON _USU_->num_emp+_USU_->nom_usu;
       TAG 'usuario';
       TO (_ARCH_USU+INDEXT);
       FOR !DELETED()
endif
setkey(VK_F4,{||NIL})
// forma arreglo de usuarios
aCorr:={}
dbgotop()
while !eof()
 cCorr:=strtran(alltrim(_USU_->nom_usu),' ','_')
 if (n:=aScan(aCorr,{|x|x[1]==cCorr}))<1
  xNom:=alltrim(_USU_->des_usu)
  cAbr:=left(xNom,1)
  while at(' ',xNom)>0
   xNom:=substr(xNom,at(' ',xNom)+1)
   cAbr+=left(xNom,1)
  end
  aadd(aCorr,alltrim(cCorr))
 endif
 dbskip()
end
Cierra('_USU_')
*/

if len(aCorr)<1
 aviso('El archivo de usuarios está vacio')
endif
asort(aCorr,{|x,y|x<y})
if cUsuCor==NIL
 cUsuCor:=aCorr[1]
endif
// ingresa a usuarios TODOS
aadd(aCorr,'TODOS')
DEFINE DIALOG bPant FROM 08,08 TO 27,73;
       TITLE 'Envio de correo';
       COLOR COLOR_NEGRO;
       FONT oFont
bPant:lHelpIcon:=.F.
DEFINE FONT oFont NAME "ARIAL" SIZE 0,-13 BOLD
DEFINE FONT oFontb NAME "ARIAL" SIZE 0,-11      // botones
@ Row2Pxl(0.5),Col2Pxl(23) BITMAP oBmp RESOURCE "GOCORREO" SIZE 48,48 ADJUST PIXEL NOBORDER OF bPant
oBmp:lTransparent:=.t.
@ 1, 2 say 'Usuarios' of bPant
@ 1,10 COMBOBOX oCorreo VAR cUsuCor picture "@!S10" SIZE 80,200 STYLE CBS_DROPDOWN ITEMS aCorr ON CHANGE oCorreo:SetText(cUsuCor)
oCorreo:oGet:bKeyChar:={|nKey|oCorreo:GetKeyChar(nKey)}
cCorreo:=''
@ 2.5,1 say 'Texto del correo' color COLOR_AZUL of bPant
@ 3, 1 GET oGet VAR cCorreo;
       MULTILINE;
       SIZE 31,3.5;
       FONT oFont;
       OF bPant

nCentro:=(bPant:nRight-bPant:nLeft)/2
nTop:=bPant:nBottom-bPant:nTop-32
nCentro/=2 ; nTop/=2

@ nTop,nCentro-40  SBUTTON oBtn1 PROMPT ' &Aceptar' RESOURCE 'GOACEPT1','GOACEPT2' OF bPant SIZE 38, 14 ;
                   ACTION ( lEnvia := .T. ,;
                            bPant:End() );
                   XP NOBOXTR FONT oFontb PIXEL
@ nTop,nCentro+02  SBUTTON oBtn2 PROMPT ' &Cancelar' RESOURCE 'GOCANC1','GOCANC2' OF bPant SIZE 38, 14 ;
                   ACTION ( lEnvia := .F. ,;
                            bPant:End() );
                   XP NOBOXTR FONT oFontb PIXEL CANCEL
ACTIVATE DIALOG bPant CENTERED
if lEnvia
 EnviCorr(aCorr,cCorreo,cUsuCor)
endif
oFont:End()
oFontb:End()
oBmp:End()
eval(bAliAnt)
setkey(VK_F4,{||REnviCorreo()})
return NIL


// --- Revisa la recepcion archivo temporal usuarios correo
function RReceCorreo()
local bPant,oBmp,oGet,cCorr,cMensaje,cColor,aDir,aDirS,nCorr,oFont,i

if _cUsuario==NIL
 return .f.
endif
if !file(_ARCH_COR+UsuCorreo+'.S??').and.!file(_ARCH_COR+UsuCorreo+'.U??')
 return .f.
endif
DEFINE FONT oFont NAME "ARIAL" SIZE 0,-13 BOLD
setkey(VK_F4,{||NIL})
setkey(VK_F5,{||NIL})
// revisa archivo temporal para chequeo de correo
cCorr:=UsuCorreo+'.U??'
aDir:=directory(_ARCH_COR+cCorr)
cCorr:=UsuCorreo+'.S??'
aDirS:=directory(_ARCH_COR+cCorr)
for i:=1 to len(aDirS)
 aadd(aDir,aDirS[i])
next
for nCorr:=1 to len(aDir)
 cMensaje:=''
 if file(_ARCH_COR+aDir[nCorr,1])
  cMensaje:=memoread(_ARCH_COR+aDir[nCorr,1])
 endif
 ferase(_ARCH_COR+aDir[nCorr,1])
 if !empty(cMensaje)
  DEFINE DIALOG bPant FROM 08,08 TO 24,73;
         TITLE 'Recepción de correo';
         COLOR COLOR_NEGRO;
         FONT oFont
  bPant:lHelpIcon:=.F.
  @ 0.5,02 say 'REMITE: '+left(cMensaje,8) color COLOR_MAGENTA of bPant
  @ 1.0,02 say 'Fecha:' of bPant
  @ 1.0,09 say FormaFecha(aDir[1,3]) of bPant
  @ 1.5,02 say 'Hora:' of bPant
  @ 1.5,09 say aDir[1,4]+', Correo: '+ceros(nCorr,2)+'/'+ceros(len(aDir),2) of bPant
  @ Row2Pxl(0.5),Col2Pxl(23) BITMAP oBmp RESOURCE "GOCORREO" SIZE 48,48 ADJUST PIXEL NOBORDER OF bPant
  oBmp:lTransparent:=.t.
  cMensaje:=TranTexto(cMensaje,.f.,.t.)
  cMensaje:=substr(cMensaje,9)
  CursorHand()
  @ Row2Pxl(3),Col2Pxl(1)/2 GET oGet VAR cMensaje;
                            MULTILINE;
                            SIZE Col2Pxl(31),Row2pxl(3.5);
                            FONT oFont;
                            READONLY PIXEL;
                            OF bPant
  ACTIVATE DIALOG bPant CENTERED ON INIT oGet:bGotFocus:={||oGet:SetPos(0,0)}
  oBmp:End()
  CursorArrow()
 endif
next
oFont:End()
setkey(VK_F4, {||REnviCorreo()})
setkey(VK_F5, {||RReceCorreo()})
return NIL


// --- Envia el correo
static function EnviCorr(aCorr,cCorreo,cUsuCor)
local cCorr,nCorr,i,n,lUrgente,cTipo:='S',oFont,Correo

if empty(cCorreo)
 return NIL
endif
cCorr:=alltrim(cUsuCor)
lUrgente:=at('...',cCorreo)>0
if lUrgente
 cCorreo:=strtran(cCorreo,'...','')
 cTipo:='U'
endif
cCorreo:=padr(UsuCorreo,08)+TranTexto(cCorreo,.t.,.t.)
if cCorr=='TODOS'
 for i:=1 to len(aCorr)
  if aCorr[i]=='TODOS'
   loop
  endif
  nCorr:=1
  Correo:=_ARCH_COR+aCorr[i]+'.'+cTipo+ceros(nCorr,2)
  while file(Correo)
   nCorr++
   Correo:=_ARCH_COR+aCorr[i]+'.'+cTipo+ceros(nCorr,2)
  end
  n:=fcreate(Correo,0)
  fwrite(n,cCorreo)
  fclose(n)
 next
else
 nCorr:=1
 Correo:=_ARCH_COR+cCorr+'.'+cTipo+ceros(nCorr,2)
 while file(Correo)
  nCorr++
  Correo:=_ARCH_COR+cCorr+'.'+cTipo+ceros(nCorr,2)
 end
 n:=fcreate(Correo,0)
 fwrite(n,cCorreo)
 fclose(n)
endif
return .t.


// --- Transforma contenido de un texto para no ser leidos
static function TranTexto(xTexto,lEscritura,lEncabeza)
local cTexto:='',nStep,i

if lEscritura
 nStep:=1
else
 if lEncabeza
  cTexto+=left(xTexto,8) ; xTexto:=substr(xTexto,9)
 endif
 nStep:=3
endif
for i:=1 to len(xTexto) step nStep
 if lEscritura
  cTexto+=ceros(asc(substr(xTexto,i,1))-1,3)
 else
  cTexto+=chr(val(substr(xTexto,i,3))+1)
 endif
next
return cTexto


// --- Borra archivo temporal para usuarios de correo
function BArchCorreo()

if _cUsuario==NIL
 return NIL
endif
if file(_ARCH_COR+UsuCorreo)
 ferase(_ARCH_COR+UsuCorreo)
endif
return NIL


// --- Antepone n ceros a un numero y lo regresa como cadena
function Ceros(cNum,n)

if valtype(cNum)='N'
 cNum:=str(cNum,n)
endif
return padl(alltrim(cNum),n,'0')