Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / DATABASE / PROERROR.ZIP / PROERROR.PRG < prev

Wrap

Text File | 1991-05-17 | 62.6 KB | 1,954 lines

*:********************************************************************* *: *: *: System: FOXPRO 1.x ERROR HANDLING SYSTEM *: Author: Pat Adams, DB Unlimited (718) 469-4032 *: Copyright (c) 1989, 1990, 1991 DB Unlimited *: Last modified: 5/17/91 * Revision Number 5.13 * * All Rights Reserved - PROERROR may be used in your own * applications and modified for use in your applications * with no fees, licenses or other approvals required. * It may *not* be used in articles, books, talks or other * presentations without specific prior approval nor may * PROERROR or modifications thereof be sold or otherwise * issued for monetary gain. * * Special thanks to Y. Alan Griver, Mike Fahey, Jeri * Rosenhaft, Guy Scharf, John Hoffman, Leo Tohill and others * too numerous to mention here for their help in alpha and beta * as well as design suggestions. *: *: Procs & Fncts: PROERROR *: : NOFILE *: : PROFATAL *: : RAZBERRY *: : A_LERT *: : FILEBUSY *: : REC_BUSY *: : INDEX_ER *: : READONLY *: : NOACCESS *: : NOCREATE *: : NO_OPEN *: : REALBAD1 *: : TRASHED *: : KORRUPT *: : READ_ERR *: : RITE_ERR *: : MIXUP *: : INVALPRN *: : BADCHAIN *: : NOSPACE *: : NOTREADY *: : LOWFILES *: : WORKSPAC *: : YES_NO *: *: Uses: PROERROR.DBF *: *:********************************************************************* *& Save error information to database or retry * * NOTE: This routine is specific to FoxPro. * * Information is stored to the PROERROR.DBF file and then * the user is returned to master calling program if a RETRY * is not issued. Please note that PROERROR closes all files * and indexes before issuing a RETURN TO MASTER. It is expected * that the MASTER level file will initialize all necessary global * memvars, open databases and indexes, etc. as required for a * particular system. * * Utilize the following command to set up this system to * respond to FoxPro errors: * * ON ERROR DO PROERROR WITH ERROR(), MESSAGE(), MESSAGE(1), ; * SYS(16), LINENO(), SYS(102), SYS(100), SYS(101), LASTKEY(), ; * DBF(), SYS(18) * * Parameters are: * * xerno = The numeric code of the number provided by ERROR() * xmsg = The error message provided by MESSAGE() * xkode = The contents of the line of code which * triggered the error as provided by MESSAGE(1) * xmodul = The name of the code module, SYS(16) * xline = The number of the line of code triggering the * error, LINENO() * xprint = Current PRINTER setting as per SYS(102) * xkonsol= Current CONSOLE setting as per SYS(100) * xdevice= Current DEVICE setting as per SYS(101) * keypress = LASTKEY() * curr_dbf = Selected .DBF when error occurred * getfield = Field of GET...READ at time error occurred * * In addition to this data, the routine saves the information from * DISPLAY MEMORY and DISPLAY STATUS is saved to the memo field. * * Note that if the .PRG file for a system is not available or the COMPILE * NODEBUG command has been utilized the contents of the line of code and the * line number of the line of code which triggered the error will not * be available. * * The INKEY(0, "M") permits user to click the left mouse key * in response to the "Press any key..." message. * * In release 5.11 the structure of the PROERROR.DBF file has * been modified slightly. The field previously named MODUL * has been changed to MMODUL. This avoid expansion of "modul" * by FoxDoc, SNAP! and other similar utilities used to parse * the source code. * * Release 5.12 introduced the YES_NO module to get user input, * and temporary disables the ON ERROR DO PROERROR WITH... * to avoid any recursive ON ERROR calls to PROERROR. The ON * ERROR DO PROERROR WITH... is reinitalized before leaving the * PROERROR routine. * * Version 5.12 also makes some changes to the 1705 error message. * It has been found that InvisibleNet erroneously returns error * 1705 when a file is in EXCLUSIVE use by another instead of the * expected error #3. (Novell correctly returns error #3) The * module called for the 1705 error now checks for this. * * Version 5.13 adds a specific check for error #91, "Module not * loaded" which occurs when attempting to RELEASE MODULE which * is not loaded. A specific trap for error #104, "Unknown Function Key" * has also been added so the error is simply ignored. * Version 5.13 also adds a memory variable, GETFIELD, to provide * information on the field currently being read, if applicable. *!********************************************************************* PROCEDURE proerror *********************************************************************** * *& Controlling module for the FoxPro error handling system. * * Author: Pat Adams, DB Unlimited (718) 469-4032 * Copyright 1989, 1990, 1991 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARA xerno, xmsg, xkode, xmodul, xline, xprint, ; xkonsol, xdevice, keypress, curr_dbf, getfield STORE .F. TO tryagain ON ERROR ?? CHR(7) IF xerno = 91 .OR. xerno = 168 .OR. xerno = 104 .OR. xerno = 214 * ======================================================= *$ This is a temporary work-around because some editions * of FoxPro return error # 168 (MENU has not been defined) * or error # 214 (WINDOW has not been defined) when attempting * to do housekeeping by RELEASE MENU/WINDOW which is not * currently defined. Fox has promised a fix for this at * a later date. * * Error #91, "Module was not loaded" is returned when * an attempt is made to RELEASE MODULE which has already * been released or was not loaded. * * Error #104 occurs when a call to function keys F11 or F12 * are made and an older keyboard without these keys is in use. * ======================================================= SET CONSOLE &xkonsol SET DEVICE TO &xdevice ON ERROR DO PROERROR WITH ERROR(), MESSAGE(), MESSAGE(1), ; SYS(16), LINENO(), SYS(102), SYS(100), SYS(101), LASTKEY(), ; DBF(), SYS(18) RETURN ENDIF xerno = 168 DO CASE xerno CASE xerno = 1 * ======================== *$ File does not exist * Pop up window to warn user. * ======================== ON KEY && Null out all hot keys DO nofile WITH xerno, xmsg, xkode, xmodul, xline * ====================== * Return to the master level * ====================== ON ERROR DO PROERROR WITH ERROR(), MESSAGE(), MESSAGE(1), ; SYS(16), LINENO(), SYS(102), SYS(100), SYS(101), LASTKEY(), ; DBF(), SYS(18) RETURN TO MASTER CASE xerno = 3 .OR. xerno = 108 * ================================= *$ File is in use by another. * Advise user & provide option to retry * ================================= DO filebusy WITH tryagain CASE xerno = 109 * ======================== *$ Record in use by another. * Advise user & provide option to retry * ======================== DO rec_busy WITH tryagain CASE xerno = 4 * ==================================== *$ End of file encountered. With the * ON ERROR statement active this error * message may be encountered when using * code such as DO WHILE .NOT. EOF(), so * simply return to next line in calling program * ==================================== SET PRINT &xprint SET CONSOLE &xkonsol SET DEVICE TO &xdevice ON ERROR DO PROERROR WITH ERROR(), MESSAGE(), MESSAGE(1), ; SYS(16), LINENO(), SYS(102), SYS(100), SYS(101), LASTKEY(), ; DBF(), SYS(18) RETURN CASE xerno = 38 * ========================== *$ Attempt has been made to position record * pointer before the first record in the file. * Correct by going to top of file, skipping down * one record, then retrying the same command line. * ========================== GO TOP SKIP STORE .T. TO tryagain CASE xerno = 5 .OR. xerno = 20 .OR. xerno = ; 26 .OR. xerno = 114 * ============================================== *$ Record is out of range error message * or Record is not in index error message. * This usually means an index has been corrupted * or the data or database was changed without the * index active. * * Also handles the index damaged error message * and Index does not match database error message. * Pop up message to user and then quit to main menu. * ============================================ DO index_er STORE .F. TO tryagain CASE xerno = 111 * ============================ *$ Cannot write to a read-only file. * Attempt has been made to use a file * created for read only purposes. * ============================ DO readonly STORE .F. TO tryagain CASE xerno = 1101 * ==================== *$ Cannot open file * ==================== DO no_open STORE .F. TO tryagain CASE xerno = 1705 * ============================== *$ File access denied * ============================== DO noaccess WITH tryagain, xkode CASE xerno = 1102 * ======================= *$ Can not create file * ======================= DO nocreate STORE .F. TO tryagain CASE xerno = 1157 * =============================== *$ Cannot update file * * This is really bad news - A hardware * error has resulted in the inability * to write to the disk. * =============================== DO realbad1 SET CURSOR ON * =================================== * Note that there is no attempt here * to store information to the PROERROR.DBF * file. It is assumed such an attempt * would result in the same error. * =================================== QUIT CASE xerno = 1115 .OR. xerno = 15 * ======================================= *$ Worst case - Database has been trashed * ======================================= DO trashed STORE .F. TO tryagain CASE xerno = 67 .OR. xerno = 1309 * ======================================= *$ Expression evaluator fault. The .FRX * or other compiled files may be corrupted. * ======================================= DO korrupt STORE .F. TO tryagain CASE xerno = 1104 * =================================== *$ File read error * Advise user and provide option to try again * =================================== DO read_err WITH tryagain CASE xerno = 1105 * ======================================== *$ File write error * Advise user & provide option to try again * ======================================== DO rite_err WITH tryagain CASE xerno = 19 * ==================================== *$ Index file does not match database. * Index expression includes fields not * contained in the database file. * Advise user & return to Main Menu. * ==================================== DO mixup STORE .F. TO tryagain CASE xerno = 124 * ========================= *$ Invalid printer redirection * which can only be fixed from DOS. * This normally occurs when attempts * are made to share a nonsharable * printer or the path to the print * device has not been properly defined. * Advise user & quit to DOS * ========================= DO invalprn CASE xerno = 1012 * ================================ *$ DOS free memory chain has been scrambled. * The only solution is to return to DOS. * ================================ DO badchain CASE xerno = 56 * ================================= *$ Out of disk error. Return to DOS * ================================= DO nospace CASE xerno = 125 * ================================ * Printer not ready. * Provide user with option to retry. * ================================= DO notready WITH tryagain CASE xerno = 6 * ================================ *$ Too many files open * The CONFIG.SYS needs to be changed. * Advise user & quit to DOS. * ================================ DO lowfiles WITH xerno, xmsg, xkode, xmodul, xline CASE xerno = 1410 * ==================================== *$ Unable to create temporary work files * Advise user & quit to DOS * ==================================== DO workspac CASE xerno = 1642 * ===================================== *$ Colorset resource not found * * This is NOT a recoverable error in the sense of * retrying the command since the named color set is * missing. However, FoxPro will use the default * color set. * * If the color set resource makes a * significant difference to the system this * CASE is appropriate. The system will abort * and info will be saved to the PROERROR database. * If, on the other hand, your application will * function without the named color set, astrisk * out this module as has been done here or simply * remove it. * ===================================== STORE .F. TO tryagain OTHERWISE * =============================================== *$ Otherwise store information to database and * return to Main Menu directly from Profatal * ================================================ DO profatal WITH xerno, xmsg, xkode, ; xmodul, xline, xprint, xkonsol, xdevice, keypress ENDCASE xerno IF tryagain * ============================== *& User has elected to try again * Restore environment & retry * ============================== SET PRINT &xprint SET CONSOLE &xkonsol SET DEVICE TO &xdevice ON ERROR DO PROERROR WITH ERROR(), MESSAGE(), MESSAGE(1), ; SYS(16), LINENO(), SYS(102), SYS(100), SYS(101), LASTKEY(), ; DBF(), SYS(18) RETRY ELSE * ========================== *$ Store info to error file * ========================== SET CONSOLE OFF SELECT 0 USE proerror * ======================================= * Error file is opened for use while other * previously opened files are kept open so the * information on what databases and indexes were * open at the time of the error can be stored in * the record for reference purposes. * ======================================== APPEND BLANK REPLACE er_no WITH xerno, er_msg WITH xmsg, ; kode WITH xkode, mmodul WITH xmodul, ddate ; WITH DATE(), ttime WITH TIME(), line_no WITH xline SET SAFETY OFF STORE SYS(3) + ".TXT" TO ffile * ====================================== * Note use of indirect referencing instead * of the ¯o substitution * ====================================== LIST MEMO TO (ffile) APPEND MEMO notes FROM (ffile) LIST STATUS TO (ffile) APPEND MEMO notes FROM (ffile) ERASE (ffile) ON KEY && Clear out ON KEY LABELs CLOSE DATA UNLOCK ALL CLEAR ALL ON ERROR DO PROERROR WITH ERROR(), MESSAGE(), MESSAGE(1), ; SYS(16), LINENO(), SYS(102), SYS(100), SYS(101), LASTKEY(), ; DBF(), SYS(18) RETURN TO MASTER ENDIF tryagain * END Procedure Proerror *!********************************************************************* *! *! Procedure: NOFILE *! *! Called by: PROERROR.PRG *! *! Calls: A_LERT (procedure in PROERROR.PRG) *! *! Uses: PROERROR.DBF *! *!********************************************************************* PROCEDURE nofile *********************************************************************** *& File does not exist error has been encountered. * Pop up window to warn user and tell user to call * immediately. Store information to database. * * * * * * * * * * * * * * * * * * * * PARAMETERS xerno, xmsg, xkode, xmodul, xline DEFINE WINDOW bugbox FROM 6,22 TO 16,57 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET ESCAPE OFF SET CURSOR OFF @ 1, 3 SAY "The file you need is missing!" @ 3, 4 SAY "Please call Pat Adams at" @ 4, 4 SAY "(718) 469-XXXX immediately" @ 5, 4 SAY "and report this problem." SET COLOR TO W/N DO a_lert CLEAR TYPEAHEAD @ 7, 9 SAY "Press any key..." = INKEY(0,"M") SET CONSOLE OFF * ================== *$ Store info to PROERROR.DBF * ================== SELECT 0 USE proerror * ======================================= * Error file is opened for use while other * previously opened files are kept open so the * information on what databases and indexes were * open at the time of the error can be stored in * the record for reference purposes. * ======================================== APPEND BLANK REPLACE er_no WITH xerno, er_msg WITH xmsg, ; kode WITH xkode, mmodul WITH xmodul, ddate ; WITH DATE(), ttime WITH TIME(), line_no WITH xline SET SAFETY OFF STORE SYS(3) + ".TXT" TO ffile * ====================================== * Note use of indirect referencing instead * of the ¯o substitution * ====================================== LIST MEMO TO (ffile) APPEND MEMO notes FROM (ffile) LIST STATUS TO (ffile) APPEND MEMO notes FROM (ffile) CLOSE DATA ERASE (ffile) DEACTIVATE WINDOW bugbox CLEAR windows RETURN * End Procedure Nofile *!********************************************************************* *! *! Procedure: PROFATAL *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *! Uses: PROERROR.DBF *! : &FFILE.DBF *! *!********************************************************************* PROCEDURE profatal *********************************************************************** *& Save error information to database or retry * * NOTE: This routine is specific to FoxPro. * * Information is stored to the PROERROR.DBF file and then * the user is returned to master calling program if a RETRY * is not issued. * * This module can also be used independently for debugging by * issuing the following ON ERROR statement: * * ON ERROR DO PROFATAL WITH ERROR(), MESSAGE(), MESSAGE(1), ; * SYS(16), LINENO(), SYS(1O3), SYS(100), SYS(101), LASTKEY(), ; * DBF(), SYS(18) * * Parameters are: * * xerno = The numeric code of the number provided by ERROR() * xmsg = The error message provided by MESSAGE() * xkode = The contents of the line of code which * triggered the error as provided by MESSAGE(1) * xmodul = The name of the code module, SYS(16) * xline = The number of the line of code triggering the * error, LINENO() * xprint = Current PRINTER setting as per SYS(103) * xkonsol= Current CONSOLE setting as per SYS(100) * xdevice= Current DEVICE setting as per SYS(101) * keypress = LASTKEY() * curr_dbf = Selected .DBF when error occurred * getfield = Field of GET...READ at time error occurred * * In addition to this data, the routine saves the information from * DISPLAY MEMORY and DISPLAY STATUS is saved to the memo field. * * Note that if the .PRG file is not available or the COMPILE NODEBUG * command has been utilized the contents of the line of code and the * line number of the line of code which triggered the error will not * be available. * * Author: Pat Adams, DB Unlimited (718) 469-XXXX * Date: 4/20/90 * Last modified: 9/4/90 * Copyright 1989 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARA xerno, xmsg, xkode, xmodul, xline, xprint, xkonsol, xdevice, ; keypress, curr_dbf, getfield SET TALK OFF SET ESCAPE OFF SET CURSOR OFF * ================================ * Pop up window to inform user about error * =============================== DEFINE WINDOW xfatal FROM 6,8 TO 16,42 DOUBLE ; SHADOW COLOR +W/N, +W/N, +*R/R ACTIVATE WINDOW xfatal @ 1, 1 SAY " One of those FATAL errors" @ 2, 1 SAY " has occurred! " @ 4, 1 SAY " Would you like to see the " @ 5, 1 SAY " error message and code that" @ 6, 1 SAY " created the condition? " CLEAR TYPEAHEAD * ===================== * Sound a Bronx cheer * ==================== DO razberry @ 8, 1 SAY " (Enter Y or N) " * ================================= * Error Trapping for Yes/No Response * with SUSPEND activated via ESC key * ================================= STORE 0 TO kkey DO WHILE kkey = 0 kkey = INKEY() IF kkey > 0 * ============================= * Function keys 2 thru 9 return * negative values. This sets up * error trapping for that condition. * ============================= IF CHR(kkey) $ "YyNn" STORE CHR(kkey) TO viewit ELSE IF kkey <> 27 STORE 0 TO kkey ENDIF kkey <> 27 ENDIF chr(kkey) $ ELSE STORE 0 TO kkey ENDIF kkey > 0 ENDDO while kkey = 0 ACTIVATE SCREEN SET CONSOLE OFF * ================== *$ Store info to PROERROR.DBF * ================== SELECT 0 USE proerror * ======================================= * Error file is opened for use while other * previously opened files are kept open so the * information on what databases and indexes were * open at the time of the error can be stored in * the record for reference purposes. * ======================================== APPEND BLANK REPLACE er_no WITH xerno, er_msg WITH xmsg, ; kode WITH xkode, mmodul WITH xmodul, ddate ; WITH DATE(), ttime WITH TIME(), line_no WITH xline SET SAFETY OFF STORE SYS(3) + ".TXT" TO ffile * ====================================== * Note use of indirect referencing instead * of the ¯o substitution * ====================================== LIST MEMO TO (ffile) APPEND MEMO notes FROM (ffile) LIST STATUS TO (ffile) APPEND MEMO notes FROM (ffile) ERASE (ffile) SET ESCAPE ON ON ESCAPE SUSPEND SET CONSOLE ON IF UPPER(viewit) = "Y" * ================================== * Clear out the ON ESCAPE SUSPEND and permit * user to BROWSE to see the error information. * Escape key is now utilized to exit the BROWSE. * ================================== ON ESCAPE SET ESCAPE ON ?? SYS(2002,1) && Turn on cursor GO BOTTOM DEFINE WINDOW fbrowse FROM 2,2 TO 22,72 PANEL ; CLOSE FLOAT GROW SHADOW ZOOM COLOR W+/B, GR+/BG, R+ BROWSE FIELDS er_no:5, er_msg:20, kode:20, ; mmodul:12, ddate:8, ttime:8, line_no:8, ; notes:6 NOMODIFY WINDOW fbrowse DEACTIVATE WINDOW fbrowse RELEASE WINDOW fbrowse ENDIF upper(viewit) = "Y" CLOSE DATA DEACTIVATE WINDOW xfatal RELEASE WINDOW xfatal ON KEY && Clear out ON KEY LABELs RETURN TO MASTER * END Procedure Profatal *!********************************************************************* *! *! Procedure: RAZBERRY *! *! Called by: PROFATAL (procedure in PROERROR.PRG) *! : FILEBUSY (procedure in PROERROR.PRG) *! : REC_BUSY (procedure in PROERROR.PRG) *! : INDEX_ER (procedure in PROERROR.PRG) *! : READONLY (procedure in PROERROR.PRG) *! : NOACCESS (procedure in PROERROR.PRG) *! : NOCREATE (procedure in PROERROR.PRG) *! : NO_OPEN (procedure in PROERROR.PRG) *! : KORRUPT (procedure in PROERROR.PRG) *! : READ_ERR (procedure in PROERROR.PRG) *! : RITE_ERR (procedure in PROERROR.PRG) *! : MIXUP (procedure in PROERROR.PRG) *! : INVALPRN (procedure in PROERROR.PRG) *! : LOWFILES (procedure in PROERROR.PRG) *! : WORKSPAC (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE razberry *********************************************************************** *& Sound chime as a "raspberry" or Bronx cheer * * Author: Pat Adams, DB Unlimited 7/24/89 * Copyright 1989 DB Unlimited * * * * * * * * * * * * * * * * * * * * * * SET BELL TO 30,15 ?? CHR(7) SET BELL TO 512,2 && Return bell to normal setting RETURN * End Procedure Razberry *!********************************************************************* *! *! Procedure: A_LERT *! *! Called by: NOFILE (procedure in PROERROR.PRG) *! : REALBAD1 (procedure in PROERROR.PRG) *! : TRASHED (procedure in PROERROR.PRG) *! : BADCHAIN (procedure in PROERROR.PRG) *! : NOSPACE (procedure in PROERROR.PRG) *! : NOTREADY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE a_lert ************************************************************************ *& Sound warning siren * * Author: Pat Adams, DB Unlimited (718) 469-XXXX * Date: 2/5/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * FOR il = 1 TO 3 FOR xx = 1 TO 4 SET BELL TO 1650-(18*xx), 3 ?? CHR(7) SET BELL TO 650-(5*xx),3 ?? CHR(7) ENDFOR ENDFOR SET BELL TO 512,2 && Return bell to normal setting RETURN * End Procedure A_LERT *!********************************************************************* *! *! Procedure: FILEBUSY *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE filebusy *********************************************************************** *& Inform user file is in use & provide option to retry * * Passed parameter is a logical .F. which is returned * as a .T. or .F., depending upon whether user wants to * retry for use of the file. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETER tryagain DEFINE WINDOW bugbox FROM 6,22 TO 15,57 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+W/N @ 1,13 SAY "SORRY!" SET ESCAPE OFF SET COLOR TO +W/N @ 3, 2 SAY "The file you need is in use" @ 4, 2 SAY "by someone else right now." DO razberry CLEAR TYPEAHEAD @ 6, 2 SAY "Do you want to try again? (Y/N)" * ==================================== * Error user trapping for Y/N response * ==================================== DO yes_no WITH tryagain DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN tryagain * END Procedure Filebusy *!********************************************************************* *! *! Procedure: REC_BUSY *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE rec_busy ********************************************************************** *& Record in use by another. Inform user & provide option to retry. * * Passed parameter is a logical .F. which is returned * as a .T. or .F., depending upon whether user wants to * retry for use of the record. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETER tryagain DEFINE WINDOW bugbox FROM 6,22 TO 15,57 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+W/N @ 1,13 SAY "SORRY!" SET ESCAPE OFF SET COLOR TO +W/N @ 3, 2 SAY "The record you want is in use" @ 4, 2 SAY "by someone else right now." CLEAR TYPEAHEAD DO razberry @ 6, 2 SAY "Do you want to try again? (Y/N)" * ======================================== * Error trapping for user Y/N response * ======================================== DO yes_no WITH tryagain DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN tryagain * End Procedure REC_BUSY *!********************************************************************* *! *! Procedure: INDEX_ER *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE index_er *********************************************************************** *& Record is out of range error message * or Record is not in index error message. * This usually means an index has been corrupted * or the data or database was changed without the * index active. * * Also handles the index damaged error message * Pop up message to user and then quit to main menu. * * The actual message to the user will need to be * modified for the particulars of each system. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 4,19 TO 19,53 PANEL ; SHADOW COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+GR/N @ 1, 8 SAY " BAD NEWS " SET COLOR TO +W/N @ 3, 2 SAY "There is a problem with the" @ 4, 2 SAY "index(s) needed for this" @ 5, 2 SAY "routine." @ 7, 2 SAY "You will be returned to the" @ 8, 2 SAY "Main Menu. From there please" @ 9, 2 SAY "select the appropriate" @10, 2 SAY "maintenance function to fix" CLEAR TYPEAHEAD @11, 2 SAY "the index." DO razberry SET COLOR TO W/N @13, 2 SAY "Press any key..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * END Procedure Index_er *!********************************************************************* *! *! Procedure: READONLY *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE readonly *********************************************************************** *& Cannot write to a read-only file. * * Attempt has been made to use a file created for read only purposes. * * Inform user with message to call me since this is most likely a * programming error, and return user to Main Menu. * * Author: Pat Adams, DB Unlimited (718) 469-XXXX * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 4,22 TO 19,57 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+GR/N SET CURSOR OFF @ 1, 9 SAY " SORRY " SET COLOR TO +W/N @ 3, 2 SAY "Something has gone wrong and" @ 4, 2 SAY "the system is attempting to" @ 5, 2 SAY "write to a read only file." @ 7, 2 SAY "Please call Pat Adams at DB" @ 8, 2 SAY "Unlimited (718-469-XXXX) and" @ 9, 2 SAY "report this problem." SET COLOR TO W/N DO razberry CLEAR TYPEAHEAD @11, 2 SAY "Press any key to" @12, 2 SAY "return to the Main Menu..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * END Procedure Readonly *!********************************************************************* *! *! Procedure: NOACCESS *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE noaccess ********************************************************************** *$ File access denied * * Attempt has been made to write to a file that is * read only. This may arise for several reasons: * * 1. File is protected by the DOS * ATTRIB command as read only * * 2. User rights have not been * configured properly for this * users LAN access. Note that * a .DBF file may be opened (for purposes * of reading or copying the file) with * read only rights on a LAN but * index files require both read and * write rights. * * 3. Most LANs, such as Novell, utilize bytes not utilized * by DOS to store information about whether the LAN * attribute(s) for the file are read only, etc. Something * may have changed the LAN attributes for this file to * read only. * * 4. File is in use by another. This routine * tests the line of code which caused the error and * if it contains a USE EXCL statement advises the user * that someone else has use of the file. Error #3 should * be returned in this circumstance but certain DOS based * LANs such as InvisibleNet erroneously return error 1705. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Last Modified: 12/4/90 * IF statement added to check for erroneous * error 1705. * * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETERS doagain, kodeline SET CURSOR OFF IF ATC("EXCL", kodeline) <> 0 * ============================================= * Required file is in use by another. * An exclusive use of file can not be obtained. * Advise user and provide opportunity to retry * for the required file. * ============================================= SET ESCAPE OFF DEFINE WINDOW BOX1 FROM 7,24 TO 16,56 PANEL; SHADOW COLOR W+/N,N/W,GR*+/GR+ ACTIVATE WINDOW BOX1 SET COLOR TO *+GR/N @ 0,11 SAY " SORRY " SET COLOR TO +W/N @ 2, 3 SAY "Someone else is using the" @ 3, 3 SAY "file you need exclusively." @ 5, 2 SAY "Would you like to try again?" SET COLOR TO W/N @ 7, 9 SAY "(Enter Y or N)" * ================================= * Error Trapping for user Yes/No Response * ================================= DO yes_no WITH doagain SET ESCAPE ON DEACTIVATE WINDOW box1 RELEASE WINDOW box1 ELSE * ============================================= * Other conditions have created the error. * Advise user and abort remainder of the routine. * ============================================= STORE .F. TO doagain DEFINE WINDOW bugbox FROM 4,19 TO 22,63 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+GR/N SET CURSOR OFF @ 1,13 SAY " WHOOPS " SET COLOR TO +W/N @ 3,2 SAY "One of several conditions has occurred." @ 5,2 SAY "Someone else has the file(s) you need" @ 6,2 SAY "in exclusive use, you do not have the" @ 7,2 SAY "appropriate user rights on the LAN, or" @ 8,2 SAY "the file(s) you need have been flagged" @ 9,2 SAY "as read only." @ 11,2 SAY "If this message continually appears" @ 12,2 SAY "please call your LAN administrator." DO razberry CLEAR TYPEAHEAD SET COLOR TO W/N @ 15, 2 SAY "Press any key to" @ 16, 2 SAY "return to the Main Menu..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox ENDIF ATC("EXCL", kodeline) <> 0 RETURN doagain * END Procedure Noaccess *!********************************************************************* *! *! Procedure: NOCREATE *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE nocreate *********************************************************************** *& Error 1102 - Can not create file * * This usually occurs because: * * 1. The disk or directory is full * * 2. An invalid file name is being utilized. Check for * blank spaces and occurrances of other characters not * acceptable to DOS and/or FoxPro. * * 3. User may not have correct LAN user rights. * * 4. An attempt is being made to write over an existing * file which has been flagged as read only. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 2,13 TO 21,66 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET COLOR TO +*GR/N SET CURSOR OFF @ 1,16 SAY " WHOOPS " SET COLOR TO +W/N @ 3, 3 SAY "The operating system will not permit creation" @ 4, 3 SAY "of a file which is required. This may arise" @ 5, 3 SAY "for several reasons:" @ 7, 5 SAY "1. You do not have the correct LAN rights." @ 8, 9 SAY "Call your LAN administrator." @10, 5 SAY "2. The disk or subdirectory is full." @12, 5 SAY "3. You are trying to use an invalid name." @14, 5 SAY "4. A read-only file of the same name exists." SET COLOR TO W/N DO razberry CLEAR TYPEAHEAD @16, 2 SAY "Press any key to" @17, 2 SAY "return to the Main Menu..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * END Procedure Nocreate *!********************************************************************* *! *! Procedure: NO_OPEN *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE no_open *********************************************************************** *& Error 1101 - Cannot open file * * This usually occurs because: * * 1. User does not have correct LAN rights. * * 2. File does not exist - probably inadvertently erased. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 3,13 TO 18,66 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+GR/N @ 1,18 SAY " SORRY " SET COLOR TO +W/N @ 3, 2 SAY "The system is unable to open the file you need." @ 5, 2 SAY "One of two things may have happened:" @ 7, 4 SAY "1. You do not have the correct user rights" @ 8, 8 SAY "on the LAN. Call your LAN administrator." @10, 4 SAY "2. The file has been erased." SET COLOR TO W/N DO razberry CLEAR TYPEAHEAD @12,24 SAY "Press any key to" @13,24 SAY "return to the Main Menu..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * END Procedure No_open *!********************************************************************* *! *! Procedure: REALBAD1 *! *! Called by: PROERROR.PRG *! *! Calls: A_LERT (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE realbad1 *********************************************************************** *& Error 1157 - Cannot update file * * This is a very serious error. A problem has occurred * when attempting to write to the disk. The problem is * not with FoxPro but rather with DOS or the hardware. * The most likely causes are: * * 1. The disk/directory is full; * * 2. The hard disk has failed. * * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 3,18 TO 17,61 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+GR/N @ 1, 9 SAY " VERY BAD NEWS " SET COLOR TO +W/N @ 3, 2 SAY "A hardware error has occurred." @ 5, 2 SAY "Your disk or directory may be full" @ 6, 2 SAY "or there may be a disk failure." @ 8, 2 SAY "Call your LAN administrator immediately" SET COLOR TO W/N CLEAR TYPEAHEAD @ 9, 2 SAY "to report this!" @12, 9 SAY "Press any key to return to DOS..." FOR jj = 1 TO 3 * ===================================== * Sound the alert siren several times * ===================================== DO a_lert ENDFOR = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * END Procedure realbad1 *!********************************************************************* *! *! Procedure: TRASHED *! *! Called by: PROERROR.PRG *! *! Calls: A_LERT (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE trashed *********************************************************************** *& Error 1115 - Database record is trashed * * [Pray that user has made a backup recently] * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 5,22 TO 17,58 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+GR/N @ 1, 2 SAY " THE WORST HAS HAPPENED " SET COLOR TO +W/N @ 3, 2 SAY "A database has been trashed!" @ 5, 2 SAY "You must restore from your most" @ 6, 2 SAY "recent backup or call Pat Adams" @ 7, 2 SAY "at DB Unlimited (718-469-XXXX)." SET COLOR TO W/N CLEAR TYPEAHEAD @ 9, 2 SAY "Press any key to" @10, 2 SAY "return to Main Menu..." FOR jj = 1 TO 5 * ============================== * Sound warning siren loud & long * ============================== DO a_lert ENDFOR = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * End Procedure Trashed *!********************************************************************* *! *! Procedure: KORRUPT *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE korrupt *********************************************************************** *& Error 67 = Expression evaluator fault * * There is an internal consistency check failure in the * FoxPro expression evaluator. The most likely cause is * corruption in the compiled object code file. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 3, 8 TO 19,71 PANEL SHADOW ; COLOR W+/N,N/W,GR+*/R ACTIVATE WINDOW bugbox SET CURSOR OFF SET COLOR TO *+GR/N @ 1,21 SAY " BAD NEWS " SET COLOR TO +W/N @ 3, 2 SAY "Something seems to have corrupted your compiled code file." @ 5, 2 SAY "Options are:" @ 7, 2 SAY "1. Return to DOS and copy a fresh version onto the disk" @ 9, 2 SAY "2. Recompile from the ASCII text source code" @11, 2 SAY "3. Call Pat Adams at DB Unlimited (718-469-XXXX)" SET COLOR TO W/N CLEAR TYPEAHEAD DO razberry @14, 9 SAY "Press any key to return to Main Menu..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN * End PROCEDURE korrupt *!********************************************************************* *! *! Procedure: READ_ERR *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE read_err *********************************************************************** *& Error 1104 - File read error * * The operating system returned an error to FoxPro * while FoxPro was attempting to read a file. It could * just be a "hiccup" or there could be problems with the * disk. Provide user with option to retry. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETERS rretry DEFINE WINDOW bugbox FROM 3,19 TO 20,61 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N SET CURSOR OFF @ 1,11 SAY " BAD NEWS " SET COLOR TO +W/N @ 3, 2 SAY "Your hardware and/or operating system" @ 4, 2 SAY "returned an error during an attempt" @ 5, 2 SAY "to read a file." @ 7, 2 SAY "It may be that there was just a minor" @ 8, 2 SAY "'hiccup' or you may be experiencing" @ 9, 2 SAY "hardware problems. If this is the" @10, 2 SAY "first time you have received this" @11, 2 SAY "error message try things again. If" @12, 2 SAY "not, quit and check your disk, con-" @13, 2 SAY "troller and LAN connections." SET COLOR TO +GR/N CLEAR TYPEAHEAD DO razberry @15, 6 SAY "Do you want to retry? (Y/N)" * ===================================== * Error trapping for user Y/N response * ===================================== DO yes_no WITH rretry DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN rretry * End Procedure Read_err *!********************************************************************* *! *! Procedure: RITE_ERR *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE rite_err ************************************************************************ *& Error 1105 - File write error * * Operating system error returned while FoxPro was attempting * to write to a file or create a new file. Usually occurs * when a diskette has been write protected. * * Advise user & provide option to retry. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETERS rretry DEFINE WINDOW bugbox FROM 5,21 TO 15,58 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,11 SAY CHR(4)+" "+CHR(4)+" SORRY "+CHR(4)+" "+CHR(4) SET COLOR TO +W/N @ 3, 2 SAY "There is a problem writing the" @ 4, 2 SAY "file to disk. Is it possible" @ 5, 2 SAY "you have a write protected disk?" CLEAR TYPEAHEAD DO razberry @ 7, 2 SAY "Do you want to retry this? (Y/N)" * ================================== *$ Error trapping for user Y/N response * ================================== DO yes_no WITH rretry DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN rretry * END Procedure rite_err *!********************************************************************* *! *! Procedure: MIXUP *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE mixup ************************************************************************ *& Error 19 - Index file does not match database. * Index expression includes fields not contained in * the database file. Advise user & return to Main Menu. * * Author: Pat Adams, DB Unlimited (718) 469-XXXX * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 5,18 TO 17,61 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/W @ 1,14 SAY CHR(4)+" "+CHR(4)+" SORRY "+CHR(4)+" "+CHR(4) SET COLOR TO +W/N @ 3, 2 SAY "An attempt was made to use an index" @ 4, 2 SAY "containing fields not in the database." @ 6, 2 SAY "Please call Pat Adams at DB Unlimited" @ 7, 2 SAY "(718-469-XXXX) to report this problem." SET COLOR TO W/N CLEAR TYPEAHEAD DO razberry @ 9, 2 SAY "Press any key to return to Main Menu..." = INKEY(0, "M") RETURN * End Procedure Mixup *!********************************************************************* *! *! Procedure: INVALPRN *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *! Uses: PROERROR.DBF *! : &FFILE.DBF *! *!********************************************************************* PROCEDURE invalprn *********************************************************************** *& Error 124 - Invalid printer redirection * which can only be fixed from DOS. * * This normally occurs when attempts are made to share a non- * sharable printer on a LAN or the path to the print device * has not been properly defined. * * Advise user & quit to DOS. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 5,15 TO 17,64 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,18 SAY CHR(4)+" "+CHR(4)+" SORRY "+CHR(4)+" "+CHR(4) SET COLOR TO +W/N @ 3, 2 SAY "An attempt was made to use an unavailable" @ 4, 2 SAY "print device. Either the printer you" @ 5, 2 SAY "want is not sharable or the correct DOS" @ 6, 2 SAY "PATH setting has not been made. You must" @ 7, 2 SAY "leave this system, return to DOS and fix" @ 8, 2 SAY "things there. Or call your LAN administrator." SET COLOR TO W/N CLEAR TYPEAHEAD DO razberry @10, 2 SAY "Press any key to return to DOS..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox CLEAR * ========================== *$ Store info to error file * ========================== SET CONSOLE OFF SELECT 0 USE proerror * ======================================= * Error file is opened for use while other * previously opened files are kept open so the * information on what databases and indexes were * open at the time of the error can be stored in * the record for reference purposes. * ======================================== APPEND BLANK REPLACE er_no WITH xerno, er_msg WITH xmsg, ; kode WITH xkode, mmodul WITH xmodul, ddate ; WITH DATE(), ttime WITH TIME(), line_no WITH xline SET SAFETY OFF STORE SYS(3) + ".TXT" TO ffile * ====================================== * Note use of indirect referencing instead * of the ¯o substitution * ====================================== LIST MEMO TO (ffile) APPEND MEMO notes FROM (ffile) LIST STATUS TO (ffile) APPEND MEMO notes FROM (ffile) CLOSE DATA ERASE (ffile) CLEAR windows SET CURSOR ON CLEAR ALL QUIT * END Procedure Invalprn *!********************************************************************* *! *! Procedure: BADCHAIN *! *! Called by: PROERROR.PRG *! *! Calls: A_LERT (procedure in PROERROR.PRG) *! *! Uses: PROERROR.DBF *! : &FFILE.DBF *! *!********************************************************************* PROCEDURE badchain *********************************************************************** *& Error 1012 - OS memory error. * * Something has scrambled the DOS free memory chain. * The only solution is to return to DOS and begin all * over again. Advise user & quit to DOS. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 5,15 TO 17,61 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,13 SAY " BAD NEWS " SET COLOR TO +W/N @ 3, 2 SAY "Something has scrambled your DOS memory." @ 4, 2 SAY "The only solution is to return to DOS and" @ 5, 2 SAY "start all over again." @ 7, 2 SAY "Please call Pat Adams at DB Unlimited" @ 8, 2 SAY "(718-469-XXXX) to report this problem." SET COLOR TO W/N CLEAR TYPEAHEAD @10, 2 SAY "Press any key to return to DOS..." DO a_lert = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox CLEAR * ========================== *$ Store info to error file * ========================== SET CONSOLE OFF SELECT 0 USE proerror * ======================================= * Error file is opened for use while other * previously opened files are kept open so the * information on what databases and indexes were * open at the time of the error can be stored in * the record for reference purposes. * ======================================== APPEND BLANK REPLACE er_no WITH xerno, er_msg WITH xmsg, ; kode WITH xkode, mmodul WITH xmodul, ddate ; WITH DATE(), ttime WITH TIME(), line_no WITH xline SET SAFETY OFF STORE SYS(3) + ".TXT" TO ffile * ====================================== * Note use of indirect referencing instead * of the ¯o substitution * ====================================== LIST MEMO TO (ffile) APPEND MEMO notes FROM (ffile) LIST STATUS TO (ffile) APPEND MEMO notes FROM (ffile) CLOSE DATA ERASE (ffile) CLEAR windows SET CURSOR ON CLEAR ALL QUIT * END Procedure Badchain *!********************************************************************* *! *! Procedure: NOSPACE *! *! Called by: PROERROR.PRG *! *! Calls: A_LERT (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE nospace *********************************************************************** *& Error 56 - Out of disk * * No more space on the disk to complete the current WRITE. * Frequently occurs during PACK, SORT and REINDEX commands * as well as when copying files to a floppy disk. * * Since there may not be disk space available to save * information on what line of code in which module * generated the error the user is asked to make a screen * print before returning to DOS. * * Author: Pat Adams, DB Unlimited (718) 469-XXXX * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 2,11 TO 20,68 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,19 SAY " BAD NEWS " SET COLOR TO +W/N @ 3,11 SAY "You have run out of disk space." @ 5, 2 SAY "It is now necessary to leave this system and return" @ 6, 2 SAY "to DOS. If you are not writing to a floppy disk use" @ 7, 2 SAY "SHIFT/Print Screen to make a copy of this screen" @ 8, 2 SAY "and call your LAN administrator." @10, 2 SAY "ERROR #: 56 Out of Disk" @11, 2 SAY "CODE: " + IIF(LEN(xkode) > 40, LEFT(xkode,40), xkode) @12, 2 SAY "MODULE: " + xmodul @13, 2 SAY "LINE #: " + STR(xline, 6,0) SET COLOR TO W/N CLEAR TYPEAHEAD DO a_lert @16,10 SAY "Press any key to return to DOS..." = INKEY(0, "M") * ================================================= * A CLOSE DATA or CLEAR ALL may not work * in view of the error message. Therefore, * the QUIT is issued without the other commands. * * Depending upon a number of variables, even the * QUIT may not unload FoxPro and take you back to DOS. * ================================================= SET CURSOR ON QUIT * END Procedure Nospace *!********************************************************************* *! *! Procedure: NOTREADY *! *! Called by: PROERROR.PRG *! *! Calls: A_LERT (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE notready *********************************************************************** *& Error 125 - Printer not ready * Advise user & provide option to reset printer & retry. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETERS rretry DEFINE WINDOW bugbox FROM 3,17 TO 19,63 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R SET CURSOR OFF ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,14 SAY CHR(4)+" "+CHR(4)+" WHOOPS "+CHR(4)+" "+CHR(4) SET COLOR TO +W/N @ 3, 2 SAY "There is a problem with your printer." @ 4, 2 SAY "Check the following:" @ 6, 6 SAY "1. Is the printer turned on?" @ 8, 6 SAY "2. Is the printer on line?" @10, 2 SAY "Otherwise you may have a loose connection" @11, 2 SAY "between the computer and the printer or" @12, 2 SAY "the printer may be timing out." SET COLOR TO +GR/N CLEAR TYPEAHEAD * ========================= *$ Sound long, loud siren * ========================= DO a_lert @14, 2 SAY "Would you like to retry printing? (Y/N)" * ==================================== * Error trapping for user Y/N response * ==================================== DO yes_no WITH rretry DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox RETURN rretry * END Procedure Notready *!********************************************************************* *! *! Procedure: LOWFILES *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *! Uses: PROERROR.DBF *! : &FFILE.DBF *! *!********************************************************************* PROCEDURE lowfiles *********************************************************************** *& Error 6 - Too many files open * * This normally occurs when the FILES= statement in the * CONFIG.SYS has been set too low. Advise user & return * to DOS. It is also possible that the LAN software uses * a FILES setting of its own and that needs to be adjusted * upwards. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Revised: 5/11/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETERS xerno, xmsg, xkode, xmodul, xline DEFINE WINDOW bugbox FROM 3,17 TO 19,62 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,13 SAY CHR(4)+" "+CHR(4)+" WHOOPS "+CHR(4)+" "+CHR(4) SET COLOR TO +W/N @ 3, 2 SAY "The FILES= statement in your CONFIG.SYS" @ 4, 2 SAY "needs to be adjusted upwards. This must" @ 5, 2 SAY "be done from DOS. After leaving this" @ 6, 2 SAY "system correct the statement in your" @ 7, 2 SAY "CONFIG.SYS to FILES=99." @ 9, 2 SAY "If you don't know how to do this please" @10, 2 SAY "call Pat Adams at DB Unlimited (718-" @11, 2 SAY "469-XXXX)." SET COLOR TO W/N CLEAR TYPEAHEAD DO razberry @13, 2 SAY "Press any key to return to DOS..." = INKEY(0, "M") DEACTIVATE WINDOW bugbox RELEASE WINDOW bugbox * ========================== *$ Store info to error file * ========================== SET CONSOLE OFF SELECT 0 USE proerror * ======================================= * Error file is opened for use while other * previously opened files are kept open so the * information on what databases and indexes were * open at the time of the error can be stored in * the record for reference purposes. * ======================================== APPEND BLANK REPLACE er_no WITH xerno, er_msg WITH xmsg, ; kode WITH xkode, mmodul WITH xmodul, ddate ; WITH DATE(), ttime WITH TIME(), line_no WITH xline SET SAFETY OFF STORE SYS(3) + ".TXT" TO ffile * ====================================== * Note use of indirect referencing instead * of the ¯o substitution * ====================================== LIST MEMO TO (ffile) APPEND MEMO notes FROM (ffile) LIST STATUS TO (ffile) APPEND MEMO notes FROM (ffile) CLOSE DATA ERASE (ffile) CLEAR ALL SET CURSOR ON QUIT * End procedure Lowfiles *!********************************************************************* *! *! Procedure: WORKSPAC *! *! Called by: PROERROR.PRG *! *! Calls: RAZBERRY (procedure in PROERROR.PRG) *! *!********************************************************************* PROCEDURE workspac *********************************************************************** *& Error 1410 - Unable to create temporary work files * * This error will normally arise from one of two reasons: * * a. Disk or subdirectory is full * * b. The disk/subdirectory specified in the * CONFIG.FP for the temporary work files * PROGWORK, EDITWORK, and SORTWORK are not * available. * * On a LAN the problem may also be that the user does not have * write "rights" in the subdirectory to which the temporary * work files are defaulting. * * Since disk space may not be available to store information that * generated the error, user is requested to make a screen print * to save the error messages. * * Author: Pat Adams, DB Unlimited * Date: 4/28/90 * Revised: 5/11/90 * Copyright 1990 DB Unlimited * All rights reserved * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DEFINE WINDOW bugbox FROM 3,17 TO 19,63 PANEL SHADOW ; COLOR W+/N,N/W,R+*/R ACTIVATE WINDOW bugbox SET COLOR TO *+R/N @ 1,13 SAY CHR(4)+" "+CHR(4)+" BAD NEWS "+CHR(4)+" "+CHR(4) SET COLOR TO +W/N @ 3, 2 SAY "It is not possible to create the temporary" @ 4, 2 SAY "work files needed. Your disk or sub-" @ 5, 2 SAY "directory may be full or the subdirectory" @ 6, 2 SAY "specified for the temporary files may not" @ 7, 2 SAY "exist." @ 9, 2 SAY "If necessary, call your LAN administrator" @10, 2 SAY "but first use SHIFT/Print Screen to make" @11, 2 SAY "a copy of this screen." SET COLOR TO W/N CLEAR TYPEAHEAD DO razberry @13, 2 SAY "Press any key to return to DOS..." = INKEY(0, "M") SET CURSOR ON CLEAR ALL SET CURSOR ON QUIT * END Procedure Workspac *********************************************************** PROCEDURE yes_no *********************************************************** *& Get user Y/N input and return appropriate value * * Author: Pat Adams, DB Unlimited * Date: 12/3/90 * Copyright 1990 DB Unlimited * * The passed parameter, USER_INPUT, is returned as * either a .T. or .F. value * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PARAMETERS user_input * ================================= * Error Trapping for Yes/No Response * with RETURN TO MASTER activated via ESC key * ================================= PRIVATE kkey STORE 0 TO kkey DO WHILE kkey = 0 kkey = INKEY() IF kkey = 27 RETURN TO MASTER ENDIF kkey = 27 IF kkey > 0 * ============================= * Function keys 2 thru 9 return * negative values. This sets up * error trapping for that condition. * ============================= IF CHR(kkey) $ "YyNn" IF CHR(kkey) $ "Yy" STORE .T. TO user_input ELSE STORE .F. TO user_input ENDIF chr(kkey) $ "Yy" ELSE STORE 0 to kkey ENDIF chr(kkey) $ ELSE STORE 0 TO kkey ENDIF kkey > 0 ENDDO while kkey = 0 RETURN user_input * END Procedure YES_NO ** EOF: PROERROR.PRG