home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / exitcode / exitcode.bas < prev    next >
Encoding:
BASIC Source File  |  1994-01-19  |  2.9 KB  |  105 lines
  1. '***************************EXITCODE.BAS*********************************
  2. 'JRD NOTE:
  3. 'With this code you can set an ERRORLEVEL when you exit your QuickBASIC
  4. '4.5 program.
  5. '
  6. 'I've been looking for this technique to use in QuickBASIC 4.5 for
  7. 'years.... but it was there all the time by using CALL interrupt.
  8. 'I know you can do this with PDS 7.1 and VisualBASIC for DOS, with
  9. '
  10. 'END Exitcode% Statement
  11. '                                 but....
  12. '
  13. 'I wanted to know -where- the COMMAND.COM got that ERRORLEVEL number from
  14. 'Now I know...
  15. '
  16. '&H21 Interrupt, Service 4CH is the "Terminate with return code"
  17. 'We try it to exit and set an ERRORLEVEL.
  18. '
  19. 'WOW! if you run this in the QuickBASIC Environment....
  20. '
  21. '                          All HELL breaks loose!
  22. '
  23. 'So....DON'T DO IT.... Remember you were warned. This overwrites ROM,
  24. 'some how messes up LPT1, and does other weird things.... INCLUDING
  25. 'causing the cursor to disappear if you run the executable code,
  26. 'EXITCODE.EXE from a batch file and don't set the cursor as this program
  27. 'does.
  28. '
  29. 'BUT.... the good news is.... IT WORKS.
  30. '
  31. 'I made BATCH.BAT to be used with this. It is a true blue
  32. 'IF ERRORLEVEL batch file
  33. 'need to make SURE you slap some code for the cursor. Need nothing more
  34. 'than the following to prevent the cursor from disappearing:
  35. '
  36. 'LOCATE , , 1 ,4 ,7
  37. '
  38. 'John De Palma on CompuServe 76076,571
  39. '1/19/94
  40. '
  41. '=============================END OF TEXT=============================
  42. '
  43. 'declarations, etc.
  44. DEFINT A-Z
  45.  
  46. TYPE RegType
  47.      ax        AS INTEGER
  48.      bx        AS INTEGER
  49.      cx        AS INTEGER
  50.      dx        AS INTEGER
  51.      bp        AS INTEGER
  52.      si        AS INTEGER
  53.      di        AS INTEGER
  54.      flags     AS INTEGER
  55.      ds        AS INTEGER
  56.      es        AS INTEGER
  57. END TYPE
  58.  
  59. DECLARE SUB INTERRUPT (IntNum AS INTEGER, InRegs AS RegType, OutRegs AS RegType)
  60. DECLARE SUB LocateIt (row%, text$)
  61. DECLARE SUB ColorIt (Fgd%, Bgd%)
  62.  
  63. 'executable code comes next
  64. COLOR 15, 1
  65. CLS
  66. text$ = "TYPE: an Exit Code (1 to 10) to test"
  67. CALL LocateIt(10, text$)
  68. text$ = SPACE$(2)
  69. CALL ColorIt(11, 0)
  70. CALL LocateIt(11, text$)
  71. row = CSRLIN
  72. col = POS(0)
  73.  
  74. LOCATE row, col - 2, 1, 4, 7
  75. INPUT "", ExitCode%
  76. CALL ColorIt(15, 1)
  77. text$ = "Setting ERRORLEVEL TO: " + STR$(ExitCode%)
  78. CALL LocateIt(13, text$)
  79. PRINT
  80. DIM Regs AS RegType
  81.        
  82.     Regs.ax = &H4C00 + ExitCode%                'AH = 4C; AL = ExitCode%
  83.  
  84. '           ┌───────────────────────────────────────┐
  85. '           │     * * * * D A N G E R * * * *       │
  86. '           └───────────────────────────────────────┘
  87.  
  88. '  DO =NOT= run the CALL INTERRUPT in the QuickBASIC environment!!!!!!
  89.       
  90.     CALL INTERRUPT(&H21, Regs, Regs)
  91.    
  92.     'the next never gets printed as we are out of here
  93.     text$ = "Return Code is: " + STR$(Regs.ax MOD 256)
  94.         CALL LocateIt(15, text$)
  95.  
  96. SUB ColorIt (Fgd, Bgd)
  97. COLOR Fgd, Bgd
  98. END SUB
  99.  
  100. SUB LocateIt (row%, text$)
  101. LOCATE row%, 41 - (LEN(text$) \ 2)
  102. PRINT text$;
  103. END SUB
  104.  
  105.