Pantalla de errores antigua y nueva.

[Garbi]

Antes de actualizar la version de fivewin, ahora tengo 15.09.

Antes cuando una aplicacion daba un error por que no existía una variable o cualquier error salia la tipica ventana de variable no existe, y la linea donde se producia. y Quit o Default (algunas veces)

Ahora sale una pantalla de error de windows que el programa se cerrara y genera el error en el fichero hb_out.txt pero indica como si fuera un volcado de memoria, pero no el porque se ha producido exactamente. Ejemplo no indica que la variable vtsock no existe porque la variable se llama realmente vstock y me he equivocado al escribirlo.

Como puedo volver a la pantalla anterior o mejor aun como incorporar esa descripcion en el fichero hb_out.txt

Muchas Gracias.

[cuatecatl82]

Cierto, lo he notado en los ejemplos que se comparten en el foro, antes mostraba un dialogo con el icono de Fivetech y una descripcion completa de donde provenia el fallo, ahora no solo un simple msg("Falta xVariable") y fin

Tomada de un ejemplo..


a que se deberá..?

Saludos.

[karinha]

probablemente, usted está utilizando un ERRSYSW.PRG de una versión incompatible con la versión actual.
Reemplazar ERRSYSW.PRG por el nuevo ERRSYSW.PRG de la versión actual.

Saludos.

[Antonio Linares]

Garbi, Victor,

Probad a hacer fwh\samples\buildh.bat testerro

Debería aparecer la típica ventana de errores de FWH

Como ha indicado João, comprobad que no esteis usando un gestor de errores modificado (errsysw.prg) y que tenga
un error en el mismo, lo que produce finalmente un GPF y de ahi que se genere el fichero hb_out.log

[Garbi]

Hola, he retomado este tema para poder dejarlo claro y el unico fichero de errores es el que un compañero me dejo usar que ajunto codigo, prodian ayudarme a saber que tengo que cambiar para que me vuelva a salir la tipica pantalla derror de clipper.

Muchas Gracias

Code: Select all  Expand view

#INCLUDE "FIVEWIN.CH"
#INCLUDE "ORD.CH"
#include "error.ch"

external _fwGenError                             // Link FiveWin generic Error Objects Generator

#define NTRIM(n)         ( LTrim(Str(n)) )
#ifdef __CLIPPER__
   #define DLG_TITLE "FiveWin: The CA-Clipper for Windows Library"
#else
   #ifdef __HARBOUR__
      #define DLG_TITLE "FiveWin for Harbour"
      #command QUIT => ( PostQuitMessage( 0 ), __Quit() )
   #else
      #define DLG_TITLE "FiveWin for Xbase++"
   #endif
#endif



/*
 Funcion: OpenDbf()
 Sintaxis: OpenDbf(<cNomdbf>,[<nSecs>],[<lModo>],[<lSlect>],[<lEspera>],[<aIndices>|<cIndice>],[<cDriver>]))
 Descripcion: Funcion para abrir una base de datos compartida o exclusiva
              en entornos de redes
 Parametros:
    <cNomdbf>    Nombre de la base de datos a abrir
    [<nSecs>]    Segundos que tiene que esperar si no puede abrir el DBF
    [<lModo>]    Modo de apertura .T. = compartida .F. = Exclusiva
    [<lSlect>]   Modo de acceso .T. = Solo lectura .F. = lectura/escritura
    [<lEspera>]  .T. = Solo saldra hasta poder abrir el Archivo
    [<aIndices>] Arreglo que contendra los indices
    <cIndice>    Nombre de indice
    [<cDriver>]  drive a utilizar por la base de datos
 Regresa: Un alias nuevo para la base de datos recien abierta si esta se
          pudo abrir adecuadamente, una cadena vacia si no se pudo abrir
          o bien se cancelo la operacion de apertura
 Autor: Rene M. Flores
 Modifico:Víctor Manuel Tomás Díaz.
          Se agrego el Parametro lEspera y el parametro a Indices para abrir los indices
          de manera automatica ademas de revisar si existen.
          Se puede abrir cualquier drive cdx ntx
          Se agrega BEGIN SEQUENCE para captar el error en caso de que el archivo no sea un Dbf.
 Fecha: 25-Junio 1999
*/

