topic-4741

Posts: 126

Joined: Thu Oct 06, 2005 10:18 PM

Errorsys redefinition
Posted: Mon Oct 30, 2006 05:17 AM

Antonio,

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 Collapse

#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.

Enrico Maria Giordano

Posts: 9020