Lentitud al abrir una dbf en red

[lgolexyn]

Hola Manu, un gusto.

La verdad que todavía no pude solucionar mi inconveniente, probablemente por que lo estoy utilizando mal.
tengo un pequeño ej en https://mega.nz/file/s2ME2DRC#2n_YxCn-v ... 6FHKsjMAv8

Mis aplicaciones con TDbf 12, las puedo compilar con FWH 2.5 y xHar 1.0, con versiones mas nuevas de FHW no logre hacerlas andar.

Desde ya muchas gracias Manu.

[karinha]

LINUX Ò WINDOWS?

Se Linux,

Code: Select all  Expand view  RUN

SET DBFLOCKSCHEME TO <nLockScheme>

/* LOCK SCHEMES */
#define DB_DBFLOCK_DEFAULT 0
#define DB_DBFLOCK_CLIP 1
#define DB_DBFLOCK_CL53 2
#define DB_DBFLOCK_VFP 3
#define DB_DBFLOCK_CL53EXT 4
#define DB_DBFLOCK_HB64 5
 

Regards, saludos.

[JoseAlvarez]

Hola Manu, un gusto.

La verdad que todavía no pude solucionar mi inconveniente, probablemente por que lo estoy utilizando mal.
tengo un pequeño ej en https://mega.nz/file/s2ME2DRC#2n_YxCn-v ... 6FHKsjMAv8

Mis aplicaciones con TDbf 12, las puedo compilar con FWH 2.5 y xHar 1.0, con versiones mas nuevas de FHW no logre hacerlas andar.

Desde ya muchas gracias Manu.

Saludos,

Una pregunta un poco tonta, y solo para descartar.

Tienes tu .EXE en cada equipo? o solo en el servidor?

[lgolexyn]

Mi sis sistemas trabajan bajo windwos 10
y el ejecutable esta solo en el servidor.

Saludos

[JoseAlvarez]

Mi sis sistemas trabajan bajo windwos 10
y el ejecutable esta solo en el servidor.

Saludos

Bien, te comento que hace tiempo un colega acá en mi pais me consultó sobre el mismo problema que tenia con un cliente.

Entre ambos nos dedicamos a revisar y decidimos colocar el .EXE en cada maquina . Y esa resultó ser la solución al problema.

El .EXE estaba solo en el servidor y se mandaba a ejecutar desde las estaciones a través de un acceso directo sencillo.

Se hicieron las modificaciones para que el .EXE estuviera en todas las maquinas y buscara los datos en el servidor.

Todo se arregló maravillosamente hasta el dia de hoy.

Por supuesto debes tener claro como vas a administrar la creación de los indices, ya que para ello se requiere acceso exclusivo. Se deben rehacer solo cuando se corrompan. no es necesario crearlos cada vez que se entra al programa. Es lo que podria sugerirte.

Prueba por ese camino a ver, quizas pueda ser tu solución tambien.

[karinha]

Leonardo, porque usted hace esto? este ejemplo fué hecho em Fivewin for Cllipper?

Code: Select all  Expand view  RUN

   // LIMPIO LAS DLL POR SI ALGO QUEDO CARGADO
   FreeLibrary( "BWCC.DLL" )
   FreeLibrary( "BWCCESS.DLL" )
   FreeLibrary( "BWCCESN.DLL" )
 

Y porque llamas a TSBUTTON.ch?

Después voy darle una mirada mejor. Algo no me hace sentido. Mui confuso aún...

Saludos.

[karinha]

Leonardo, este FWBACKUP que usas, és para 32 bits? Podrias disponibilizar para nosotros? Gracias.

Regards, saludos.

[karinha]

Code: Select all  Expand view  RUN

// --------------------------------------------------------------------------//
// FWH 2.5 -  Kine
// (c) Leonardo Olexyn 2023 - Modificado por: Joao Santos. 10/07/2023
// --------------------------------------------------------------------------//

#include "FiveWin.ch"
#Include "Directry.ch"
#include "Mesdbf.ch"  // ??? Para?

// EXTERNAL OrdKeyCount, OrdkeyNo
ANNOUNCE RDDSYS // IDEM: ANNOUNCE FPTCDX
REQUEST OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto // Para ListBox
REQUEST DBFCDX, DBFFPT