FUNCTION OpenDbf(cNomdbf,nSecs,lModo,lSlect,lEspera,aIndices,cDriver)
  LOCAL oGenError
  LOCAL bNewError, bOldError
  LOCAL lOk  := .T.                     // Control de error
  LOCAL cVret := ""                     // Valor de retorno
  LOCAL lError := lExit := .T.          // Control de apertura
  LOCAL cTempAlias,nTimer               // Temporales
  LOCAL oBotAcept,oBotCancel,oBmp,oFont // Temporales
  DEFAULT nSecs := 5                    // Tiempo de espera
  DEFAULT lModo := .T.                  // Compartido
  DEFAULT lSlect := .F.                 // Lectura y escritura
  DEFAULT lEspera := .F.                // Respeta el tiempo de espera
  DEFAULT aIndices := ""                // Indices
  DEFAULT cDriver := DbsetDriver()
  IF !FILE( cNomdbf )
     MsgStop("NO EXISTE EL ARCHIVO "+cNomdbf,"ERROR EN EL SISTEMA")
     RETURN (cVret)
  ENDIF
  CursorWait()
  nTimer := SECONDS() + nSecs
  cTempAlias := SUBSTR(cFileNoExt(cFileName(cNomDbf)),1,4)
  cAlias := NewAlias(cTempAlias)
  DO WHILE lError .AND. lExit
     bNewError := {|oError| ErrorHandler(oError,.T.) } // Prepara el objeto error
     bOldError := Errorblock(bNewError)                // Error actual

     BEGIN SEQUENCE
           DBUSEAREA(.T.,cDriver,cNomdbf,cAlias,lModo,lSlect) // Abre el Archivo
     RECOVER USING oGenError                           // Si hubo error lo toma

          IF Select( cAlias ) > 0                      // Cierra el area abierta
               ( cAlias )->(DbCloseArea())
          ENDIF
          lOk := .F.                                   // Se genero un error
          IF oGenError != NIL
             * oGenError := ChkError(oGenError, cFile)
               MsgStop("ERROR EN EL ARCHIVO"+CRLF+Upper(cFileNoExt(cFileName(cNomDbf)))+CRLF+"IMPOSIBLE CONTINUAR","ERROR FATAL")
          ENDIF
     END SEQUENCE
     Errorblock(bOldError)
     IF !lOk                                           // Hubo error al abrir la base de datos
        RETURN(cVret := "")                            // Regresa vacio
     ENDIf
     lError := NETERR()
     IF !lError
        cVret := cAlias
        IF !Empty(aIndices)
           IF !AbrirIdx(aIndices)                         // Error al Abrir los indices
              ( cAlias )->(DbCloseArea())                 // Cierra el area abierta
              cVret := ""                                 // Regresa vacio
           ENDIF
        ENDIF
     ELSE
        cVret := ""
     ENDIF
     IF SECONDS() >= nTimer .AND. lError
       IF !lEspera
          MsgBeep()
          IF MsgRetryCancel("NO ESTA DISPONIBLE EL ARCHIVO: "+upper(cFileName(cNomDbf)),"AVISO DEL SISTEMA")
             lError := .T. ; lExit := .T. ; nTimer := SECONDS() + nSecs
          ELSE
             lError := .T. ; lExit := .F.
          ENDIF
       Else
          Msginfo("NO ESTA DISPONIBLE EL ARCHIVO: "+upper(cFileName(cNomDbf)),"AVISO DEL SISTEMA")
          lError := .T.; lExit := .T. ; nTimer := SECONDS() + nSecs
       ENDIF
     ENDIF
  ENDDO
RETURN (cVret)


/*
 Funcion: NewAlias()
 Sintaxis: NewAlias(<cNomdbf>)
 Descripcion: Asigna un nuevo alias para las bases de datos a abrir, esta
              funcion permite abrir varias veces la misma base de datos
              es ideal para ambientes MDI
 Parametros:
    <cNomdbf>  Nombre de la base de datos a abrir
 Regresa: Una cadena de caracteres con el nombre del alias nuevo                                                                        *
 Autor: Rene M. Flores
 Fecha: 30 Agosto 1996
*/

FUNCTION NewAlias(cNomDbf)
  STATIC nNum := 0
  LOCAL cAlias := ""
  nNum++
  cAlias := cNomDbf + LTRIM(STR(nNum))
RETURN (cAlias)

/*
 Funcion: Add_reg()
 Sintaxis: Add_reg( <cNomdbf>,[<nSecs>],[<lEspera>] )
 Descripcion: Agrega un campo en blanco a la base de datos

 Parametros:
    <cNomdbf>    Nombre de la base de datos a abrir
    [<nSecs>]    Segundos que tiene que esperar si no puede bloquear el registro
    [<lEspera>]  Solo saldra hasta poder agregar un el registro

 Regresa: Un valor verdadero si se pudo bloquear el registro o un falso en
          caso de que no se logro el bloque o cancelacion de la operacion
 Autor: Rene M. Flores
 Fecha: 30 Agosto 1996
 Modifico:Víctor Manuel Tomás Díaz.
          Se agrego el Parametro lEspera para efectos de la programación
          en Codman, S.A. de C.V.  2 Marzo 1999
 Fecha: 25 Junio 19999
*/
FUNCTION Add_Reg(cAlias,nSecs,lEspera)
  LOCAL lVret := .F.
  LOCAL lError := .T.
  LOCAL nTimer//,oDlg
  DEFAULT nSecs := 5
  DEFAULT lEspera := .T.
  nTimer := SECONDS() + nSecs
  DO WHILE lError
     (cAlias)->(DBAPPEND())
     lError := NETERR()
     IF lError
        IF SECONDS() >= nTimer
           IF !lEspera
              * DEFINE DIALOG oDlg RESOURCE "DLG_NET_ERR" TITLE "AGREGAR REGISTRO"
              *
              * REDEFINE BUTTON oBotAcept ID 1 OF oDlg;
              *          ACTION (nTimer := SECONDS() + nSecs,oDlg:End()) UPDATE
              * REDEFINE BUTTON oBotCancel ID 2 OF oDlg;
              *          ACTION (oDlg:End()) UPDATE
              * ACTIVATE DIALOG oDlg CENTERED
              IF MsgRetryCancel("NO ESTA DISPONIBLE EL ARCHIVO: "+upper(cFileName(cNomDbf)),"AVISO DEL SISTEMA")
                 nTimer := SECONDS() + nSecs // Se incrementan los segundos
              ELSE
                 lError := .F.
              ENDIF
           ELSE
              nTimer := SECONDS() + nSecs    // Se incrementan los segundos
           ENDIF
        ENDIF
     ELSE
       IF Reg_Lock(cAlias,nSecs)
         lVret := .T.
       ENDIF
     ENDIF
  ENDDO
