Como muchas operaciones de mantenimiento de las tablas (empacar, reindexar, etc) requieren que se abran las tablas en modo exclusivo, resultaba muy incómodo tener que pasearse por las instalaciones cerrando el programa en cada ordenador, o ir llamando a los distintos departamentos de la empresa para que hicieran lo propio si es que lo tenían en ejecución. Así que pensé en un sistema sencillo de comunicación del programa que permitiera averiguar qué máquinas estaban ejecutando mi sistema y así avisar directamente a los usuarios activos en ese momento y no a todo el mundo. Cuando esa parte estuvo lista, pensé que el sistema podría estar ejecutándose en un equipo pero el usuario podría no estar presente, entonces, ¿a quién avisar?, ¿quién cerraría el sistema?, pues que sea el propio programa el que se cierre. Manos a la obra, diseñé un sencillo protocolo en el que además de "preguntar" al grupo de trabajo quién estaba ejecutando el programa, podía enviar el mensaje "CERRAR". Y un paso más, si podía enviar el mensaje CERRAR, podía enviar cualquier otro mensaje para que se mostrara en un pequeño formulario.
La idea no es del todo original, de hecho encontré varias referencias en la red sobre esto, pero este es el resultado de mis averiguaciones, pruebas y esfuerzo personal.
Para las comunicaciones hago uso del control MSWinsock (mswinsck.ocx) y uso el protocolo TCP, un formulario para el servidor que le permite buscar máquinas en el grupo de trabajo y enviar mensajes u órdenes de cierre y una clase basada en Form para los "clientes", que les mostrará los mensajes de texto que reciban del servidor. Cuando instalo mis sistemas, se decide qué máquinas van a ser "CLIENTE" y cuál va a ser "SERVIDOR". En una biblioteca de clases visuales (llamada victor.vcx) tengo creadas tres clases: msgserv, basada en Form; winso_, basa en Container con dos controles Winsock; y winse_ basada en Container con un control Winsock que usará el servidor. Cuando el programa arranca, comprueba si se es cliente, y si lo es, se crean los objetos oportunos, más o menos así:
PROCEDURE Main
**Lineas de código.....
* Cargo la biblioteca de clases que contiene, entre otras, las clases
* que uso en este ejemplo.
SET CLASSLIB TO victor_b.vcx ADDITIVE
* Primero compruebo si la máquina que está ejecutando el programa
* es CLIENTE(no Servidor), está en Red(LAN) y no es un punto de venta
* desconectado(Asíncrona)
IF m.CLIENTE AND !m.ASINCRONA AND m.REDLOCAL THEN
* Agrego una propiedad al objeto _SCREEN para que sea
* accesible desde cualquier parte del programa(nunca me
* han gustado las variables públicas). Además, al ser una clase
* basada en Form no se puede usar NewObject().
_Screen.AddProperty('VMSG') && Nombre de la propiedad
* El objeto se crea de una clase basada en Form para mostrar
* los mensajes enviados por el Servidor
_Screen.VMSG=CREATEOBJECT('MSGSERV')
* Agrego un objeto (esta vez directamente) al objeto _SCREEN,
* basado en la clase winso_. Esta contiene dos controles WinSock,
* uno para 'escuchar' y otro para responder.
_Screen.NewObject('ws1','winso_','victor.vcx')
* El primer control WinSock(llamado WNS1) empieza a 'escuchar'...
_Screen.WS1.WNS1.Object.LISTEN()
ENDIF
ENDPROC
Cuando el evento _Screen.WS1.WNS1.Object.LISTEN() intercepta una petición, se llama al método Accept del segundo control Winsock que es el que recibe los mensajes y envía las respuestas. Esto permite al primer objeto Winsock seguir "escuchando". Como solamente se espera la comunicación con el servidor, el segundo control es suficiente para enviarle las peticiones de conexión. Si se tuviera que comunicar con más de un ordenador, se deberían usar varios controles.
Las propiedades para WNS1 y para el segundo Winsock (WNS2) son:
Protocol : 0 = TCP
LocalPort: 62100 para uno y 62000 para el otro
Estos puertos no tiene nada especial, excepto que un listado de puertos TCP más comunes, ví que no solían usarse para nada especial, así que no interferiría en ningún otro proceso del sistema.
El primer Winsock (WNS1) tiene el siguiente código en el evento ConnectionRequest:
*** Evento ActiveX Control *** LPARAMETERS requestid IF THIS.Parent.WNs2.OBJECT.State<>0 THEN =THIS.Parent.WNS2.Object.Close() ENDIF THIS.Parent.WNS2.Object.Accept(requestid)Como solo tenemos un segundo control Winsock para establecer la comunicación, comprobaremos previamente si sigue "abierto" por una llamada anterior. Si así fuera (State<>0),lo cerramos previamente con Close. A continuación llamamos al método Accept con el parámetro (requestid) que hemos recibido. Recordemos que ConnectionRequest podrá recibir peticiones de conexión por que previamente hemos llamado al método LISTEN.
En el método Accept de WNS2 no hace falta escribir código pero sí en el evento DataArrival:
*** Evento ActiveX Control ***
LPARAMETERS bytestotal
LOCAL sDATOS
m.sDATOS=SPACE(bytestotal)
_VFP.AutoYield=.F.
THIS.GetData(@sDATOS)
_VFP.AutoYield=.T.
DO CASE
CASE m.sDATOS='INFO'
THIS.SendData('SI.')
CASE m.sDATOS='SALIR.'
THIS.SendData('CERRANDO.')
=INKEY(.3,'H')
KEYBOARD '{F12}'
OTHERWISE
_Screen.VMSG.MOSTRAR(m.sDATOS)
_Screen.VMSG.VISIBLE=.T.
ENDCASE
DOEVENTS
El evento DataArrival recibe un parámetro (bytestotal) con el número de bytes recibidos del servidor. Así pues creamos una variable (de tipo string) a la que le resevamos previamente tanto espacio como bytes esperados. Como VFP es extremadamente rápido, interrumpo temporalmente el proceso de eventos de Windows pendientes con AutoYield = F. Llamo al método GetData, pasando por referencia la variable creada (@sDATOS), que se encargará de llenar con los bytes recibidos y, activo otra vez el proceso de eventos de Windows (AutoYield =.T.).Si se recibe el mensaje "INFO", le envío al servidor un mensaje corto: "SI". Si recibe el texto "SALIR". le envío al servidor el mensaje "CERRANDO", provoco una minúscula pausa (INKEY( .3,'H')) para que le de tiempo a enviar el mensaje y, a continuación llamo el procedimiento SALIR_Y_CERRAR que se encargará de cerrar las tablas, la base de datos, los formularios abiertos y abandonar la ejecución del programa. Si no se recibe ninguno de los dos mensajes anteriores, llamo al método MOSTRAR del objeto VMSG, creado a partir de la clase MSGSERV basada en Form, para mostrar el texto recibido.
La clase MSGSERV es un Form con un cuadro de edición y dos botones, uno para limpiar la caja de edición y otro para cerrar (ocultar) el formulario.
Le he añadido un método: MOSTRAR que recibe como parámetro el texto que hay que mostrar:
LPARAMETERS sTEXTO
IF TYPE('sTEXTO')<>'C' AND TYPE('sTEXTO')<>'M' THEN
m.sTEXTO=""
ENDIF
THIS.EDit1.Value=THIS.EDit1.Value+'Recibido el '+DTOC(DATE())+ ;
' a las '+TIME()+CHR(13)
THIS.EDit1.Value=THIS.EDit1.Value+m.sTEXTO+CHR(13)
THIS.EDit1.SelStart=LEN(THIS.EDit1.Value)
THIS.EDit1.SelLength=1
Si lo que se recibe es de tipo Character o Memo, voy llenando el cuadro de edición (Edit1) y lo adorno con la fecha y hora de la recepción. El evento Click del botón Limpiar contiene: THIS.EDit1.Value="" y el del botón Cerrar contiene:THIS.Parent.Hide para ocultar el formulario. Al formulario le he establecido la propiedad AlwaysOnTop = .T. y la propiedad AutoCenter = .T.Nos queda la parte del "Servidor". Como hemos dicho antes, el servidor no necesita estar "escuchando" todo el tiempo para este desarrollo. Uso un formulario convencional al que le he añadido un objeto de la clase WINSE_ para enviar los mensajes. Tenemos un cuadro de texto para escribir el nombre del Grupo de trabajo a consultar, esto me da libertad para ejecutarlo en cualquier instalación, ya que cada uno de mis clientes (obviamente) usará un nombre distinto para su Grupo de trabajo. También utilizo un control ListView con la propiedad CheckBoxes activada. En este control mostraré las máquinas conectadas en el Grupo de trabajo, con iconos del control ImageList informaré de cuáles están ejecutando el programa y cuáles no y con el CheckBox elegiré a quiénes enviar los mensajes. El control ListView tiene dos ColumnHeaders (Nombre y Estado).
En la imagen se puede ver en una vista del diseño, el control ImageList y el objeto WINSE_. Por cierto, el control Winsock que contiene la clase WINSE_ (la que usa el servidor), no necesita que se establezca la propiedad LocalPort (puede estar en cero) si no la propiedad RemotePort que debe tener el mismo número de puerto que el control WNS1 de la parte cliente; es el que captura las peticiones de conexión, en nuestro ejemplo, el 62100.
El evento Init de este formualrio averigua el nombre del servidor y lo eneseña en un cuadro de texto (txtServer), lo que me servirá para "filtrar" su nombre cuando ANETRESOURCES() me devuelva lo que ha encontrado en la red, tengase en cuenta que el servidor también aparecerá. Aprovecho para crear una propiedad tipo Array (Recurs(1)) que utilizaré también con ANETRESOURCES() y enlazo el objeto ImageList (llamado Olecontrol1) al control ListView (llamado LSTV) para mostrar los iconos:
*** Evento Init ***
THIS.AddProperty('Recurs(1)',"")
THISFORM.TXTServer.Value=LEFT(SYS(0),AT("#",SYS(0))-2)
THISFORM.LSTV.SmallIcons=THISFORM.OLecontrol1
El botón Buscar se encarga de la primera fase, averiguar los equipos conectados a la red y llenar el ListView con lo encontrado y en su evento Click tenemos esto:LOCAL nH, nH2
m.nH2=0
THISFORM.CMdProbar.Enabled=.F.
THISFORM.TXTMensaje.Value='BUSCANDO EQUIPOS EN LA RED. ESPERE...'
=THISFORM.TXTMensaje.Refresh()
=THISFORM.lsTV.ListItems.Clear()
=THISFORM.Refresh()
IF LEN(ALLTRIM(THISFORM.TXTRed.Value))>0 THEN
=INKEY(.3,'H')
m.nH2=ANETRESOURCES(THISFORM.recurs,ALLTRIM(THISFORM.TXTRed.Value),0)
FOR nH=1 TO m.nH2
THISFORM.RECURS(nH)=STRTRAN(THISFORM.RECURS(nH),"\","")
IF !THISFORM.RECURS(nH)$THISFORM.TXTServer.Value THEN
THISFORM.LSTV.ListItems.Add(,,THISFORM.RECURS(nH),,1)
ENDIF
NEXT
ENDIF
IF m.nH2>0 THEN
THISFORM.TXTMensaje.Value='COMPLETADA LA BUSQUEDA.'
THISFORM.CMdProbar.Enabled=.T.
ELSE
THISFORM.TXTMensaje.Value='NO ENCUENTRO EQUIPOS EN LA RED.'
ENDIF
Sobre la función ANETRESOURCES(), la documentación de VFP7 dice que el tercer parámetro debe ser 1 para encontrar equipos y 2 para impresoras( cero para Todo), y que el nombre de la red a buscar debe tener la sintaxis "\\NombreRed". Tengo que decir que con ANETRESOURCES() yo no he encontrado Impresoras compartidas nunca y si uso "\\NombreRed" en vez de "NombreRed" sin las dos barras tampoco encuentro equipos. Tal vez no he hecho las pruebas oportunas pero es así como lo he vivido.La segunda fase es comprobar qué equipos están ejecutando el programa y para ello, les envío el mesaje "INFO" para ver si responden "SI.". Este paso se puede hacer a la vez que el primero, pero para mayor claridad en el código lo he establecido medienate el evento Click del botón "Probar Conexión" (cmdProbar). Recordemos que este formulario contiene un objeto de la clase WINSE_ que enviará y recibirá la información de los equipos. El control winsock de esta clase tiene el siguiente código en el evento DataArrival:
*** Evento DataArrival de WS1 ActiveX Control *** LPARAMETERS bytestotal LOCAL sDATOS _VFP.AutoYield=.F. m.sDATOS=SPACE(bytestotal) THIS.OBJECT.GetData(@sDATOS) THIS.Parent.Parent.RESPU=sDATOS _VFP.AutoYield=.T. DOEVENTS"Respu" es una propiedad del Formulario (por eso se usa la indirección Parent.Parent) que lo contiene, y se ha declarado el evento Respu_assign que coloca el icono correspondiente en el elemento del control ListView indicando si está conectado o no:
LPARAMETERS vNewVal *To do: Modify this routine for the Assign method THIS.RESPU = m.vNewVal IF m.vNewVal=='SI.' THEN THISFORM.LSTV.ListItems(THISFORM.LITem).SmallIcon=2 THISFORM.LSTV.ListItems(THISFORM.LITem).SubItems(1)='CONECTADO' THISFORM.Refresh() ENDIF IF m.vNewVal=='CERRANDO.' THEN THISFORM.LSTV.ListItems(THISFORM.LITem).SmallIcon=3 THISFORM.LSTV.ListItems(THISFORM.LITem).SubItems(1)='CERRADO' THISFORM.Refresh() ENDIFVeamos ahora el código del evento Click para el botón Probar conexión (cmdProbar):
LOCAL nSEC, lCON, nH THISFORM.TXTMensaje.Value='PROBANDO CONEXIONES AL SISTEMA...' FOR nH=1 TO THISFORM.LSTV.ListItems.Count THISFORM.LItem=nH IF THISFORM.Cnn.WS1.OBJECT.State==0 THEN THISFORM.Cnn.WS1.OBJECT.RemoteHost=THISFORM.LSTV.ListItems(nH).Text THISFORM.Cnn.WS1.OBJECT.connect() ENDIF nSEC=SECONDS() m.lCON = -1 DO WHILE .T. IF SECONDS()>nSEC+5 OR THISFORM.Cnn.WS1.OBJECT.STATE==7 THEN EXIT ENDIF DO CASE CASE THISFORM.Cnn.WS1.OBJECT.STATE==0 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='CERRADO' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==1 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='ABIERTO' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==2 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='ESCUCHANDO...' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==3 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='PENDIENTE...' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==4 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='RESOLVIENDO...' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==5 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='RESUELTO' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==6 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='CONECTANDO...' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==7 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='CONECTADO' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==8 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='CERRANDO...' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE CASE THISFORM.Cnn.WS1.OBJECT.STATE==9 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE THISFORM.LSTV.ListItems(nH).SubItems(1)='ERROR' m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE ENDCASE ENDDO =THISFORM.Refresh() IF THISFORM.Cnn.WS1.OBJECT.STATE==7 THEN m.lCON=.T. _VFP.AutoYield=.F. THISFORM.Cnn.WS1.OBJECT.SendData("INFO") THISFORM.LSTV.ListItems(nH).SubItems(1)='ENVIADO' =INKEY(1,'H') _VFP.AutoYield=.T. ELSE THISFORM.LSTV.ListItems(nH).SubItems(1)='ERROR O NO CONECTADO' ENDIF DO WHILE THISFORM.Cnn.WS1.OBJECT.STATE<>0 THISFORM.Cnn.WS1.OBJECT.Close() ENDDO NEXT THISFORM.TXTMensaje.Value='COMPLETADA LA COMPROBACION.' THISFORM.CMdDesconec.Enabled=.T.Y para enviar mensajes, incluido el de "CERRAR", uso un método llamado "Envios" en el que se comprueba qué elementos del ListView tienen el CheckBox marcado para eviarles el mensaje, estos elementos los marcaremos previamente y puede ponerse un botón "Marcar Todos" para facilitar el trabajo. Este es el método Envios del Formulario que invoco con el botón Forzar desconexión (envía CERRAR) o el botón Enviar Mensaje, que está oculto por el tamaño del formulario. El botón Mensaje se encarga de establecer la propiedad Height del formulario a un valor más alto, lo que deja ver el cuadro de edición para escribir mensajes de texto y el botón Enviar. Este es el código del método ENVIOS:
LPARAMETERS sMENSAJE
LOCAL nH
FOR nH=1 TO THISFORM.LSTV.ListItems.Count
IF THISFORM.LSTV.ListItems(nH).Checked AND THISFORM.LSTV.ListItems(nH).SmallIcon==2 THEN
THISFORM.LItem=nH
IF THISFORM.Cnn.WS1.OBJECT.State==0 THEN
THISFORM.Cnn.WS1.OBJECT.RemoteHost=THISFORM.LSTV.ListItems(nH).Text
THISFORM.Cnn.WS1.OBJECT.connect()
ENDIF
nSEC=SECONDS()
m.lCON=-1
DO WHILE .T.
IF SECONDS()>nSEC+5 OR THISFORM.Cnn.WS1.OBJECT.STATE==7 THEN
EXIT
ENDIF
DO CASE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==0 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='CERRADO'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==1 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='ABIERTO'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==2 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='ESCUCHANDO...'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==3 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='PENDIENTE...'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==4 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='RESOLVIENDO...'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==5 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='RESUELTO'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==6 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='CONECTANDO...'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==7 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='CONECTADO'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==8 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='CERRANDO...'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
CASE THISFORM.Cnn.WS1.OBJECT.STATE==9 AND m.lCON<>THISFORM.Cnn.WS1.OBJECT.STATE
THISFORM.LSTV.ListItems(nH).SubItems(1)='ERROR'
m.lCON=THISFORM.Cnn.WS1.OBJECT.STATE
ENDCASE
ENDDO
=THISFORM.Refresh()
IF THISFORM.Cnn.WS1.OBJECT.STATE==7 THEN
m.lCON=.T.
_VFP.AutoYield=.F.
THISFORM.Cnn.WS1.OBJECT.SendData(m.sMENSAJE)
THISFORM.LSTV.ListItems(nH).SubItems(1)='ENVIADO'
=INKEY(1,'H')
_VFP.AutoYield=.T.
ELSE
THISFORM.LSTV.ListItems(nH).SubItems(1)='ERROR O NO CONECTADO'
ENDIF
DO WHILE THISFORM.Cnn.WS1.OBJECT.STATE<>0
THISFORM.Cnn.WS1.OBJECT.Close()
ENDDO
ENDIF
NEXT
Y esto es lo que hice. Espero que le sea de guía, inspiración o utilidad para muchos. Cualquier mensaje de mejoras, críticas u opiniones serán bien recibidas.Descarga
Pueden descargar la clase visual desde el siguiente enlace: victor.zip (4.05 KB)