STATIC  oWnd, hBorland, SelAnio := 0, oLogin, oIcon
STATIC  tUser := { "", "" }, oCrw, wInstalado, oWndCry

FUNCTION Main()

   LOCAL oBrush, oBar, oCursorMano, oBmp, oImg, lMov := .F.
   // no recomendable.
   LOCAL cOldBmp := GetProfString( "Desktop", "WallPaper" ) // mejor no

   // fivewin antiguo?
   wInstalado := Curdrive() + ":\" + Getcurdir() + "\"

   // SetHandleCount( 150 )  // clipper, no use.

   /* // original
   SET 3DLOOK ON
   SET DELETED ON
   REQUEST DBFCDX
   rddSetDefault( "DBFCDX" )
   REQUEST DBFFPT
   SET EXCLUSIVE OFF
   Set( _SET_AUTOPEN, .T. ) // para? no recomendable.
   */

   /* // antiguo original
   SET DATE FRENCH
   // Año 2000-------------------------
   SET CENTURY ON
   // SET EPOCH ON
   // ---------------------------------
   */

   RDDSETDEFAULT("DBFCDX")
   // se no funcionar en tu version , comente con //
   RDDREGISTER( "DBFCDX", 1 ) // RDT_FULL -> 20/10/2022 Joao

   SET CENTURY ON
   SET DATE BRITISH
   // se no funcionar en tu version, comente con //
   SET TIME FORMAT TO "HH:MM:SS"
   SET EPOCH TO YEAR( DATE() ) - 30
   SET SOFTSEEK OFF
   SET WRAP ON
   SETCANCEL( .F. )
   SET CONFIRM OFF
   SET DELETED ON
   SET _3DLOOK ON
   SET UNIQUE OFF
   SET ESCAPE OFF
   SET EXACT ON
   SET EXCLUSIVE OFF
   SET MULTIPLE OFF
   SET OPTIMIZE ON

   // hBorland := LoadLibrary( "BWCC.DLL" )
   // -------------------------------------------
   // LIMPIO LAS DLL POR SI ALGO QUEDO CARGADO

   /* // usas donde? Controles Borland? donde? Llamou donde?
   FreeLibrary( "BWCC.DLL" )
   FreeLibrary( "BWCCESS.DLL" )
   FreeLibrary( "BWCCESN.DLL" )
   SET RESOURCES TO
   */

   // Porque no usas UN KINE.RES, mui mejor y mas seguro.
   SET RESOURCES TO "KINE.DLL"  

   // Bien mejor, no?
   cTitle := "GESTION KINESIOLOGICA " + SPACE(40) + ;
            "Instituto de Rehabilitacion Delpiano"

   DEFINE CURSOR oCursorMano RESOURCE "DC"

   DEFINE ICON oIcon Resource "OLEX"
   DEFINE BITMAP oBMP FILENAME ".\bitmaps\instlogo.bmp"

   DEFINE FONT oFont  NAME "MS SANS SERIF" SIZE 0, - 12

   DEFINE WINDOW oWnd MDI FROM 4, 4 TO 25, 75 TITLE cTitle ;
      MENU BuildMenu() MENUINFO 6 ICON oIcon

   oWnd:bPainted := {| hDC | PalBmpDraw( hDC, 0, 0, oBmp:hBitmap,, oWnd:nWidth, oWnd:nHeight,, .T. ) }

   DEFINE BUTTONBAR oBar 3D SIZE 32, 32 OF oWnd ;
      CURSOR oCursorMano   // Se define tipo de cursor al posicionarse en la barra.

   DEFINE BUTTON RESOURCE "SALIR" NOBORDER  OF oBar ;
      ACTION ExitMsg() ;
      MESSAGE "Finaliza el Programa" TOOLTIP "Salir"

   DEFINE BUTTON RESOURCE "PACIENTE" NOBORDER OF oBar GROUP ;
      MESSAGE "ABM de Pacientes" TOOLTIP "Pacientes" ;
      WHEN PuedoIng( tUser ) ;
      ACTION Paci_ABM( @tUser )

   ACTIVATE WINDOW oWnd MAXIMIZED

   // no uses esto por ahora.
   // SetDeskWallPaper( cOldBmp ) // We restore old WallPaper...

   // FreeLibrary( hBorland ) // Porque?

   SET RESOURCES TO  // CAMBIE A KINE.RES mucho mejor y Seguro.

   SET 3DLOOK OFF