RETURN (lVret)

/*
 Funcion: Reg_lock()
 Sintaxis: Reg_lock( <cNomdbf>,[<nSecs>],[<lEspera>] )
 Descripcion: Realiza el bloqueo de un registro
 Parametros:
    <cNomdbf>  Nombre de la base de datos a abrir
    [<nSecs>]  Segundos que tiene que esperar si no puede bloquear el registro
    [<lEspera>]  Solo saldra hasta poder agregar un el registro

 Regresa: Un valor verdadero si se pudo bloquear el registro o un falso en
          caso de que no se logro el bloque o cancelacion de la operacion
 Autor: Rene M. Flores
 Fecha: 30 Agosto 1996

 Modifico:Víctor Manuel Tomás Díaz.
          Se agrego el Parametro lEspera para efectos de la programación
          en Codman, S.A. de C.V.  2 Marzo 1999
 Fecha: 25 Junio 19999
*/
FUNCTION Reg_Lock(cAlias,nSecs,lEspera)
  LOCAL lVret := .F.
  LOCAL lError := .F.
  LOCAL nTimer , oSay ,oFont
  DEFAULT nSecs := 5
  DEFAULT lEspera := .T.
  nTimer := SECONDS() + nSecs
  DO WHILE  !lError
     lError := (cAlias)->(RLOCK())
     IF lError
        lVret := .T.
     ELSE
        IF !lEspera
           IF SECONDS() >= nTimer
              * DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0,-10  // definimos fuente tipo Windows 95
              *
              * DEFINE DIALOG oDlg RESOURCE "DLG_NET_ERR";
              *        TITLE "AVISO AL USUARIO" FONT oFont
              *
              * REDEFINE BUTTON oBotAcept ID 1 OF oDlg;
              *          ACTION (nTimer := SECONDS() + nSecs, oDlg:End()) UPDATE
              * REDEFINE BUTTON oBotCancel ID 2 OF oDlg;
              *          ACTION (lError := .T. , oDlg:End()) UPDATE
              * REDEFINE SAY oSay ;
              *          PROMPT "NO ESTA DISPONIBLE EL REGISTRO" ID 500 OF oDlg UPDATE
              * ACTIVATE DIALOG oDlg CENTERED
              IF MsgRetryCancel("NO ESTA DISPONIBLE EL REGISTRO" ,"AVISO DEL SISTEMA")
                 nTimer := SECONDS() + nSecs
              ELSE
                 lError := .T.
              ENDIF
           ENDIF
        ELSE
           MSGINFO("NO ESTA DISPONIBLE EL REGISTRO","AVISO DEL SISTEMA")
           nTimer := SECONDS() + nSecs
        ENDIF
     ENDIF
  ENDDO
RETURN (lVret)

/**
 Funcion: File_Lock()
 Sintaxis: File_Lock(<oOwner>,<cAlias>)
 Parametros:
    <cNomdbf>  Nombre de la base de datos a bloquear
    [<nSecs>]  Segundos que tiene que esperar si no puede abrir el DBF

 Regresa: Verdadero si se pudo bloquear la bases de datos
          Falso si no pudo abrir adecuadamente o bien se cancelo la operacion de bloqueo
 Autor: Rene M. Flores
 Fecha: 30 Agosto 1996
*/

FUNCTION File_Lock(cAlias,nSecs)
   LOCAL lVret := .F.
   LOCAL lError := .F.
   LOCAL nTimer,oDlg
   LOCAL oBotAcept,oBotCancel
   DEFAULT nSecs := 5
   nTimer := SECONDS() + nSecs
   DO WHILE !lError
      (cAlias)->(FLOCK())
      lError := (cAlias)->(NETERR())
      IF lError
         lVret := .T.
      ELSE
         IF SECONDS() >= nTimer
            * DEFINE DIALOG oDlg RESOURCE "DLG_NET_ERR" ;
            *          TITLE "BLOQUEO DE LA BASE DE DATOS"
            * REDEFINE BUTTON oBotAcept ID 1 OF oDlg;
            *          ACTION (lError := .T.,nTimer := SECONDS() + nSecs,oDlg:End()) UPDATE
            * REDEFINE BUTTON oBotCancel ID 2 OF oDlg ;
            *          ACTION (lError := .T.,oDlg:End()) UPDATE
            * ACTIVATE DIALOG oDlg CENTERED
            IF MsgRetryCancel("NO ESTA DISPONIBLE EL ARCHIVO" ,"AVISO DEL SISTEMA")
               nTimer := SECONDS() + nSecs
            ELSE
               lError := .T.
            ENDIF
         ENDIF
      ENDIF
   ENDDO
