Ejemplo de Chatter.

[FranciscoA]

Cristóbal, gracias por contestar.
Efectivamente, así lo estoy haciendo actualmente. Estoy buscando la manera de hacerlo totalmente vía código FWH1204 talvez usando sockets.
He bajado de Sn Google varios scripts que estoy estudiando a ver si puedo lograrlo. Lo que me interesa crear una especie de mensajero, no el chat completo.
Ya hice un función para conocer quienes están usando el app, a quienes muestro en un xbrowse, y desde allí quiero enviar los mensajes.
Saludos.

[Antonio Linares]

https://bitbucket.org/fivetech/fivewin-contributions/downloads/chatter.zip

[noe aburto]

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 view

//Paso 1.

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

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

public _cUsuario  :=NIL        // usuario del sistema, NOMBRE QUE USARIO QUE ENTRO 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
//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
se guardan algo asi:

NOE.S01
NOE.S02
NOE.S03
NOE.S04

y el contenido de NOE.S01
NOE 102101102101102101108109102101108109097102101108109102101012009101102101102109101108109102101108043102

[noe aburto]

Los botones de aceptar y cancelar usan la clase tsbutton 7.0, cambiar segun su aplicacion
y omitir todos los RESOURCE