Anyone have a modified errorsys.prg they're willing to share?

[pilgrim211]

Need something that would show work areas open, indices open, current recno on each dbf etc etc. when system hangs(ie. dbfntx1210)
If willing to share pls let me know.

Unfortunately I have not been able to find much documentation on how to do.
Thanx Thanx

 

[Indio]

You can use this Errorsys.prg
You can replace the spanish & italian comments included on it with your own.



/***
* Errorsys.prg
* Standard Clipper error handler
* Copyright (c) 1990-1993, Computer Associates International, Inc.
* All rights reserved.
* Compile: /m /n /w
*/

#include "error.ch"
#include "setcurs.ch"
#include "set.ch"
#include "Fileio.Ch"

// put messages to STDERR
#command ? <list,...> => ?? Chr(13) + Chr(10) ; ?? <list>
#command ?? <list,...> => OutErr(<list>)

// used below
#define NTRIM (LTrim(Str))
#define VERO .T.
#define FALSO .F.



/***
* DefError()
*/
static func DefError(e)
local i, cMessage, aOptions, nChoice
LogError(e)
// 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. esCode == 32 .and. e:canDefault)
NetErr(.t.)
return (.f.) // NOTE
end


// for lock error during APPEND BLANK, set NETERR() and subsystem default
if (e:genCode == EG_APPENDLOCK .and. e:canDefault)

NetErr(.t.)
return (.f.) // NOTE

end



// build error message
cMessage := ErrorMessage(e)


// build options array
// aOptions := {&quot;Break&quot;, &quot;Quit&quot;}
aOptions := {&quot;Quit&quot;}