RETURN (lVret)

/*
 Funcion: DelReg()
 Sintaxis: DelReg( <cNomdbf> )
 Descripcion: Marca un registro como borrado
 Parametros:
    <cNomdbf>  Nombre de la base de datos a abrir
 Regresa: Un valor verdadero si se logro marcar el registro como borrado
          caso contrario regresa falso
 Autor: Rene M. Flores
 Fecha: 30 Agosto 1996
*/
FUNCTION DelReg(cAlias)
   LOCAL lVret := .F.
   IF Reg_Lock(cAlias)
      lVret := .T.
      (cAlias)->(DBDELETE())
      (cAlias)->(DBUNLOCK())
   ENDIF
RETURN (lVret)

/*
 Funcion: UnDelReg()
 Sintaxis: UnDelReg( <cNomdbf> )
 Descripcion: Desmarca un registro como borrado
 Parametros:
    <cNomdbf>  Nombre de la base de datos a abrir
 Regresa: Un valor verdadero si se logro desmarcar el registro como borrado
          caso contrario regresa falso
 Autor: Rene M. Flores
 Fecha: 30 Agosto 1996
*/
FUNCTION UnDelReg(cAlias)
   LOCAL lVret := .F.
   IF Reg_Lock(cAlias)
      lVret := .T.
      (cAlias)->(DBRECALL())
      (cAlias)->(DBUNLOCK())
   ENDIF
RETURN (lVret)

STATIC FUNCTION MsgError(e)

    LOCAL cMessage

     cMessage := if( empty( e:osCode ), ;
                    if( e:severity > ES_WARNING, "ERROR ", "ATENCION " ),;
                    "(DOS Error " + NTRIM(e:osCode) + ") " )

     cMessage += if( ValType( e:subsystem ) == "C",;
                    e:subsystem()                ,;
                    "???" )

     cMessage += if( ValType( e:subCode ) == "N",;
                    "/" + NTRIM( e:subCode )   ,;
                    "/???" )

     IF ( ValType(e:description) == "C" )
          cMessage += "  " + e:description
     END

     cMessage += if( !Empty( e:filename ),;
                 ": " + e:filename   ,;
                 if( !Empty( e:operation ),;
                    ": " + e:operation   ,;
                    "" ) )

     MsgInfo(cMessage, "DESCRIPCION DE ERROR")

RETURN NIL


PROC ErrorSys()
     ErrorBlock( { | e | ErrorDialog( e ) } )
RETURN

proc ErrorLink()
return


