Saludos.
Hace muchos años me ha funcionado sin problemas algo que hice tan simple, y los usuarios (arriba de 50) encantados, no solo para cuestión de trabajo, sino algo más....
Code: Select all | Expand
//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')
PARA QUE UN CORREO SEA LEIDO INMEDIATAMENTE POR EL RECEPTOR (SIN EL TIEMPO MARCADO POR EL TIMER), BASTA CON PONER TRES PUNTOS SEGUIDOS (...) EN EL TEXTO DEL MENSAJE A ENVIAR EN CUALQUIER PARTE. SE CONSIDERA COMO URGENTE.
SI EL USUARIO NO HA ENTRADO AL SISTEMA, ESTOS SERAN LEIDOS AL ENTRAR UNO POR UNO.
No hay problema, los archivo creados no se pueden leer, si no es por el mismo programa
NOE 102101102101102101108109102101108109097102101108109102101012009101102101102109101108109102101108043102