if (e:canRetry)
AAdd(aOptions, &quot;Retry&quot
end

if (e:canDefault)
AAdd(aOptions, &quot;Default&quot
end


// put up alert box
nChoice := 0
do while (nChoice == 0)
if (Empty(esCode))
nChoice := Alert(cMessage, aOptions)
else
nChoice := Alert(cMessage +&quot;;(DOS Error &quot; + NTRIM(esCode) + &quot&quot;,aOptions)
endif
if (nChoice == NIL)
exit
endif
enddo

if (!Empty(nChoice))
// do as instructed
if (aOptions[nChoice] == &quot;Break&quot
Break(e)
elseif (aOptions[nChoice] == &quot;Retry&quot
return (.t.)
elseif (aOptions[nChoice] == &quot;Default&quot
return (.f.)
endif
endif

// display message and traceback
if (!Empty(esCode))
cMessage += &quot; (DOS Error &quot; + NTRIM(esCode) + &quot &quot;
end

? cMessage
i := 2
while (!Empty(ProcName(i)))
? &quot;Called from&quot;, Trim(ProcName(i)) + &quot;(&quot; + NTRIM(ProcLine(i)) + &quot &quot;
i++
enddo

// give up
ErrorLevel(1)
QUIT
return (.f.)

*--------------------------
static func ErrorMessage(e)
local cMessage
cMessage := if(e:severity > ES_WARNING, &quot;Error &quot;, &quot;Warning &quot
if (ValType(e:subsystem) == &quot;C&quot // add subsystem name if available
cMessage += e:subsystem()
else
cMessage += &quot;???&quot;
endif

if (ValType(e:subCode) == &quot;N&quot // add subsystem's error code if available
cMessage += (&quot;/&quot; + NTRIM(e:subCode))
else
cMessage += &quot;/???&quot;
endif

if (ValType(e:description) == &quot;C&quot // add error description if available
cMessage += (&quot; &quot; + e:description)
endif

// add either filename or operation
if (!Empty(e:filename))
cMessage += (&quot;: &quot; + e:filename)
elseif (!Empty(eperation))
cMessage += (&quot;: &quot; + eperation)
endif
return (cMessage)

*+++++++++++++++++++++++++++++
* OBJETO Err - Objeto clase ERROR pasado por CLIPPER

STATIC FUNCTION LogError(Err)
LOCAL screen := SAVESCREEN(0,0,MAXROW(), MAXCOL())
LOCAL LogFile := GETENV(&quot;LOG_FILE&quot
LOCAL errat := SELECT()
LOCAL vname, vtype, vrec, memcount, scount, memhandle, fhandle, x
LOCAL memlength, count, vars, bytes, memwidth, ttemp, atemp, i
LOCAL start, j, range, outstring, substring

// Set default File log
IF EMPTY(LogFile)
LogFile='ERRORLOG'
ENDIF

// Error division por zero, por default devuelve 0
IF (Err:genCode == EG_ZERODIV)
RETURN(0)
ENDIF

// Error de OPEN en la red, set NETERR() y el subsistema di default
IF (Err:genCode == EG_OPEN .AND. ErrsCode == 32 .AND. Err:canDefault)
NetErr(VERO)
RETURN(FALSO)
ENDIF

// Error de LOCK durante APPEND BLANK, set NETERR() y el subsistema por default
IF (Err:genCode == EG_APPENDLOCK .AND. Err:canDefault)
NetErr(VERO)
RETURN(FALSO)
ENDIF

// Error de Impresora NO EN LINEA
IF (Err:subsystem == &quot;TERM&quot
ALERT(&quot;La Impresora no esta en linea&quot
RETURN(VERO)
ENDIF

IF .NOT. FILE(LogFile)
fhandle := FCREATE(LogFile, FC_NORMAL)
ELSE
fhandle := FOPEN(LogFile, FO_READWRITE + FO_EXCLUSIVE)
ENDIF

FSEEK(fhandle, 0, FS_END) // Colocar puntero al final del archivo

IF fhandle < 4 .AND. !EMPTY(FERROR()) // Imposible escribir en el LOGFILE
ALERT(&quot;Error : Se ha verificado un Error de sistema&quot
ELSE
// Memorizo el estado del programma en el LOGFILE
*ÍÍ Intestazione Error ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*
Fwriteline(fhandle, PADR(&quot;ÍÍÍ Inicio ErrorLog File&quot;, 79, &quot;Í&quot)
Fwriteline(fhandle, &quot;Error en funcion: &quot; + PROCNAME(4))
Fwriteline(fhandle, &quot;Fecha: &quot; + DTOC(DATE())+&quot; Hora: &quot; + TIME())
Fwriteline(fhandle, &quot;Mem. disponible: &quot; + Strvalue(MEMORY(0))+&quot;Kb&quot
Fwriteline(fhandle, &quot; Archivo actual: &quot; + Strvalue(SELECT()))

*ÍÍ Informacion generica del Error ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*
Fwriteline(fhandle, &quot;&quot
Fwriteline(fhandle, PADR(&quot;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Informacion especifica del Error &quot;, 79, &quot;¯&quot)
Fwriteline(fhandle, &quot;&quot
Fwriteline(fhandle, &quot; Subsistema: &quot; + Err:subsystem())
Fwriteline(fhandle, &quot; Codigo de Error: &quot; + Strvalue(Err:subcode()))
// Fwriteline(fhandle, &quot; Default Status: &quot; + Strvalue(Err:candefault))
Fwriteline(fhandle, &quot; Descripcion: &quot; + Err:description())
Fwriteline(fhandle, &quot; Operacion : &quot; + Errperation())
Fwriteline(fhandle, &quot; Codigo Error DOS: &quot; + Strvalue(Errscode()))

*ÍÍ Rastreo del procedimiento ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*
Fwriteline(fhandle, &quot;&quot
Fwriteline(fhandle, PADR(&quot;¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Seguimiento &quot;, 79, &quot;¯&quot)
Fwriteline(fhandle, &quot;&quot
i := 1
DO WHILE !EMPTY(PROCNAME(++i))
Fwriteline(fhandle, PADR(PROCNAME(i), 20) + &quot;: &quot; + PADR(PROCLINE(i), 20))
ENDDO
FWRITE(fhandle, CHR(13)+CHR(10))

*ÍÍ Informacion Area de Trabajo ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*
Fwriteline(fhandle, &quot;&quot
Fwriteline(fhandle, PADR(&quot;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Informacion del Area de Trabajo &quot;, 79, &quot;Ä&quot)
Fwriteline(fhandle, &quot;&quot
FOR x := 1 TO 250
SELECT(x)
IF !EMPTY(ALIAS())
Fwriteline(fhandle, &quot; Alias: &quot; + ALIAS())
Fwriteline(fhandle, &quot; Registro actual: &quot; + Strvalue(RECNO()))
Fwriteline(fhandle, &quot; Filtro activo: &quot; + DBFILTER())
Fwriteline(fhandle, &quot; Relacion activa: &quot; + DBRELATION())
Fwriteline(fhandle, &quot; Clave activa: &quot; + INDEXKEY(INDEXORD()))
Fwriteline(fhandle, &quot;&quot
ENDIF
NEXT

*ÍÍ Memoria disponible para variables ÍÍÍÍÍÍÍÍÍÍÍÍÍ*
Fwriteline(fhandle, PADC(&quot; Memoria disponible para variables&quot;, 80, &quot;+&quot)
Fwriteline(fhandle, &quot;&quot
SELECT(errat)
SAVE ALL LIKE * TO Errormem
memhandle := FOPEN(&quot;Errormem.mem&quot;, FO_READWRITE)
memlength := FSEEK(memhandle, 0, FS_END)
FSEEK(memhandle,0)
count := 1
bytes := vars := 0
DO WHILE FSEEK(memhandle, 0, FS_RELATIVE)+1 < memlength
memwidth := SPACE(18)
// Leer la Informacion de la variable
FREAD(memhandle, @memwidth, 18)
vname := LEFT(memwidth, AT(CHR(0), memwidth)-1)
vtype := SUBSTR(memwidth, 12, 1)
vrec := BIN2W(RIGHT(memwidth,2))
IF(vtype $ CHR(195)+CHR(204), memcount := 14+vrec, memcount := 22)
FSEEK(memhandle, memcount, FS_RELATIVE)
ttemp := LEFT(vname + SPACE(10), 10)
ttemp += &quot; TYPE &quot; + TYPE(vname)
ttemp += &quot; &quot; + IF(TYPE(vname) = &quot;C&quot;, [&quot;] + &vname + [&quot;], Strvalue(&vname))
IF TYPE(vname) = &quot;C&quot;
bytes += (atemp := LEN(&vname.))
ELSEIF TYPE(vname) = &quot;N&quot;
bytes += (atemp := 9)
ELSEIF TYPE(vname) = &quot;L&quot;
bytes += (atemp := 2)
ELSEIF TYPE(vname) = &quot;D&quot;
bytes += (atemp := 9)
ENDIF
FWRITE(fhandle, &quot; &quot; + TRANSFORM(atemp, &quot;9999999&quot + &quot;bytes -> &quot
Fwriteline(fhandle, &quot; &quot; + ttemp)
ENDDO
FCLOSE(memhandle)
FERASE(&quot;Errormem.mem&quot
FCLOSE(fhandle)

*ÍÍ Box de aviso al operador ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*
ALERT(&quot;ATENCION: Se a verificado un Error. ;&quot;+ ;
&quot; Se ruega comunicar el siguiente dato a la;&quot;+ ;
&quot; Asistencia Tecnica: ;&quot;+ ;
&quot; ;&quot;+ ;
&quot; SubSistema: &quot; + PADR(Err:subsystem(), 30)+';' + ;
&quot; Codigo de Error: &quot; + PADR(LTRIM(STR(Err:subcode())), 30)+';'+ ;
&quot; Descripcion: &quot; + PADR(Err:description(), 30)+';'+ ;
&quot; Operacion: &quot; + PADR(Errperation(), 30)+';'+ ;
&quot; Error DOS: &quot; + PADR(LTRIM(STR(Errscode())), 30)+';'+ ;
&quot; Nombre Programa: &quot; + PADR(PROCNAME(4), 30)+';'+ ;
&quot; Linea programa: &quot; + PADR(LTRIM(STR(PROCLINE(4))), 30))
ENDIF

// Salida forzada preparando el ambiente para el DOS
ERRORLEVEL(1)
DBCLOSEALL()
SETCURSOR(SC_NORMAL)
SET COLOR TO
SETBLINK(.T.)
CLS
QUIT
RETURN(FALSO)
*----------------
STATIC FUNCTION Strvalue(string, onoff)
LOCAL retval := &quot;&quot;
onoff := IF(onoff == NIL, FALSO, onoff)
DO CASE
CASE VALTYPE(string) = &quot;N&quot; ; retval := LTRIM(STR(string))
CASE VALTYPE(string) = &quot;M&quot;
retval := IF((LEN(string) > (MEMORY(0) * 1024) * .80), SUBSTR(string,1, INT(MEMORY(0)*1024*.80)),string)
CASE VALTYPE(string) = &quot;D&quot; ; retval := DTOC(string)
CASE VALTYPE(string) = &quot;L&quot;
retval := IF((onoff), IF(string, &quot;On&quot;, &quot;Off&quot, IF(string, &quot;Vero&quot;, &quot;Falso&quot)
ENDCASE
RETURN(retval)
*---------------
STATIC FUNCTION Fwriteline(handle, string)
FWRITE(handle, string + CHR(13)+CHR(10))
RETURN(NIL)
*-----------

 

[pilgrim211]

Thanks for including the modified errorsys.prg. Haven't had a chance to really get into it yet but after I do I'll give you some feedback on my success (Vero) of failure (Falso) Ha Ha