/*
STATIC FUNCTION ErrorDialog( e )

     LOCAL lRet
     *LOCAL i, j, cMessage, aStack := {}
     LOCAL cErrorLog
     LOCAL xRet
     LOCAL aVersions
     *LOCAL aTasks

     *IF ( e:genCode == EG_NOFUNC )
     *     IF e:Args == NIL
     *     ELSE
     *          Aeval(e:Args, {|v,e| aParam[e] := v })
     *     ENDIF
     *     IF Valtype(xRet) != "N" .OR. xRet != -1
     *          RETU xRet
     *     ENDIF
     *ENDIF

     // Control de errores tipicos que no provocan runtime-error

     IF ( e:genCode == EG_ZERODIV )
          RETU (0)
     ENDIF

     IF ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
          NetErr(.t.)
          RETU .f.
     ENDIF

     IF ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
          NetErr(.t.)
          RETU .f.
     ENDIF

RETURN lRet
*/
static function ErrorDialog( e ) // -> logical or quits App.

   local oDlg, oLbx, oFont
   local lRet    // if lRet == nil -> default action: QUIT
   local n, j, cMessage, aStack := {}
   local oSay, hLogo
   local nButtons  := 1
   local cErrorLog := ""
   local aVersions := GetVersion()
   local aTasks
   local aRDDs, nTarget, uValue
   local oOldError
   local cRelation
   local lIsWinNT := IsWinNT()

   // by default, division by zero yields zero
   if ( e:genCode == EG_ZERODIV )
      return 0
   end

   // for network open error, set NETERR() and subsystem default
   if ( e:genCode == EG_OPEN .and. ;
      ( e:osCode == 32 .or. e:osCode == 5 ) .and. ;
        e:canDefault )
      NetErr( .t. )
      return .f.       // Warning: Exiting!
   end

   // for lock error during APPEND BLANK, set NETERR() and subsystem default
   if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
      NetErr( .t. )
      return .f.       // OJO SALIDA
   endif

   if Left( ProcName( 7 ), 10 ) == "ERRORDIALO"
      SET RESOURCES TO
      ErrorLevel( 1 )
      QUIT
   endif

   ErrorBlock( {|e| MsgStop( ErrorMessage(e) + " from Errorsys, line:" + ;
                             Str( ProcLine( 1 ), 4 ) ), __quit() } )

   cErrorLog += "Application" + CRLF
   cErrorLog += "===========" + CRLF
   cErrorLog += "   Path and name: " + GetModuleFileName( GetInstance() )

   #ifdef __CLIPPER__
      cErrorLog += " (16 bits)" + CRLF
   #else
      cErrorLog += " (32 bits)" + CRLF
   #endif

   cErrorLog += "   Size: " + Transform( FSize( GetModuleFileName( ;
                GetInstance() ) ), "9,999,999 bytes" ) + CRLF
   #ifdef __CLIPPER__
      cErrorLog += "   Max files handles permited: ( SetHandleCount() ) " + ;
                   Str( SetHandleCount(), 3 ) + CRLF
   #endif

   cErrorLog += "   Time from start: " + TimeFromStart() + CRLF

   cErrorLog += "   Error occurred at: " + ;
                DToC( Date() ) + ", " + Time() + CRLF

   // Error object analysis
   cMessage   = "   Error description: " + ErrorMessage( e ) + CRLF
   cErrorLog += cMessage

   if ValType( e:Args ) == "A"
      cErrorLog += "   Args:" + CRLF
      for n = 1 to Len( e:Args )
         cErrorLog += "     [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
                      "   " + cValToChar( e:Args[ n ] ) + CRLF
      next
   endif

   cErrorLog += CRLF + "Stack Calls" + CRLF
   cErrorLog += "===========" + CRLF
      n := 2    // we don't disscard any info again !
      while ( n < 74 )
          if ! Empty(ProcName( n ) )
             AAdd( aStack, "   Called from: " + ProcFile( n ) + " => " + Trim( ProcName( n ) ) + ;
                           "(" + NTRIM( ProcLine( n ) ) + ")" )
             cErrorLog += ATail( aStack ) + CRLF
          endif
          n++
    end

   cErrorLog += CRLF + "System" + CRLF
   cErrorLog += "======" + CRLF

   #ifdef __CLIPPER__
      cErrorLog += "   CPU type: " + GetCPU() + CRLF
   #else
      cErrorLog += "   CPU type: " + GetCPU() + " " + ;
                   AllTrim( Str( GetCPUSpeed() ) ) + " Mhz" + CRLF
   #endif

   cErrorLog += "   Hardware memory: " + ;
                cValToChar( Int( nExtMem() / ( 1024 * 1024 ) ) + 1 ) + ;
                " megs" + CRLF + CRLF

   cErrorLog += "   Free System resources: " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) + " %" + CRLF + ;
                "        GDI    resources: " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) + " %" + CRLF + ;
                "        User   resources: " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) + " %" + CRLF + CRLF

   cErrorLog += "   Compiler version: " + Version() + CRLF

   #ifdef __CLIPPER__
      cErrorLog += "   Windows and MsDos versions: " + ;
                   AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
                   AllTrim( Str( aVersions[ 2 ] ) ) + ", " + ;
                   AllTrim( Str( aVersions[ 3 ] ) ) + "." + ;
                   AllTrim( Str( aVersions[ 4 ] ) ) + CRLF + CRLF
   #else
      cErrorLog += "   Windows version: " + ;
                   AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
                   AllTrim( Str( aVersions[ 2 ] ) ) + ", Build " + ;
                   AllTrim( Str( aVersions[ 3 ] ) ) + ;
                   " " + aVersions[ 5 ] + CRLF + CRLF
   #endif

   aTasks = GetTasks()
   cErrorLog += "   Windows total applications running: " + ;
                AllTrim( Str( Len( aTasks ) ) ) + CRLF
   for n = 1 to Len( aTasks )
      cErrorLog += "    " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
   next

   // Warning!!! Keep here this code !!! Or we will be consuming GDI as
   // we don't generate the error but we were generating the bitmap

   hLogo = FWBitMap()

   if e:canRetry
      nButtons++
   endif

   if e:canDefault
      nButtons++
   endif

   cErrorLog += CRLF + "Variables in use" + CRLF + "================" + CRLF
   cErrorLog += "   Procedure     Type   Value" + CRLF
   cErrorLog += "   ==========================" + CRLF

   n := 2    // we don't disscard any info again !
   while ( n < 74 )

       if ! Empty( ProcName( n ) )
          cErrorLog += "   " + Trim( ProcName( n ) ) + CRLF
          for j = 1 to ParamCount( n )
             cErrorLog += "     Param " + Str( j, 3 ) + ":    " + ;
                          ValType( GetParam( n, j ) ) + ;
                          "    " + cGetInfo( GetParam( n, j ) ) + CRLF
          next
          for j = 1 to LocalCount( n )
             cErrorLog += "     Local " + Str( j, 3 ) + ":    " + ;
                          ValType( GetLocal( n, j ) ) + ;
                          "    " + cGetInfo( GetLocal( n, j ) ) + CRLF
          next
       endif

       n++
   end

   cErrorLog += CRLF + "Linked RDDs" + CRLF + "===========" + CRLF
   aRDDs = RddList( 1 )
   for n = 1 to Len( aRDDs )
      cErrorLog += "   " + aRDDs[ n ] + CRLF
   next

   cErrorLog += CRLF + "DataBases in use" + CRLF + "================" + CRLF
   for n = 1 to 255
      if ! Empty( Alias( n ) )
         cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n,"=> ", "   " ) + ;
                      PadR( Alias( n ), 15 ) + Space( 20 ) + "RddName: " + ;
                      ( Alias( n ) )->( RddName() ) + CRLF
         cErrorLog += "     ==============================" + CRLF
         cErrorLog += "     RecNo    RecCount    BOF   EOF" + CRLF
         cErrorLog += "    " + Transform( ( Alias( n ) )->( RecNo() ), "9999999" ) + ;
                      "      " + Transform( ( Alias( n ) )->( RecCount() ), "9999999" ) + ;
                      "      " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
                      "   " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF

         if ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
            cErrorLog += "     Indexes in use " + Space( 23 ) + "TagName" + CRLF
            for j = 1 to 15
               if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
                  cErrorLog += Space( 8 ) + ;
                               If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", "   " ) + ;
                               PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
                               ( Alias( n ) )->( OrdName( j ) ) + ;
                               CRLF
               endif
            next
            cErrorLog += CRLF + "     Relations in use" + CRLF
            for j = 1 to 8
               if ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
                  cErrorLog += Space( 8 ) + Str( j ) + ": " + ;
                               "TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
                               " INTO " + Alias( nTarget ) + CRLF
                  // uValue = ( Alias( n ) )->( DbRelation( j ) )
                  // cErrorLog += cValToChar( &( uValue ) ) + CRLF
               endif
            next
         endif
      endif
   next

   n = 1
   cErrorLog += CRLF + "Classes in use:" + CRLF
   cErrorLog += "===============" + CRLF

   #ifndef __XHARBOUR__
      while ! Empty( __ClassName( n ) )
         cErrorLog += "   " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
      end
   #else
      while n <= __ClsCntClasses()
         cErrorLog += "   " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
      end
   #endif

   cErrorLog += CRLF + "Memory Analysis" + CRLF
   cErrorLog +=        "===============" + CRLF

   #ifdef __CLIPPER__
      cErrorLog += "   Static memory:" + CRLF
      cErrorLog += "      data segment: 64k" + CRLF
   #endif

   #ifdef __CLIPPER__
   cErrorLog += "      Initial size:       " + ;
                LTrim( Str( nInitDSSize() ) ) + ;
                " bytes  (SYMP=" + LTrim( Str( nSymPSize() ) ) + ;
                ", Stack=" + LTrim( Str( nStackSize() ) ) + ;
                ", Heap=" + LTrim( Str( nHeapSize() ) ) + ")" + CRLF
   cErrorLog += "      PRG Stack:          " + ;
                LTrim( Str( 65535 - ( nStatics() * 14 ) - nInitDSSize() ) ) + ;
                " bytes" + CRLF
   #endif

   #ifdef __CLIPPER__
      cErrorLog += "      " + LTrim( Str( nStatics() ) ) + " Static variables: " + ;
                   LTrim( Str( nStatics() * 14 ) ) + " bytes" + CRLF + CRLF
   #else
      cErrorLog += "      " + LTrim( Str( nStatics() ) ) + " Static variables" + ;
                   CRLF + CRLF
   #endif

   cErrorLog += "   Dynamic memory consume:" + CRLF
   cErrorLog += "      Actual  Value: " + Str( MemUsed() ) + " bytes" + CRLF
   cErrorLog += "      Highest Value: " + Str( MemMax() ) + " bytes" + CRLF
   // nSymNames() no longer returns a real value! 15/April/97
   /*
   cErrorLog += "   SYMBOLS segment" + CRLF
   cErrorLog += "      " + LTrim( Str( nSymNames() ) ) + " SymbolNames:   " + ;
                LTrim( Str( nSymNames() * 16 ) ) + " bytes"
   */

   // Generates a file with an Error Log

   BEGIN SEQUENCE
      oOldError = ErrorBlock( { || DoBreak() } )
      MemoWrit( "Error.log", cErrorLog )
   END SEQUENCE
   ErrorBlock( oOldError )

   DEFINE DIALOG oDlg ;
      SIZE 300, 200 + If( lIsWinNT, 50, 0 ) ;
      TITLE DLG_TITLE

   @ 0, 0 SAY oSay PROMPT OemToAnsi( cMessage ) ;
      CENTERED OF oDlg FONT oFont SIZE 149, 20

   oSay:nStyle   = nOR( oSay:nStyle, 128 )   // SS_NOPREFIX
   oSay:nTop     =   3
   oSay:nLeft    =  22
   oSay:nBottom  =  25
   oSay:nRight   = 148

   @ 24,   6 SAY "&Stack List" OF oDlg FONT oFont PIXEL

   n = aStack[ 1 ]

   @ 33, 3 LISTBOX oLbx VAR n ITEMS aStack OF oDlg ;
      SIZE 145, 60 + If( lIsWinNT, 18, 0 ) PIXEL

   if nButtons == 1 .or. nButtons == 3
      @ 88 + If( lIsWinNT, 24, 0 ), 60 BUTTON "&Quit" OF oDlg ACTION oDlg:End() ;
         SIZE 30, 11 PIXEL FONT oFont DEFAULT
   else
      @ 88 + If( lIsWinNT, 24, 0 ), 37 BUTTON "&Quit" OF oDlg ACTION oDlg:End() ;
         SIZE 30, 11 PIXEL FONT oFont
   endif

   if e:CanRetry
      @ 88 + If( lIsWinNT, 24, 0 ), If( nButtons == 2, 82, 13 ) BUTTON "&Retry" ;
         OF oDlg ACTION ( lRet  := .t., oDlg:End() ) ;
         SIZE 30, 11 FONT oFont PIXEL
   endif

   if e:CanDefault
      @ 88 + If( lIsWinNT, 24, 0 ), 108 BUTTON "&Default"  OF oDlg ;
         ACTION ( lRet  := .f., oDlg:End() ) ;
         SIZE 30, 11 FONT oFont PIXEL
   endif

   @ 21, 100 BUTTON "See Error.log file" OF oDlg FONT oFont PIXEL ;
      SIZE 47, 10 ;
      ACTION WinExec( "Notepad.exe error.log" )

   ACTIVATE DIALOG oDlg CENTERED ;
      ON PAINT DrawBitmap( hDC, hLogo, 6, 6 )

   DeleteObject( hLogo )

   if lRet == nil .or. ( !LWRunning() .and. lRet )
      SET RESOURCES TO
      ErrorLevel( 1 )
      // Add these lines if using MDI child windows with dialogboxes
      // for n = 1 to Len( GetAllWin() )
      //    if ValType( GetAllWin()[ n ] ) == "O"
      //       GetAllWin()[ n ]:UnLink()
      //    endif
      // next
      QUIT              // must be QUIT !!!
   endif

