//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')