home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / ECHECK.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-04  |  13.9 KB  |  383 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : ECHECK.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : ERROR CHECK SUB ROUTINE
  9. '
  10. '****************************************************************************
  11. '  This program and those associated with it were written for use with Quick-
  12. '  Windows Advanced (Version 1.5+).  Possesion of this program entitles you
  13. '  to certain priviliges.  They are:
  14. '
  15. '     1. You may compile, use, or modify this program in any way you choose
  16. '        provided you do not sell or give away the source code to this prog-
  17. '        ram or any of it's companions to anyone for any reason.  You may,
  18. '        however, sell the resulting executable program as you see fit.
  19. '
  20. '     2. You may modify, enhance or change these programs as you see fit. I
  21. '        as that you keep a copy of the original code and that you notify
  22. '        me of any improvements you make.  I like to think that the code is
  23. '        bug free and cannot be improved upon, but I'm sure someone will
  24. '        find a way to make it better.  If it's you, I'm looking forward to
  25. '        seeing your changes.  I can be reached at:
  26. '
  27. '              Tim Beck                      Tim Beck (C/O Debbie Beck)
  28. '              19419 Franz Road              8030 Fairchild Avenue
  29. '              Houston, Texas  77084         Canoga Park, California 91306
  30. '              (713) 639-3079                (818) 998-0588
  31. '
  32. '     3. This code has been tested and re-tested in a variety of applications
  33. '        and although I have not found any bugs, doesn't mean none exist. So,
  34. '        this program along with it's companions comes with NO WARRANTY,
  35. '        either expressed or implied.  I'm sorry if there are problems, but
  36. '        I can't be responsible for your work.  I've tried to provide a safe
  37. '        and efficient programming enviroment and I hope you find it helpful
  38. '        for you.  I do, however, need to cover my butt!
  39. '
  40. '  I have enjoyed creating this library of programs and have found them to be
  41. '  a great time saver.  I hope you agree.
  42. '
  43. '                                                            Tim Beck //
  44. '
  45. '****************************************************************************
  46.   
  47.    DECLARE SUB ERROR.CHECK (Error.Number%, Location%, Error.Count%, Abort.Code%, Resume.Code%, Status%)
  48.  
  49.   '--------------------------------------------------------------------------
  50.   '   Display an Error Message in the Center of the Screen (Uses MESSAGEBOX)
  51.   '
  52.   '   Error.Number%  = ERR (BASIC Error Number)
  53.   '   Location%      = ERL (BASIC Error Line)
  54.   '   Error.Count%   = Number of Errors that have occured ... Resets if
  55.   '                    Last Error <> Current Error
  56.   '   Abort.Code%    = Determines whether or not application should
  57.   '                    automatically Abort (0 = NO, 1 = YES)
  58.   '   Resume.Code%   = Type of Resume (0=NONE, 1=RESUME, 2=NEXT, 3=EXIT)
  59.   '   Status%        = Reports whether or not operation was successful (0,1)
  60.   '
  61.   '   Example:
  62.   '
  63.   'echeck:
  64.   '
  65.   '  CALL ERROR.CHECK(ERR, ERL, Error.Count%, Abort.Code%, Resume.Code%, status%)
  66.   '  IF Abort.Code% = 0 THEN
  67.   '     IF Resume.Code% = 0 THEN
  68.   '        SYSTEM
  69.   '     ELSEIF Resume.Code% = 1 THEN
  70.   '        RESUME
  71.   '     ELSEIF Resume.Code% = 2 THEN
  72.   '        RESUME exit.label
  73.   '     ELSEIF Resume.Code% = 3 THEN
  74.   '        RESUME NEXT
  75.   '     END IF
  76.   '  ELSE
  77.   '     SYSTEM
  78.   '  END IF
  79.  
  80.    REM $INCLUDE: 'STDCOM.INC'
  81.  
  82.    TIMER OFF 'Enables event trapping
  83.   
  84.  
  85. SUB ERROR.CHECK (Error.Number%, Location%, Error.Count%, Abort.Code%, Resume.Code%, Status%) STATIC
  86.  
  87.    Status% = 0
  88.    button1$ = ""
  89.    button2$ = ""
  90.    button3$ = ""
  91.    Resume.Code% = 0
  92.  
  93.    IF Error.Number% <> Last.Error% THEN
  94.       Error.Count% = 0
  95.    END IF
  96.  
  97.    SELECT CASE Error.Number%
  98.       CASE 1 TO 4
  99.          Error.Count% = Error.Count% + 1
  100.          msg$ = " Internal Program Error ~ The Programmer Goofed! "
  101.          Msg.Lines% = 2
  102.          Msg.Width% = LEN(msg$) / 2
  103.          Msg.Type% = 1
  104.          Abort.Code% = 0
  105.          button1$ = " OK "
  106.       CASE 5
  107.          Error.Count% = Error.Count% + 1
  108.          msg$ = "        Illegal Function Call       ~ I'm so confused?  Wanna try again? "
  109.          Msg.Lines% = 2
  110.          Msg.Width% = LEN(msg$) / 2
  111.          Msg.Type% = 2
  112.          Abort.Code% = 0
  113.          button1$ = " Retry "
  114.          button2$ = " Abort "
  115.       CASE 6
  116.          Error.Count% = Error.Count% + 1
  117.          msg$ = " A Number is too large to Process "
  118.          Msg.Lines% = 1
  119.          Msg.Width% = LEN(msg$)
  120.          Msg.Type% = 2
  121.          Abort.Code% = 0
  122.          button1$ = " Retry "
  123.          button2$ = " Abort "
  124.       CASE 7
  125.          Error.Count% = Error.Count% + 1
  126.          msg$ = " Out of Memory.  Exiting "
  127.          Msg.Lines% = 1
  128.          Msg.Width% = LEN(msg$)
  129.          Msg.Type% = 1
  130.          Abort.Code% = 1
  131.          button1$ = " Ok to Exit "
  132.       CASE 11
  133.          Error.Count% = Error.Count% + 1
  134.          msg$ = "      Division by Zero!     ~   It's blowing my mind!    "
  135.          Msg.Lines% = 2
  136.          Msg.Width% = LEN(msg$) / 2
  137.          Msg.Type% = 2
  138.          Abort.Code% = 0
  139.          button1$ = " Retry "
  140.          button2$ = " Abort "
  141.       CASE 14
  142.          Error.Count% = Error.Count% + 1
  143.          msg$ = "   Out of String Space!      ~ May not be able to continue "
  144.          Msg.Lines% = 2
  145.          Msg.Width% = LEN(msg$) / 2
  146.          Msg.Type% = 2
  147.          Abort.Code% = 0
  148.          button1$ = " Retry "
  149.          button2$ = " Abort "
  150.       CASE 17, 19
  151.          Error.Count% = Error.Count% + 1
  152.          msg$ = " Sorry. I tried, but I'm unable to continue! "
  153.          Msg.Lines% = 1
  154.          Msg.Width% = LEN(msg$)
  155.          Msg.Type% = 1
  156.          Abort.Code% = 0
  157.          button1$ = " OK to Exit "
  158.       CASE 20
  159.          Error.Count% = Error.Count% + 1
  160.          msg$ = " How'd I get here?  There's been no error "
  161.          Msg.Lines% = 1
  162.          Msg.Width% = LEN(msg$)
  163.          Msg.Type% = 2
  164.          Abort.Code% = 0
  165.          button1$ = " Retry "
  166.          button2$ = " Abort "
  167.       CASE 24
  168.          Error.Count% = Error.Count% + 1
  169.          msg$ = " Timeout.  Would you like to try again? "
  170.          Msg.Lines% = 1
  171.          Msg.Width% = LEN(msg$)
  172.          Msg.Type% = 2
  173.          Abort.Code% = 0
  174.          button1$ = " Yes, try Again "
  175.          button2$ = " No, give it up "
  176.       CASE 25
  177.          Error.Count% = Error.Count% + 1
  178.          msg$ = " Device Fault!  It's not working ... "
  179.          Msg.Lines% = 1
  180.          Msg.Width% = LEN(msg$)
  181.          Msg.Type% = 2
  182.          Abort.Code% = 0
  183.          button1$ = " Retry "
  184.          button2$ = " Abort "
  185.       CASE 27
  186.          Error.Count% = Error.Count% + 1
  187.          msg$ = "        Out of Paper!        ~ Would you like to add more? "
  188.          Msg.Lines% = 2
  189.          Msg.Width% = LEN(msg$) / 2
  190.          Msg.Type% = 2
  191.          Abort.Code% = 0
  192.          button1$ = " Continue "
  193.          button2$ = "   Stop   "
  194.       CASE 50
  195.          Error.Count% = Error.Count% + 1
  196.          msg$ = "        Field Overflow!       ~ There's something wrong with ~      that data file ...      "
  197.          Msg.Lines% = 3
  198.          Msg.Width% = LEN(msg$) / 3
  199.          Msg.Type% = 2
  200.          Abort.Code% = 0
  201.          button1$ = " Retry "
  202.          button2$ = " Abort "
  203.       CASE 52
  204.          Error.Count% = Error.Count% + 1
  205.          msg$ = "   Bad File Name/Number!     ~ Would you like to try again? "
  206.          Msg.Lines% = 2
  207.          Msg.Width% = LEN(msg$) / 2
  208.          Msg.Type% = 2
  209.          Abort.Code% = 0
  210.          button1$ = " Retry "
  211.          button2$ = " Abort "
  212.        CASE 53
  213.          Error.Count% = Error.Count% + 1
  214.          msg$ = "  Couldn't find that one!   ~ Want to enter another one? "
  215.          Msg.Lines% = 2
  216.          Msg.Width% = LEN(msg$) / 2
  217.          Msg.Type% = 2
  218.          Abort.Code% = 0
  219.          button1$ = " Retry "
  220.          button2$ = " Abort "
  221.       CASE 54
  222.          Error.Count% = Error.Count% + 1
  223.          msg$ = "          Bad File Mode!         ~ The Programmer screwed up Again "
  224.          Msg.Lines% = 2
  225.          Msg.Width% = LEN(msg$) / 2
  226.          Msg.Type% = 2
  227.          Abort.Code% = 0
  228.          button1$ = " Retry "
  229.          button2$ = " Abort "
  230.       CASE 55
  231.          Error.Count% = Error.Count% + 1
  232.          msg$ = " Attempt to re-open an open file! ~ I'm unable to continue. Aborting "
  233.          Msg.Lines% = 2
  234.          Msg.Width% = LEN(msg$) / 2
  235.          Msg.Type% = 1
  236.          Abort.Code% = 0
  237.          button1$ = " OK "
  238.       CASE 57, 72
  239.          Error.Count% = Error.Count% + 1
  240.          msg$ = " Data Error found during Input/Output "
  241.          Msg.Lines% = 1
  242.          Msg.Width% = LEN(msg$)
  243.          Msg.Type% = 3
  244.          Resume.Code% = 0
  245.          button1$ = " Retry "
  246.          button2$ = " Abort "
  247.          button3$ = " Ignore "
  248.       CASE 58
  249.          Error.Count% = Error.Count% + 1
  250.          msg$ = " Found Another with the same name ~    Want to enter another name?   "
  251.          Msg.Lines% = 2
  252.          Msg.Width% = LEN(msg$) / 2
  253.          Msg.Type% = 3
  254.          Abort.Code% = 0
  255.          button1$ = "   Yes  "
  256.          button2$ = "   No   "
  257.          button3$ = " Ovrwrt "
  258.       CASE 61
  259.          Error.Count% = Error.Count% + 1
  260.          msg$ = "      Your Disk is Full!     ~   I'm unable to continue.   ~  Press [Enter] to Exit Now. "
  261.          Msg.Lines% = 3
  262.          Msg.Width% = LEN(msg$) / 3
  263.          Msg.Type% = 1
  264.          Abort.Code% = 0
  265.          button1$ = " Exit Program "
  266.       CASE 62
  267.          Error.Count% = Error.Count% + 1
  268.          msg$ = " Attempted to Read More than was there! "
  269.          Msg.Lines% = 1
  270.          Msg.Width% = LEN(msg$)
  271.          Msg.Type% = 3
  272.          Abort.Code% = 0
  273.          button1$ = " Retry "
  274.          button2$ = " Abort "
  275.          button3$ = " Ignore "
  276.       CASE 67
  277.          Error.Count% = Error.Count% + 1
  278.          msg$ = "       Too many files are open.       ~ Check your CONFIG.SYS and try again. "
  279.          Msg.Lines% = 2
  280.          Msg.Width% = LEN(msg$) / 2
  281.          Msg.Type% = 2
  282.          Abort.Code% = 0
  283.          button1$ = " Retry "
  284.          button2$ = " Abort "
  285.       CASE 68
  286.          Error.Count% = Error.Count% + 1
  287.          msg$ = " DOS reports that the Device isn't Available ~      Is everything connected properly?      "
  288.          Msg.Lines% = 2
  289.          Msg.Width% = LEN(msg$) / 2
  290.          Msg.Type% = 2
  291.          Abort.Code% = 0
  292.          button1$ = " Retry "
  293.          button2$ = " Abort "
  294.       CASE 69
  295.          Error.Count% = Error.Count% + 1
  296.          msg$ = " Wow!  There's too much Data for me!  ~ Slow down the communications, Please "
  297.          Msg.Lines% = 2
  298.          Msg.Width% = LEN(msg$) / 2
  299.          Msg.Type% = 2
  300.          Abort.Code% = 0
  301.          Resume.Code% = 0
  302.          button1$ = " Retry "
  303.          button2$ = " Abort "
  304.       CASE 70
  305.          Error.Count% = Error.Count% + 1
  306.          msg$ = "        Permission Denied!        ~ What're you trying to do anyway? "
  307.          Msg.Lines% = 2
  308.          Msg.Width% = LEN(msg$) / 2
  309.          Msg.Type% = 2
  310.          Abort.Code% = 0
  311.          button1$ = " Retry "
  312.          button2$ = " Abort "
  313.       CASE 71
  314.          Error.Count% = Error.Count% + 1
  315.          msg$ = "    Your disk isn't ready.    ~ Would you like to try again? "
  316.          Msg.Lines% = 2
  317.          Msg.Width% = LEN(msg$) / 2
  318.          Msg.Type% = 2
  319.          Abort.Code% = 0
  320.          button1$ = " Retry "
  321.          button2$ = " Abort "
  322.       CASE 74
  323.          Error.Count% = Error.Count% + 1
  324.          msg$ = "         Attempt to Rename across Disks!        ~ Don't you know you're not supposed to do that? "
  325.          Msg.Lines% = 2
  326.          Msg.Width% = LEN(msg$) / 2
  327.          Msg.Type% = 2
  328.          Abort.Code% = 0
  329.          button1$ = " Retry "
  330.          button2$ = " Abort "
  331.       CASE 75
  332.          Error.Count% = Error.Count% + 1
  333.          msg$ = "     Path/File Access Error.     ~ Check your entry and try again. "
  334.          Msg.Lines% = 2
  335.          Msg.Width% = LEN(msg$) / 2
  336.          Msg.Type% = 1
  337.          Abort.Code% = 0
  338.          button1$ = " OK "
  339.       CASE 76
  340.          Error.Count% = Error.Count% + 1
  341.          msg$ = "         Path not found.         ~ Check your entry and try again. "
  342.          Msg.Lines% = 2
  343.          Msg.Width% = LEN(msg$) / 2
  344.          Msg.Type% = 2
  345.          Abort.Code% = 0
  346.          button1$ = " Retry "
  347.          button2$ = " Abort "
  348.       CASE 8 TO 10, 12, 13, 16, 18, 26, 28, 29, 30, 33, 35, 37, 38, 39, 40, 51, 56, 59, 73
  349.          Error.Count% = Error.Count% + 1
  350.          msg$ = "            Memory Overflow Error!           ~ Commence Immeditate Shutdown of all systems "
  351.          Msg.Lines% = 2
  352.          Msg.Width% = LEN(msg$) / 2
  353.          Msg.Type% = 1
  354.          Abort.Code% = 1
  355.          button1$ = " OK "
  356.       CASE ELSE
  357.          msg$ = " Unknown Error.  Attempt to Resume? "
  358.          Msg.Width% = LEN(msg$)
  359.          Msg.Lines% = 1
  360.          Msg.Type% = 2
  361.          button1$ = " Continue "
  362.          button2$ = " Abort "
  363.    END SELECT
  364.  
  365.    IF Error.Count% > 3 OR Abort.Code% = 1 THEN
  366.       Error.Count% = 0
  367.       Abort.Code% = 1
  368.       EXIT SUB
  369.    ELSEIF Msg.Type% = 1 THEN
  370.       CALL MESSAGEBOX(button1$, 1 + Sh.Flag% + EX.Flag%, HB.attr%, msg$, Msg.Lines%, Msg.Width%, DE.attr%, Resume.Code%, msg.array%())
  371.    ELSEIF Msg.Type% = 2 THEN
  372.       CALL MESSAGEBOX2(button1$, button2$, 1 + Sh.Flag% + EX.Flag%, HB.attr%, msg$, Msg.Lines%, Msg.Width%, DE.attr%, Resume.Code%, msg.array%())
  373.    ELSEIF Msg.Type% = 3 THEN
  374.       CALL MESSAGEBOX3(button1$, button2$, button3$, 1 + Sh.Flag% + EX.Flag%, HB.attr%, msg$, Msg.Lines%, Msg.Width%, DE.attr%, Resume.Code%, msg.array%())
  375.    END IF
  376.  
  377.    IF ERR = 1 OR ERR = 2 OR ERR = 3 OR ERR = 4 OR ERR = 7 OR ERR = 17 OR ERR = 19 OR ERR = 55 OR ERR = 61 OR ERR = 65 THEN
  378.       Resume.Code% = 2           'Sets Resume code to Exit
  379.    END IF
  380.          
  381. END SUB
  382.  
  383.