RETURN NIL

// ----------------------------------------------------------------------------//
FUNCTION BuildMenu()

   LOCAL oMenu, lMov := .F.

   DEFINE MENU oMenu RESOURCE "MENU_KINE"

   /***  Pacientes  ***// ///////////////////
   REDEFINE MENUITEM ID 100 OF oMenu      ;
      ACTION NIL // Paci_ABM( @tUser )         ;
   // MESSAGE "ABM de Pacientes"        ;
   // ACCELERATOR ACC_CONTROL, asc("A")

   // ***  Listado de Pacientes  ***
   REDEFINE MENUITEM ID 110 OF oMenu      ;
      ACTION NIL  // ( LP_Nombre( @tUser ) )         ;

   // MESSAGE "Listado por Nombre del Paciente"        ;
   // ACCELERATOR ACC_CONTROL, asc("b")

   REDEFINE MENUITEM ID 112 OF oMenu      ;
      ACTION NIL  // ( LP_All( @tUser ) )         ;

   // MESSAGE "Listado de Todos los Paciente"        ;
   // ACCELERATOR ACC_CONTROL, asc("T")

   /***  Obra Social  ***// ///////////////////
   REDEFINE MENUITEM ID 130 OF oMenu      ;
      ACTION NIL  // TablaObra( @tUser )         ;

   // MESSAGE "ABM de Obras Sociales"        ;
   // ACCELERATOR ACC_CONTROL, asc("O")

   /***  Tarifas  ***// ///////////////////
   REDEFINE MENUITEM ID 140 OF oMenu      ;
      ACTION NIL // TablaTarif( @tUser )         ;

   // MESSAGE "ABM de Tarifas"        ;
   // ACCELERATOR ACC_CONTROL, asc("T")

   /***  Rubros de Cuentas  ***// ///////////////////
   REDEFINE MENUITEM ID 150 OF oMenu      ;
      ACTION NIL // Rubros_ABM( @tUser )         ;

   // MESSAGE "ABM de Rubros de Cuentas"        ;
   // ACCELERATOR ACC_CONTROL, asc("R")

   /***  Profesionales  ***// ///////////////////
   REDEFINE MENUITEM ID 155 OF oMenu      ;
      ACTION NIL // TablaProf( @tUser )         ;

   // MESSAGE "ABM de Profesionales"        ;
   // ACCELERATOR ACC_CONTROL, asc("P")

   /***  Medicos  ***// ///////////////////
   REDEFINE MENUITEM ID 160 OF oMenu      ;
      ACTION NIL // TablaMed( @tUser )         ;

   // MESSAGE "ABM de Medicos"        ;
   // ACCELERATOR ACC_CONTROL, asc("M")

   /***  Listado de Medicos  ***// ///////////////////
   REDEFINE MENUITEM ID 162 OF oMenu      ;
      ACTION NIL // Lst_Med( @tUser )         ;

   // MESSAGE "Listado de Medicos"        ;
   // ACCELERATOR ACC_CONTROL, asc("t")

   /***  Patologias  ***// ///////////////////
   REDEFINE MENUITEM ID 165 OF oMenu      ;
      ACTION NIL // TablaPat( @tUser )         ;

   // MESSAGE "ABM de Patologías"        ;
   // ACCELERATOR ACC_CONTROL, asc("g")

   /***  Especialidad Medica  ***// ///////////////////
   REDEFINE MENUITEM ID 172 OF oMenu      ;
      ACTION NIL // TablaEsp( @tUser )         ;

   // MESSAGE "ABM de Especialidades Medicas"        ;
   // ACCELERATOR ACC_CONTROL, asc("E")


   /*** Salir ***/
   REDEFINE MENUITEM ID 180 OF oMenu      ;
      ACTION ( ExitMsg() )                ;

      // MESSAGE "Salir de la Aplicación"    ;
   // ACCELERATOR ACC_CONTROL, asc("S")


   /***  Movimientos  ***// ////////////////////////
   REDEFINE MENUITEM ID 200 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // ( Mov_Paci( @tUser ) )         ;

   // MESSAGE "Control de Seciones"                  ;
   // ACCELERATOR ACC_CONTROL, asc("S")

   /*** Caja Diaria ***/
   REDEFINE MENUITEM ID 210 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION  NIL // Caja( @tUser )         ;  // ACTION CajaD( @tUser )  originalmente

   // MESSAGE "Movimientos de Caja"                  ;
   // ACCELERATOR ACC_CONTROL, asc("g")

   /*** Historico Caja  ***/
   REDEFINE MENUITEM ID 230 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION  NIL // Caja( @tUser )        ;   //ACTION Caja( @tUser )  originalmente

   // MESSAGE "Movimientos Historico de Caja"                  ;
   // ACCELERATOR ACC_CONTROL, asc("g")

   REDEFINE MENUITEM ID 232 OF oMenu      ;
      WHEN PuedoIng( tUser )         ;
      ACTION  NIL // DetCajaRub( @tUser )         ;

   // MESSAGE "Detalle de Historico de Caja por Rubro de Cuenta"                  ;
   // ACCELERATOR ACC_CONTROL, asc("S")

   REDEFINE MENUITEM ID 234 OF oMenu      ;
      WHEN PuedoIng( tUser )         ;
      ACTION  NIL // Det_Cajas( @tUser )         ;

   // MESSAGE "Detalle de Historico de Caja por Rubro y un Subrubro de Cuenta"                  ;
   // ACCELERATOR ACC_CONTROL, asc("R")

   REDEFINE MENUITEM ID 236 OF oMenu      ;
      WHEN PuedoIng( tUser )         ;
      ACTION  NIL // DetCajaDH( @tUser )         ;

   // MESSAGE "Detalle de Historico de Caja DEBE Y HABER"                  ;
   // ACCELERATOR ACC_CONTROL, asc("h")

   REDEFINE MENUITEM ID 238 OF oMenu      ;
      WHEN PuedoIng( tUser )         ;
      ACTION  NIL // DetCajaBal( @tUser )         ;

   // MESSAGE "Balance de Historico de Caja por parametro"                  ;
   // ACCELERATOR ACC_CONTROL, asc("B")

   /***  Informes  ***// ////////////////////////
   /***  Deudas  ***/
   REDEFINE MENUITEM ID 300 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL ;// (LUTENTREG( @tUser ) )         ;

   // MESSAGE "Deudas de un Paciente"               ;
   // ACCELERATOR ACC_CONTROL, asc("U")

   REDEFINE MENUITEM ID 302 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_DeudPaci( @tUser ) )         ;

   // MESSAGE "Deudas de Todos los Pacientes"               ;
   // ACCELERATOR ACC_CONTROL, asc("T")

   /***  Pacienes Atendidos  ***/
   REDEFINE MENUITEM ID 310 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_PaciAten( @tUser ) )         ;

   // MESSAGE "Pacientes atendidos por Profesional"               ;
   // ACCELERATOR ACC_CONTROL, asc("P")

   REDEFINE MENUITEM ID 312 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // ( I_TPacAten( @tUser ) )         ;

   // MESSAGE "Toodos los Pacientes"               ;
   // ACCELERATOR ACC_CONTROL, asc("T")

   REDEFINE MENUITEM ID 314 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // ( P_Pacimed( @tUser ) )         ;

   // MESSAGE "Pacientes atendidos por un determinado Medico"               ;
   // ACCELERATOR ACC_CONTROL, asc("M")

   /***  Ordenes  ***/
   REDEFINE MENUITEM ID 320 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_OrdenEnt( @tUser ) )         ;

   // MESSAGE "Cantidad de Ordenes Entregadas"               ;
   // ACCELERATOR ACC_CONTROL, asc("O")

   /***  Seciones por Obra Spocial  ***/
   REDEFINE MENUITEM ID 322 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_TCObra( @tUser ) )         ;

   // MESSAGE "Cantidad de Seciones por Obra Social"               ;
   // ACCELERATOR ACC_CONTROL, asc("S")

   /***  Seciones Discriminadas  ***/
   REDEFINE MENUITEM ID 323 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_TSGCPil( @tUser ) )         ;

   // MESSAGE "Cantidad de Seciones Discrimadas"               ;
   // ACCELERATOR ACC_CONTROL, asc("D")

   /***  Pacientes por Obra Spocial  ***/
   REDEFINE MENUITEM ID 324 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION nill // (I_PPObra( @tUser ) )         ;

   // MESSAGE "Cantidad de Pacientes por Obra Social"               ;
   // ACCELERATOR ACC_CONTROL, asc("t")

   /***  Pacientes por _ y Edad  ***/
   REDEFINE MENUITEM ID 326 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_TPSexEda( @tUser ) )         ;

   // MESSAGE "Cantidad de Pacientes por _ y Edad"               ;
   // ACCELERATOR ACC_CONTROL, asc("E")

   /***  Cantidad de Pacientes por un periodo  ***/
   REDEFINE MENUITEM ID 328 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_TPacAtMe( @tUser ) )         ;

   // MESSAGE "Cantidad de Pacientes en un determinado período"               ;
   // ACCELERATOR ACC_CONTROL, asc("p")

   /***  Cantidad de Pacientes de Gimnacio y Consultorio  ***/
   REDEFINE MENUITEM ID 330 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (I_TPGimCon( @tUser ) )         ;

   // MESSAGE "Cantidad de Pacientes de Gimnacio y Consultorio"               ;
   // ACCELERATOR ACC_CONTROL, asc("G")

   /***  Vencimientos de Gimnacio a la fecha   ***/
   REDEFINE MENUITEM ID 340 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (P_VenciGim( @tUser ) )         ;

   // MESSAGE "Vencimientos de Gimnacio a la fecha"               ;
   // ACCELERATOR ACC_CONTROL, asc("V")

   /***  Vencimientos de Pileta a la fecha   ***/
   REDEFINE MENUITEM ID 342 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // (P_VenciPil( @tUser ) )         ;
   // MESSAGE "Vencimientos de Pileta a la fecha"               ;
   // ACCELERATOR ACC_CONTROL, asc("P")

   /***  Atenciones   ***/
   REDEFINE MENUITEM ID 350 OF oMenu      ;
      WHEN PuedoIng( tUser )        ;
      ACTION NIL // ( ListAten( @tUser ) )         ;

   // MESSAGE "Atenciones"               ;
   // ACCELERATOR ACC_CONTROL, asc("A")


   // ***  Utilidades  ***////////////////////////////
   REDEFINE MENUITEM ID 601 OF oMenu      ;
      ACTION NIL // ( WinExec("Calc") )         ;

   // MESSAGE "Calculadora"               ;
   // ACCELERATOR ACC_CONTROL, asc("d")

   REDEFINE MENUITEM ID 602 OF oMenu      ;
      ACTION NIL // ( nil ) ; //Arreglar( @tUser ) )         ;

   // MESSAGE "Calendario"                ;
   // ACCELERATOR ACC_CONTROL, asc("c")

   REDEFINE MENUITEM ID 603 OF oMenu      ;
      ACTION NIL ;  // ( PrinterSet() )             ;

   // MESSAGE "Configurar Impresora"      ;
   // ACCELERATOR ACC_CONTROL, asc("I")

   // submenu Reorganizar archivos
   REDEFINE MENUITEM ID 604 OF oMenu      ;
      WHEN PuedoIng( tUser )         ;
      ACTION  ( Indexar() )             ;
      MESSAGE "Reorganizar Archivos del Sistema"      ;
      ACCELERATOR ACC_CONTROL, Asc( "R" )

   REDEFINE MENUITEM ID 610 OF oMenu      ;
      WHEN PuedoIng( tUser )           ;
      ACTION NIL // ( Seguridad( oWnd ) )   ;

   // MESSAGE "Copia de Seguridad de los datos del Sistema"      ;
   // ACCELERATOR ACC_CONTROL, asc("S")

   REDEFINE MENUITEM ID 614 OF oMenu      ;
      WHEN PuedoIng( tUser )           ;
      ACTION NIL ;// ( TablaLocal(tUser ) )   ;
      // MESSAGE "Tabla de Localidades"      ;
   // ACCELERATOR ACC_CONTROL, asc("L")

   REDEFINE MENUITEM ID 630 OF oMenu      ;
      WHEN PuedoIng( tUser )           ;
      ACTION NIL // ( ABM_Usuar(tUser ) )   ;

   // MESSAGE "ABM de Usuarios del Sistema"        ;
   // ACCELERATOR ACC_CONTROL, asc("U")

   REDEFINE MENUITEM ID 635 OF oMenu      ;
      WHEN PuedoIng( tUser )           ;
      ACTION NIL // ( Conf_Sis(tUser ) )   ;

   // MESSAGE "Configurar Opciones del Sistema"        ;
   // ACCELERATOR ACC_CONTROL, asc("S")

