I create own errorsys procedure which may prevent for use open database or generally for terminate sleeping program process (in pocket memory in some situation exists only program process without any window and database may still open). When error handler is call program show error: "Too many recursive error handler calls". How to fix this ?
Thanks for reply
Pawel
Sample code:
Code: Select all
#Include 'FwCe.Ch'
Function TestErr ()
Local oWnd := Nil
AppIni ()
Define Window oWnd Title 'Test error'
@ 100, 100 Button 'Open1' Size 60, 20 Pixel Action OpenTest ()
@ 130, 100 Button 'Open2' Size 60, 20 Pixel Action OpenTest ()
Activate Window oWnd
DbCloseAll ()
Return .T.
Function OpenTest ()
Local aStr := {}
If !File ('TESTERR.DBF')
AAdd (aStr, {'F1', 'C', 10, 0})
DbCreate ('TESTERR', aStr)
Use TestErr New
Else
Use TestErr New
Endif
MsgInfo ('Database in use')
Return .T.
// 2006-03-18 14:24:03
Function ErrorSys ()
ErrorBlock ({|o| ShowError (o)})
Return .T.
// 2006-03-18 14:24:03
Static Function ShowError (oError)
Local cError := ''
Local n := 2
Local nHn := 0
If oError : GenCode == EG_OPEN // this generates error "Too many recursive error handler calls"
MsgInfo ('Program process is still running !', PROGNAME)
DbCloseAll ()
// ProgramTask () // procedure to kill program process
PostQuitMessage (0)
Quit
Endif
cError := oError : Description
If !Empty (oError : Operation)
cError += Hb_OsNewLine () + oError : Operation
Endif
cError += Hb_OsNewLine () + 'Call history:' + Hb_OsNewLine ()
Do While !Empty (ProcName (n))
cError += AllTrim (ProcName (n)) + ' (' + AllTrim (Str (ProcLine (n))) + ')' + Hb_OsNewLine ()
n ++
Enddo
If !File ('Error.Txt')
nHn := FCreate ('Error.Txt')
Else
nHn := FOpen ('Error.Txt', 2)
FSeek (nHn, 0, 2)
Endif
FWrite (nHn, DToC (Date ()) + ' ' + Time () + Hb_OsNewLine ())
FWrite (nHn, cError)
FWrite (nHn, Replicate ('-', 40) + Hb_OsNewLine ())
FClose (nHn)
MsgInfo (cError, 'Program error')
DbCloseAll ()
// ProgramTask () // procedure to kill program process
PostQuitMessage (0)
Quit
Return .T.
// system defaults
Function AppIni ()
Request DbfCdx
Request DbfFpt
RddSetDefault ('DbfCdx')
Request Hb_Lang_PL852
Request Hb_Lang_PLWIN
Request Hb_CodePage_PL852
Request Hb_CodePage_PLWIN
Set Century On
Set Epoch To 2000
Set Date German
Set Deleted On
Hb_LangSelect ('PL')
Hb_SetCodePage ('PLWIN')
Return .T.