return lRet

//--------------------------------------------------------------------------//
/*
STATIC FUNCTION  ErrorMessage(e)

     LOCAL cMessage := if(empty(e:osCode)                   ,;
                          if(e:severity > ES_WARNING        ,;
                             "ERROR "                       ,;
                             "ATENCION ")        ,;
                          "(DOS ERROR "+NTRIM(e:osCode)+") " )

     cMessage += if(ValType( e:subsystem ) == "C",;
                    e:subsystem()                ,;
                    "???" )

     cMessage += if(ValType( e:subCode ) == "N",;
                    "/" + NTRIM( e:subCode )   ,;
                    "/???" )

     IF ( ValType(e:description) == "C" )
          cMessage += "  " + e:description
     ENDIF

     cMessage += if(!Empty( e:filename ),;
                    ": " + e:filename   ,;
                    if(!Empty( e:operation ),;
                       ": " + e:operation   ,;
                       "" ) )

RETURN cMessage

//----------------------------------------------------------------------------//

STATIC FUNCTION cGetInfo( uVal )

     LOCAL cType := ValType( uVal )

     DO CASE
     CASE cType == "C"
          RETU '"' + cValToChar( uVal ) + '"'

     CASE cType == "O"
          RETU "Class: " + uVal:ClassName()

     CASE cType == "A"
          RETU "Lon: " + Str( Len( uVal ), 4 )

     OTHERWISE
          RETU cValToChar( uVal )
     ENDCASE

RETURN nil

FUNCTION ChkError(e, cFile)

     IF Valtype(e) != "O"

          e := ErrorNew()
          e:Description := "CORRUPCION DETECTADA EN AUTO-APERTURA DEL INDICE"
          e:osCode      := 1012
          e:severity    := ES_ERROR
          e:filename    := cFile

     ENDIF

RETURN e
*/
FUNCTION ErrorHandler(e,lLocalError)

     LOCAL xRet

     IF e:genCode == EG_OPEN .AND. ;
        e:osCode  == 32      .AND. ;
        e:canDefault
          NetErr(.T.)
          RETU .F.
     END

     IF lLocalError
          BREAK e
        ENDIF