RETURN ( oMenu )

// ----------------------------------------------------------------------------//
// LLAMADO A PROCEDIMIENTO DE COPIA DE SEGURIDAD
FUNCTION Seguridad( oWnd )

   IF MSGYESNO( "El programa se cerrara automáticamente para permitir la copia de todos sus archivos." + CRLF + CRLF + ;
         "Si está trabajando en una RED de ordenadores es muy recomendable que cierre este " + ;
         "programa en todos los ordenadores antes de comenzar." + CRLF + CRLF + ;
         "¿Desea comenzar la copia?", "Copia de Seguridad" )

      WINEXEC( "FWBACKUP.EXE" )  // enviame la version para 32 bits porfa.

      oWnd:END()

   ENDIF

RETURN .T.

// ----------------------------------------------------------------------------//
FUNCTION BrowseSoftware

RETURN NIL

// __ExitMsg() --> lRet. Customized exit message.                *

FUNCTION ExitMsg()

   LOCAL oDlg, oYes, oNo
   LOCAL lRet := .T.

   DEFINE DIALOG oDlg RESOURCE "EXITMSG"

   REDEFINE BUTTON ID 6 OF oDlg ACTION ( oWnd:End() )
   REDEFINE BUTTON ID 7 OF oDlg ACTION ( lRet := .F., oDlg:End() )

   ACTIVATE DIALOG oDlg CENTER

   IF lRet = .T.

      // FreeLibrary( hBorland ) // donde usas Borland??

      SET RESOURCES TO

   ENDIF

