Derren,
I have a couple of procedures that might help you. I've been handling errors in Fox since my 2.x days with this. (And, admitedly, I remember getting *most* of this code from an old article by Pat Adams so, cudos to her!)
First, somewhere (and I have a "SET THE SET-UPS" routine) I make a call to this function:
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
PROCEDURE SETONERR
ON ERROR DO PRO2EROR WITH ERROR(), MESSAGE(), MESSAGE(1),;
SYS(16), LINENO(), SYS(102), SYS(100), SYS(101),;
LASTKEY(), ALIAS(), SYS(18), SYS(5), SYS(12), SYS(6),;
SYS(2003), WONTOP(), SYS(2011), SYS(2018)
This will provide LOTS of great information about the state of your machine. (More than you can imagine...)
Then the PRO2EROR routine looks like this:
(Granted, it's a bit RETRO, and could use a little fine-tuning, since I've moved on to VFP, but it's still efective in it's current form...
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
PROCEDURE PRO2EROR
PARAMETERS M.XERROR, M.XMSG, M.XCODE, M.XMODULE, M.XLINENO,;
M.XPRINTER, M.XCONSOLE, M.XDEVICE, M.XLASTKEY,;
M.XCURDBF, M.XGETFIELD, M.XDFLTDRIVE, M.XRUNMEM,;
M.XPRNDEVICE, M.XCURDIR, M.XTOPWIN, M.XLOCKED,;
M.XMISSING
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* This code bit is specifically if an ERROR occurs
* whilst in my ERROR routine. (This typically means,
* I'm going to force a shutdown now, 'cause all kinds
* of things are blowing up!
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
ON ERROR DO BADNEWS WITH ERROR(), MESSAGE(), MESSAGE(1),;
SYS(16), LINENO()
*
SET CONSOLE ON
SET PRINTER OFF
SET DEVICE TO SCREEN
*
CLEAR TYPEAHEAD
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Following error codes are ignored!
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
IF M.XERROR=104 .OR. M.XERROR=181 .OR. M.XERROR=182 .OR.;
M.XERROR=279.OR. M.XERROR=4 .OR. M.XERROR=1107 .OR.;
M.XERROR=1001 .OR. M.XERROR=125 .OR. M.XERROR=1705 .OR.;
M.XERROR=1420 .OR. M.XERROR=1108 .OR. M.XERROR=1423
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Ignore these errors and continue with program
* execution. They are not fatal errors.
*
* Error #104 occurs when ON KEY LABEL calls to function
* keys F11 and F12 are made on older keyboards which do
* not support these keys. It does not trap illegal
* SET FUNCTION x calls.
*
* Error #181, "MENU is already in use", occurs when an
* attempt is made to activate a MENU which has already
* been activated.
*
* Error #182, "POPUP is already in use", occurs when an
* attempt is made to activate a POPUP which has already
* been activated.
*
* Error #279, "Prompts for this popup have already been
* defined" occurs when an attempt is made to use the BAR
* option to define contents of a POPUP already defined
* with PROMPT.
*
* Error #4 = "End of file encountered"
*
* Error #1107 = "Structural CDX file reference removed"
*
* Error #1001 = "Feature not available" In some
* instances the single-user version of FoxPro 2.0 may
* return this error when multi-user commands are utilized.
*
* =========================================================
* ¯o substitution is utilized since EVALUATE() does
* not work with SET commands
* =========================================================
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
SET CONSOLE &XCONSOLE
SET PRINTER &XPRINTER
SET DEVICE TO &XDEVICE
*
DO SETONERR
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* The following cases are errors that we need a message
* to return to the user, but allow them to continue in
* the system without error. It will advise them that
* the process they are trying to run will not work at
* the present time, and requires some action, but
* otherwise does not warrent a full out "Crash" of
* their current processes.
*
* Error #125 = "Printer off Line"
*
* Error #1705 = "Exclusive table use, when table is
* already open". This is required in multi-user
* evnironments, and we don't want an acutal error to
* spawn as a result.
*
* Error #1420 = "Invalid or corrupt OLE object"
* Amazingly, I have found that simply ignoring this
* error yeields no OLE corruption, and everything
* processes as normal.
*
* Error #1423 = "Error creating OLE object". Going to
* try the same approach with this as #1420.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
DO CASE
CASE M.XERROR=125
MESSAGEBOX('A printer could not be found on line! '+;
'Please verify that the printer is on, is on line'+;
', or has been selected from a Network.')
IF RDLEVEL() > 1
RELEASE WINDOW &XTOPWIN
ENDIF
*
RETURN TO &XMODULE
CASE M.XERROR=1705
MESSAGEBOX('You have attempted to run a process that '+;
'requires the use of a Table that is currently in '+;
'use by another user, or you are trying to use '+;
'exclusively while in use by another. Please '+;
'check with other users, or try your process '+;
'again later.')
IF RDLEVEL() > 1
RELEASE WINDOW &XTOPWIN
ENDIF
*
RETURN TO &XMODULE
CASE M.XERROR=1108
RETURN
CASE M.XERROR=1420
RETURN
CASE M.XERROR=1423
RETURN
ENDCASE
*
RELEASE ALL
RETURN
ENDIF
*
ACTIVATE SCREEN
? CHR(7)
*
DEFINE WINDOW SYSERRWIND;
FROM 8,5 TO 20,75 IN SCREEN;
TITLE 'APPLICATION ERROR INTERRUPT';
FOOTER 'Retry, Cancel, Quit to OS';
DOUBLE FLOAT NOGROW SHADOW;
COLOR SCHEME glCLRALRT
MOVE WINDOW SYSERRWIND CENTER
ACTIVATE WINDOW SYSERRWIND
*
@ 0,2 SAY 'Error No:'
@ 0,14 SAY M.XERROR PICTURE '#,###'
@ 1,2 SAY 'Error Msg:'
@ 1,14 SAY M.XMSG
@ 2,2 SAY 'Prog Code:'
@ 2,14 SAY LEFT(M.XCODE,50)
@ 3,2 SAY 'Program:'
@ 3,14 SAY M.XMODULE
@ 4,2 SAY 'Line No:'
@ 4,14 SAY M.XLINENO PICTURE '##,###'
@ 5,2 SAY 'Data File:'
@ 5,14 SAY M.XCURDBF
@ 6,2 SAY 'Data Field:'
@ 6,14 SAY M.XGETFIELD
*
DO CASE
CASE RDLEVEL() > 5
DO CASE
CASE _DOS
M.NEWBUTTON = '<R>etry, <C>ancel, or <O>S?'
CASE _WINDOWS
M.NEWBUTTON = '<R>etry, <C>ancel, or <O>S?'
CASE _MAC
M.NEWBUTTON = '<R>etry, <C>ancel, or <O>S?'
ENDCASE
*
@ 8,10 SAY M.NEWBUTTON COLOR SCHEME M.CLRDLG
*
DO WHILE .T.
M.RVALUE = INKEY(0,'HM')
M.BUTTONOPT = UPPER(CHR((M.RVALUE)))
IF M.BUTTONOPT $ 'RFDW'
EXIT
ENDIF
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Windows required putting decimal range for row values!!
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
IF M.RVALUE = 151
DO CASE
CASE BETWEEN(MROW(),8,8.99) AND BETWEEN(MCOL(),10,18)
M.BUTTONOPT = 'R'
EXIT
CASE BETWEEN(MROW(),8,8.99) AND BETWEEN(MCOL(),19,27)
M.BUTTONOPT = 'C'
EXIT
CASE BETWEEN(MROW(),8,8.99) AND BETWEEN(MCOL(),32,40)
M.BUTTONOPT = 'O'
EXIT
ENDCASE
ENDIF
ENDDO
*
OTHERWISE
DO CASE
CASE _DOS
M.NEWBUTTON = '\<OS'
CASE _WINDOWS
M.NEWBUTTON = '\<OS'
CASE _MAC
M.NEWBUTTON = '\<OS'
ENDCASE
M.OPSYS = M.NEWBUTTON
@ 8,10 GET M.NEWBUTTON FUNCTION '*TH \!\<Retry;\<Cancel;\<Quit' ;
SIZE 2,10,4 FONT 'Times New Roman',9
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Yes, I know I need to replace this part of the code
* with something more "VFP!" just haven't had time to
* get to it yet...
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
READ CYCLE OBJECT 3 MODAL
*
DO CASE
CASE M.NEWBUTTON = 'Retry'
M.BUTTONOPT = 'R'
CASE M.NEWBUTTON = 'Cancel'
M.BUTTONOPT = 'C'
CASE M.NEWBUTTON = 'Quit'
M.BUTTONOPT = 'Q'
OTHERWISE
M.BUTTONOPT = 'Q'
ENDCASE
*
ENDCASE
*
RELEASE WINDOW SYSERRWIND
*
IF M.BUTTONOPT = 'R' && Retry
SET CONSOLE &XCONSOLE
SET PRINTER &XPRINTER
SET DEVICE TO &XDEVICE
DO SETONERR
RELEASE ALL
RETRY
ENDIF
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* List current status to disk files for save to
* PRO2EROR.DBF.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
DO SAVERROR
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Return to FOXPRO.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
DO CASE
CASE M.BUTTONOPT = 'C' && FoxPro
M.glQUITOPT = 'FOX'
* Return to DOS/Windows
CASE M.BUTTONOPT = 'O' OR M.BUTTONOPT = 'W' OR;
M.BUTTONOPT = 'M' && DOS/Windows
M.glQUITOPT = 'DOS'
OTHERWISE
M.glQUITOPT = 'DOS'
ENDCASE
*
glQUITAPP = .T. && My Global "QuitMe" value
*
CLEAR EVENTS
*
RETURN TO MASTER
And, lastly, SAVEROR looks like this:
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
PROCEDURE SAVERROR
*
SET CONSOLE ON
*
WAIT 'Saving to Error File, Please Wait' WINDOW TIMEOUT 1
* Hesitate a second, so they know what's happening!
SET CONSOLE OFF
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Create files which hold information from LIST STATUS
* and LIST MEMORY prior to closing files, etc.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
STORE SYS(3) + ".TXT" TO M.LSTEXT && unique file name
LIST STATUS TO (M.LSTEXT)
STORE SYS(3) + ".TXT" TO M.LMTEXT
LIST MEMORY TO (M.LMTEXT)
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Store info to error file.
*
* M.glUSERID alwasy available as a memvar, though
* security may not be implemented at the time of the
* error to use it. If so, it is empty. Assume that the
* current default home dir is still correct. If not,
* whoops.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
USE DBFS\PRO2EROR
APPEND BLANK
=LOCK()
REPLACE DDATE WITH DATE(),;
TTIME WITH TIME(),;
XERROR WITH M.XERROR,;
XMSG WITH M.XMSG,;
USERID WITH M.glUSERID
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Put info from the files created with LIST MEMORY and
* LIST STATUS into the memo field and then erase the
* text files.
* NOTE: all the X... memvars will be here!
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * *
APPEND MEMO notes FROM (M.LSTEXT)
APPEND MEMO notes FROM (M.LMTEXT)
*
USE && Close PRO2EROR
*
* Clean up tmp text files.
ERASE (M.LSTEXT)
ERASE (M.LMTEXT)
*
SET CONSOLE ON
RELEASE WINDOW MOMENT
*
RELEASE M.LSTEXT, M.LMTEXT
Now, make a FREE table, called PRO2EROR (or some other name, but you'll have to change it in the code too...) with the following fields:
FieldName Type Size
DDATE Date n/a
TTIME Character 8
XERROR Character 80
XMSG Character 80
USERID Character 15
NOTES Memo n/a
USERID is a specific field I have in my USER Table, and also is noted as a public variable with the value glUSERID. You may want to change or remove this item. I like it, because it tells me "WHO" caused the error, and makes it easier for me to talk to them about what occured. (They can't claim, "It wasn't me!!!!"
;-)
Sorry this is so long, and for the bad indentation (long code is hard in a forum), and the lengthy post, and for the "OLDness" of this actual code, but I thought you might find some value in it.
(Funny that I have not looked at it in SUCH a long time...) There are a few "Bugs" in the process, but you will have no problem working them out. I've been ignoring them lately, because it still caputers all the stuff I want, and makes debuging after a crash easier. It also illustrates how to "Ignore" errors that you never even want to prompt your user about, and how to deal with those that you want some intervention, and how to let them "Recover" from them.
Best Regards,
Scott
Please let me know if this has helped
![[hammer]](/data/assets/smilies/hammer.gif "[hammer] [hammer]")