RETURN NIL

static func ErrorMessage( e )

        // start error message
    local cMessage := if( empty( e:OsCode ), ;
                          if( e:severity > ES_WARNING, "Error ", "Warning " ),;
                          "(DOS Error " + NTRIM(e:osCode) + ") " )

        // add subsystem name if available
    cMessage += if( ValType( e:SubSystem ) == "C",;
                    e:SubSystem()                ,;
                    "???" )

        // add subsystem's error code if available
    cMessage += if( ValType( e:SubCode ) == "N",;
                    "/" + NTRIM( e:SubCode )   ,;
                    "/???" )
        // add error description if available
  if ( ValType( e:Description ) == "C" )
        cMessage += "  " + e:Description
        end

        // add either filename or operation
    cMessage += if( ! Empty( e:FileName ),;
                    ": " + e:FileName   ,;
                    if( !Empty( e:Operation ),;
                        ": " + e:Operation   ,;
                        "" ) )
return cMessage

//----------------------------------------------------------------------------//
// returns extended info for a certain variable type

static function cGetInfo( uVal )

   local cType := ValType( uVal )

   do case
      case cType == "C"
           return '"' + cValToChar( uVal ) + '"'

      case cType == "O"
           return "Class: " + uVal:ClassName()

      case cType == "A"
           return "Len: " + Str( Len( uVal ), 4 )

      otherwise
           return cValToChar( uVal )
   endcase