RETURN ( lRet )

// ----------------------------------------------------------------//
STATIC FUNCTION Login( tUser )

   LOCAL oDlg, cUser := Space( 10 ), cPassword := Space( 10 )
   LOCAL lDev := .F., lAccion := .F., oNivel
   LOCAL tNivel := { "Consulta", "Consulta-Alta", "Cons-Alta-Modif", "Adminstrador" }

   DEFAULT lAccion := .F.

   DEFINE DIALOG oDlg RESOURCE "Login"

   REDEFINE GET cUser     ID 110 OF oDlg PICTURE"@!" UPDATE

   REDEFINE GET cPassword ID 120 OF oDlg PICTURE"@!" UPDATE

   REDEFINE BUTTON ID 991 OF oDlg ACTION ( lAccion := .T., oDlg:End() )

   REDEFINE BUTTON ID 992 OF oDlg ACTION ( oDlg:End() ) CANCEL

   ACTIVATE DIALOG oDlg CENTERED

   IF lAccion

      AbreAppl() // ponga um MsgRun(0 aqui...

      oLogin:SetFocus()
      oLogin:Gotop()

      SEEK SubStr( cUser, 1, 10 )

      IF !Found()

         msginfo( "Usuario Inexistente", cUser )

         oLogin:End()

         RETURN .F.

      ELSE

         IF Upper( APPLICA->Password ) <> Upper( cPassword )

            msginfo( "Password Incorecta", cUser )

            oLogin:End()

            RETURN .F.

         ENDIF

         VerUser( @cUser, @tNivel, @tUser )

         oLogin:End()

         RETURN .T.

      ENDIF

   ENDIF

