Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : ON_ERROR.ZIP
Filename : ON_ERR.PRG

 
Output of file : ON_ERR.PRG contained in archive : ON_ERROR.ZIP
* This .prg will trap several diff. types of errors when used in a
* Novell ntwk. The Error Messages are double-boxed and displayed in
* (approx.) the center of the screen.
SET EXCLUSIVE OFF
**********************************************************************
* ON_ERR.PRG - ERROR TRAPPING PROGRAM *
**********************************************************************
* INSTALLATION - GENERAL MORTGAGE SERVICE
*
* SYSTEM - FIND 'EM (DTS SYSTEM)
* PROGRAM TITLE - ON_ERR
* PRODUCED BY - ALLMINE SYSTEMS
* PROGRAMMER(S) - RICHARD WAINWRIGHT / CHARLES ADAMS
* EFFECTIVE DATE - 11/01/86
*--------------------------------------------------------------------
* C H A N G E C O N T R O L L O G
*--------------------------------------------------------------------
*
* CHANGE EFF DATE CHANGE CONTROL INFORMATION
* ------ -------- -----------------------------------------
* 00 10/25/86 INITIAL PROGRAM VERSION
*
**********************************************************************
* V I D P O P S T A T E M E N T S (Remove if not using Saywhat?!)
**********************************************************************
STORE "?? CHR(255)+CHR(255)+'ERR_SCRN/'" TO ERR_SCRN
STORE "?? CHR(255)+CHR(255)+'ERR43/'" TO ERR43
STORE "?? CHR(255)+CHR(255)+'ERR92/'" TO ERR92
STORE "?? CHR(255)+CHR(255)+'ERR6/'" TO ERR6
STORE "?? CHR(255)+CHR(255)+'ERR15/'" TO ERR15
STORE "?? CHR(255)+CHR(255)+'ERR39/'" TO ERR39
STORE "?? CHR(255)+CHR(255)+'ERR20/'" TO ERR20
STORE "?? CHR(255)+CHR(255)+'ERR108/'" TO ERR108
STORE "?? CHR(255)+CHR(255)+'ERR111/'" TO ERR111
STORE "?? CHR(255)+CHR(255)+'ERR125/'" TO ERR125
STORE "?? CHR(255)+CHR(255)+'ERR109A/'" TO ERR109A
STORE "?? CHR(255)+CHR(255)+'ERR109BC/'" TO ERR109BC
******************************************************************************
SET TALK OFF
LOCKTRIES=100
e_option = ' '
CLEAR Typeahead
lockout = .f.
&ERR_SCRN
DO WEEKDATE
DO CASE

CASE ERROR() = 130 && record not locked, this is only for oversights
IF RLOCK()
??REPL(CHR(7),20) && lets me know there is a problem
RETRY
ELSE
??REPL(CHR(7),20)
SUSP
ENDI

CASE (ERROR() = 128 .OR. ERROR() = 129 .or. ERROR() = 109) && record is in use
??CHR(7)
option = ' '
t = 1
SET DEVICE TO SCRE
??CHR(7)
&ERR109A
DO WHILE T < locktries && locktries is global memvar
@ 08,30 SAY T PICTURE '999'
IF RLOCK()
UNLOCK
EXIT
ENDI
t = t+1
ENDDO
IF Pr_ind && pr_ind is global boolean
IF T = locktries && --tells if printing report
lockout = .t.
ENDI
SET DEVI TO PRIN
RETURN
ENDI
RETURN
&ERR109BC
@ 12,65 GET OPTION
READ
IF Option = 'T'
RETRY
ENDIF
IF Option = 'R'
CLOS DATA
RETURN TO MASTER
ENDIF
RETURN

CASE ERROR() = 108 && File in use
??CHR(7)
option = ' '
DO WHILE AT(option,'RT') = 0
option = ' '
&ERR108
READ
ENDDO
IF Option = 'T'
RETRY
ELSE
CLOS DATA
RETURN TO MASTER
ENDIF

CASE ERROR() = 125 && printer not ready
??CHR(7)
roption = ' '
DO WHILE AT(ROPTIon,'RT') = 0
ROPTIon = ''
??CHR(7)
&ERR125
WAIT '' TO ROPTION
ROPTION = UPPER(ROPTION)
ENDDO
IF ROPTION = 'R'
SET PRINT OFF
RETURN TO MASTER
ENDIF
SET DEVICE TO PRINT
RETRY