return nil

//----------------------------------------------------------------------------//

#define  HKEY_LOCAL_MACHINE  2147483650  // 0x80000002

function GetCPU()

   local oReg := TReg32():New( HKEY_LOCAL_MACHINE,;
                               "HARDWARE\DESCRIPTION\System\CentralProcessor\0",;
                               .f. )
   local cCpu := oReg:Get( "ProcessorNameString" )

   oReg:Close()

return cCpu

//----------------------------------------------------------------------------//

#ifdef __HARBOUR__
   #ifndef __XHARBOUR__
      REQUEST HB_GT_GUI
      procedure HB_GTSYS() ; return
      procedure HB_GT_GUI_DEFAULT() ; return
      procedure FW_GT ; return
   #endif
#endif

//----------------------------------------------------------------------------//
FUNCTION AbrirIdx(xIdx)

     LOCAL oGenError
     LOCAL bNewError, bOldError
     LOCAL aIdxFiles
     LOCAL cIdxFile
     LOCAL nFor
     LOCAL lOk

     bNewError := {|oError| ErrorHandler(oError,.T.) }
     bOldError := Errorblock(bNewError)
     //aOpened   := {}
     lOk       := .T.

     IF Valtype(xIdx) == "A"
          aIdxFiles := xIdx
     ELSE
          aIdxFiles := {}
          Aadd(aIdxFiles,xIdx)
     ENDIF

     BEGIN SEQUENCE

     FOR nFor := 1 TO len(aIdxFiles)
         cIdxFile := aIdxFiles[nFor]
         IF File(cIdxFile)
            OrdListAdd(cIdxFile)
         ELSE
            lOk := .F.
         ENDIF
     NEXT
     OrdSetFocus(0)
     RECOVER USING oGenError
          lOk := .F.
          IF oGenError != NIL
*               oGenError := ChkError(oGenError, cIdxFile)
               MsgStop("ERROR EN LA APERTURA DE INDICES+CRLF+IMPOSIBLE CONTINUAR","ERROR FATAL")
          ENDIF
     END SEQUENCE
     Errorblock(bOldError)
RETURN lOk

FUNCTION Indexacdx( cFile , cIndex , aInd , lEspera )
   LOCAL oDlg
   LOCAL oMeter , lSalida:=.T. , oBtn , oFont
   LOCAL cAlias
   LOCAL nActual
   DEFAULT lEspera:=.F.
   cAlias := OpenDbf( cFile , 1 , .F. , .F. , lEspera )    // Exclusivo
   IF EMPTY(cAlias)
      MsgStop("NO FUE POSIBLE ABRIR EL ARCHIVO "+cFileName(cFile),"AVISO DEL SISTEMA")
      RETURN( NIL )
   ENDIF

   DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0,-10  // definimos fuente tipo Windows 95
   DEFINE DIALOG oDlg RESOURCE "DLG_INDEX" FONT oFont TITLE "CREACION DE INDICES PARA "+cFileName(cFile)

   REDEFINE METER oMeter Var nActual  ID 116 OF oDlg NOPERCENTAGE UPDATE
   REDEFINE BUTTON oBtn ID 1 OF oDlg UPDATE;
           ACTION ( lSalida:=.F. ,Indexar( oMeter , cAlias , cIndex , aInd ), lSalida:=.T. , oDlg:End() )
   ACTIVATE DIALOG oDlg VALID ( IIF(lSalida==.T., lSalida ,Eval({|| MsgInfo("SE ESTA GENERANDO UN INDICE","AVISO DEL SISTEMA"),.F.}))) CENTERED

   (cAlias)->(DBCLOSEAREA())
RETURN ( NIL )

FUNCTION Indexar( oMeter , cAlias , cIndex , aIndices )
LOCAL i,nTotal,nContador
*cAlias := OpenDbf( cFile , 1 , .F. , .F. , .T. )    // Exclusivo
*IF EMPTY(cAlias)
*   MsgStop("NO FUE GENERAR EL INDICE","ERROR AL GENERAR INDICES")
*   RETURN
*ENDIF
IF FILE( cIndex )
   ERASE( cIndex )
ENDIF
oMeter:nTotal := (cAlias)->(LASTREC())*LEN( aIndices )
nContador := 1
FOR i := 1 TO  LEN( aIndices )
    INDEX ON &(aIndices[i,1]) TAG (aIndices[i,2])  EVAL (oMeter:SET(nContador),nContador++,.T.)
NEXT
RETURN

static function DoBreak()

   BREAK

return nil

//-----------






[Antonio Linares]

Aqui funciona bien. Solo he tenido que cambiar esta línea:

hLogo = FWBitMap()

por

hLogo = FWLogoBitMap()

[Garbi]

Funciono Perfectamente.
Victor es el programador que me dejo usar este codigo, gracias a él también.

Muchas Gracias.