RETURN .F.

FUNCTION VeriLogin( tUser )

   LOCAL oDlg, cUser := Space( 10 ), cPassword := Space( 10 )
   LOCAL lDev := .F., lAccion := .F., oNivel

   DEFAULT lAccion := .F.

   DEFINE DIALOG oDlg RESOURCE "Login"

   REDEFINE GET cUser     ID 110 OF oDlg PICTURE"@!" UPDATE ;
      valid( !Empty( cUser ) )

   REDEFINE GET cPassword ID 120 OF oDlg PICTURE"@!" UPDATE

   REDEFINE BUTTON ID 991 OF oDlg ;
      ACTION ( lAccion := .T., oDlg:End() ) CANCEL

   ACTIVATE DIALOG oDlg CENTERED

   IF lAccion

      AbreApPl() // Un MsgRun()?

      oLogin:Gotop()

      SEEK  SubStr( Upper( User ), 1, 10 )  // SUBSTR( cUser,1,10 )

      IF !Found()

         msginfo( "Usuario Inexistente", cUser )

         oLogin:End()

         RETURN .F.

      ELSE

         IF Upper( APPLICA->Password ) <> Upper( cPassword )

            msginfo( "Password Incorecta", cUser )

            oLogin:End()

            RETURN .F.

         ENDIF

         // VerUser( @cUser, @tNivel, @tUser )
         oLogin:End()

         RETURN .T.

      ENDIF

   ENDIF