CASE (ERROR() = 111 .OR. ERROR() = 29) && file inaccessible or read-only
CLEAR
??REPL(CHR(7),2)
&ERR111
READ
RETURN TO MASTER

CASE ERROR() = 4 && EOF
GO BOTT
RETURN

CASE ERROR() = 38 && BOF
GO TOP
RETURN

CASE ERROR() = 6 && too many files
??CHR(7)
&ERR6
e_option = 'X'

CASE ERROR() = 20 && damaged index
??CHR(7)
&ERR20
SET SAFETY OFF
REINDEX
SET SAFETY ON
SET COLOR TO W+
@ 13,30 SAY 'REINDEX COMPLETE.'
SET COLOR TO
RETRY

CASE ERROR() = 15 && NOT a dbase database
??REPL(CHR(7),3)
&ERR15
e_option = 'X'

CASE ERROR() = 43 && insufficient MEMORY
??CHR(7)
&ERR43
READ
CLOS DATA
RETU TO MAST

CASE LTRIM(STR(ERROR())) $ '3,8,9,10,11,12,13,16,17,18,19,24,26,30,31,35,36,37,42,44,45,47,48,52,57,58,59,60,61,62,63,67,76,77';
.OR. LTRIM(STR(ERROR())) $ '78,79,87,88,91,93,94,96,102,103,104,105,106,107,112,136'
* evidently program error
??CHR(7)
&ERR43
E_OPTION='X'

CASE ERROR() = 39 && numeric overflow
&ERR39
e_option = 'X'

CASE ERROR() = 92 && command.com not available
??CHR(7)
&ERR92
e_option = 'X'

CASE LTRIM(STR(ERROR())) $ '123,124,126'
??REPL(CHR(7),2)
&ERR92D
READ
RETURN TO MASTER

*CASE ERROR() = 0
&& you can trap for errors with no number here
&& but I haven't gotten that far yet

OTHERWISE
SET COLOR TO W+
@ 10,10 TO 15,70 double
@ 11,12 SAY ' An unanticipated dBASE error has occurred... '
@ 12,12 SAY 'It is suggested that you get in touch with ALLMINE '
@ 13,12 SAY 'and to find out how to keep the error from re-occurring.'
@ 14,12 SAY 'Please wait while an error description file is created...'
SET COLOR TO
WAIT
ENDCASE


SET CONS OFF
err_file = 'E'+REPLICATE('0',2-LEN(LTRIM(STR(DAY(DATE()),2)))) +LTRIM(STR(DAY(DATE()),2))+SUBSTR(TIME(),1,2) +SUBSTR(TIME(),4,2)+SUBSTR(TIME(),7,1)+'.ERR'
SET ALTERNATE TO &err_file
SET ALTERNATE ON
?DATE()
?TIME()
?
eq = REPLICATE('=',50)
?eq
?' History listing'
?eq
LIST History
?eq
?' Status listing'
?eq
LIST STATUS
?eq
?' Memory listing'
?eq
LIST MEMO
?'bof=',BOF()
?'eof=',EOF()
?'rec. no.=',RECNO()
?'diskspace=',DISKSPACE()
?'os=',OS()
?'ver=',VERSION()
?'error number=',ERROR()
?'error message=',MESSAGE()
DO WHILE AT(e_option,'XR') = 0
e_option = ' '
set color to w+
@17,14 SAY 'eturn to where you were or eit to Main Menu?' GET E_option PICTURE '!'
set color to
READ
ENDDO
CLOSE ALTERNATE
SET CONS ON
SET COLOR TO W+
@17,6 SAY 'The error file is '+err_file+'...please make a note..press any key.'
SET COLOR TO
READ
* ON ERROR && DO ON_ERR
SET Dohist ON
IF E_option = 'X'
CLOS DATA
SET DEVICE TO SCREEN
SET PRINT OFF
RETURN TO MASTER
ELSE
&BLANKMID
RETURN
RETRY
ENDIF

RETURN


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : ON_ERROR.ZIP
Filename : ON_ERR.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/