RETURN .F.

STATIC FUNCTION VerUser( cUser, tNivel, tUser )

   tUser := Array( 2 )

   SET MESSAGE OF oWnd ;
      TO ( "Usuario: " + Trim( cUser ) + "  Nivel: " + tNivel[ APPLICA->Nivel ] );
      DATE

   tUser[ 1 ] := Trim( cUser )
   tUser[ 2 ] := Str( APPLICA->Nivel )

RETURN NIL

// Abre APPLICA

FUNCTION AbreAppl()

   // Porque usas esto? Cual la ventaja?

   DEFINE DATABASE oLogin FILE "APPLICA.DBF"  ALIAS "APPLICA"

   FIELD NAME "USER"       TYPE "C"  LEN 10  DEC 00 OF oLogin
   FIELD NAME "PASSWORD"   TYPE "C"  LEN 10  DEC 00 OF oLogin
   FIELD NAME "NIVEL"      TYPE "N"  LEN 01  DEC 00 OF oLogin

   DEFINE INDEX ON SubStr( Upper( User ), 1, 10 ) TO APPLICA TAG user ;
      NODELETED OF oLogin

   END DATABASE oLogin

   ACTIVATE DATABASE oLogin SHARED  // PROTEC

RETURN( oLogin )

STATIC FUNCTION PuedoIng( tUser )

   IF tUser[ 2 ] = "1"

      // msginfo("Acceso Denegado!!", "Atención")

      RETURN ( .F. )

   ENDIF

RETURN ( .T. )

// MODULO DE EJECUCION PARA REPORTES EN CRYSTALL REPORT 6.0

FUNCTION ejecutar( listado, lScreen )

   LOCAL nTablas := 0
   LOCAL i       := 0
   LOCAL eTablas := 0

   // Inicializa un Trabajo de Impresión, es decir,
   // que se pueden lanzar los que quieras sin cerrar los anteriores.

   oCrw:PeOpenPrintJob( listado )

   // Crystal crea un array con las tablas del informe
   // Ojo la primera posicion es "0" y no "1"
   // PeGetNTables()      // Retorna el numero de Tablas del Informe
   // PeGetTabLocation()  // Da la ubicacion de la Tabla, segun el informe de Crystal.
   // PeSetTabLocation()  // Modifica en el array de Crystal la posicion de la Tabla.

   // Localiza todas las Tablas, donde dice el informe o en la ubicación de instalación := wInstalado

   nTablas := oCrw:PeGetNTables()

   FOR i = 1 TO nTablas

      IF File( oCrw:PeGetTabLocation( i - 1 ) )

         eTablas++

      ELSE

         // wInstalado es la ubicacion del exe, si las dbf estan en otro sitio añadirlo
         IF File( wInstalado + cFileName( oCrw:PeGetTabLocation( i - 1 ) ) )

            eTablas++

            oCrw:PeSetTabLocation( ( i - 1 ), wInstalado + cFileName( oCrw:PeGetTabLocation( i - 1 ) ) )

         ENDIF

      ENDIF

   NEXT

   // Realiza el listado si encontro todos los ficheros
   IF nTablas = eTablas

      IF lScreen

         oCrw:PeSetWindowOptions()      // Fija los Botones de la ventana que aparecen
         oCrw:PeOutputToWindow( oWnd )  // Envia el listado a pantalla

      ELSE

         oCrw:PeOutToPrinter()          // Envia el listado a Impresora

      ENDIF

      // Ejecuta el Listado con las condiciones fijadas
      oCrw:PeStartPrintJob()

   ELSE

      msginfo( "Algún Fichero de Datos, No se pudo Encontrar", "Mensaje de Error" )

   ENDIF

   oCrw:PeClosePrintJob()    // Finaliza el trabajo y permite hacer otra cosa

RETURN NIL

// pinta en degrade la Ventana Principal

FUNCTION FillBlue()

   LOCAL hDC   := OWND:OWNDCLIENT:hDC
   LOCAL hWnd  := oWnd:OWNDCLIENT:hWnd
   LOCAL aRect := GetClientRect( hWnd )
   LOCAL oBrush
   LOCAL nBlue := 200
   LOCAL nStep, N

   NSTEP := ( Abs( ARECT[ 3 ] - ARECT[ 1 ] ) + 1 ) / 200

   FOR n = ARECT[ 1 ] TO ARECT[ 3 ] STEP NSTEP

      DEFINE BRUSH oBrush COLOR RGB( NBLUE, 0, 0 )

      FillRect( hDC, { N, ARECT[ 2 ], N + NSTEP, ARECT[ 4 ] }, oBrush:hBrush )

      RELEASE BRUSH oBrush

      nBlue -= 1

   NEXT

RETURN NIL

FUNCTION GetSysFont() ; RETURN "MS Sans Serif"  // ???

// fin / end

Regards, saludos.

[lgolexyn]

El fwbackup que figura ahí, ya no lo uso por ser de 16bits

El que uso ahora es PBACKUP de https://javierlloris.blogspot.com/
Adjunto el mio en 32bits compilado con FWH 17 y xHar 1.2.3
https://mega.nz/file/Ai9XhDjZ#gM1MSjFYm ... BKpLCqX72o

Espero sirva.
Saludos

[FiveWiDi]

Hola Leonardo.

Soy Manu Expósito, hice TDbf hace muchos años como ejercicio de aprendizaje para mi y de paso lo cedí a dominio público para que todo el mundo pudiera usarla libremente...

No sé si ya se solucionó el tema. Si no lo hizo podríamos intentar arreglarlo para que TDbf siga unos años más en la palestra.

Como seguro que si le meto mano de nuevo habrá cambios me gustaría que los que tengáis algún cambio implantado me lo hicierais llegar, (Carlos)

Un saludo

Por supuesto Manu, faltaría más!!

Dame un mail i te reenvío lo que le envié a Leonardo.

[xmanuel]

Hola a todos...

Carlos mi correo es xmessoft de gmail.com

[xmanuel]

Carlos envíame todo el código...
No sé si tengo algo nuevo con respecto al tuyo...
Si hay algo lo refundimos para que salga una versión para el nuevo siglo

Tengo pensado hacer una nueva TDbf que no será compatible con la vieja TDbf, se llamará TCRdd, estará hecha en C++ al 100x100 y será de dominio público como TDbf para que la use el que quiera y tenga todo el código para podáis modificarla...

[FiveWiDi]

Hola a todos...

Carlos mi correo es xmessoft de gmail.com

Enviado.

[FiveWiDi]

Carlos envíame todo el código...
No sé si tengo algo nuevo con respecto al tuyo...
Si hay algo lo refundimos para que salga una versión para el nuevo siglo

Tengo pensado hacer una nueva TDbf que no será compatible con la vieja TDbf, se llamará TCRdd, estará hecha en C++ al 100x100 y será de dominio público como TDbf para que la use el que quiera y tenga todo el código para podáis modificarla...

Se agradece mucho, en este foro hay unas contribuciones que son oro.

[xmanuel]

Carlos por fin hoy he podido ver las modificaciones, pero te falta enviar los includes.
La primera fase será incluir todos los cambios que has añadido y limpiar los residuos de la compatibilidad con clipper que ahora puede ser un lastre.

Voy a crear un hilo para este tema...