home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBLIST10.ZIP / QBLIST.LST < prev    next >
Encoding:
File List  |  1992-10-26  |  26.7 KB  |  803 lines
  1.  
  2.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   1
  3.                              QBLIST.BAS (Main Module) Page   1
  4.           --------------------------------------------------------------------------------
  5.  
  6.           DECLARE SUB DataStmtLine ()
  7.           DECLARE SUB PressAKey ()
  8.           DECLARE SUB ListFunc ()
  9.           DECLARE SUB ListSubs ()
  10.           DECLARE SUB FunctionList ()
  11.           DECLARE SUB WriteLine ()
  12.           DECLARE SUB SplitLine ()
  13.           DECLARE SUB MainRoutine ()
  14.           DECLARE SUB EojRoutine ()
  15.           DECLARE SUB EndOfList ()
  16.           DECLARE SUB MainModuleList ()
  17.           DECLARE SUB SubRoutineList ()
  18.           DECLARE SUB CompleteList ()
  19.           DECLARE SUB WaitforAnswer (A$)
  20.           DECLARE SUB ScreenTitle ()
  21.           DECLARE SUB SubTitle ()
  22.           DECLARE SUB MainModule ()
  23.           DECLARE SUB ProgramTitle ()
  24.           DECLARE SUB OpenFiles ()
  25.           
  26.           COMMON SHARED Line$, FileName$, SubName$, Today$, TheTime$, FullPageCount
  27.           COMMON SHARED SubPageCount, LineCount, SubRoutineType, SubType$
  28.           COMMON SHARED Line1$, Line2$, Line3$, Line4$, LineLen
  29.           
  30.           REM **********************************
  31.           REM * Set Printer To 12 CPI at 8 LPI *
  32.           REM **********************************
  33.           
  34.           ON ERROR GOTO ErrorHandler
  35.           
  36.           Today$ = DATE$
  37.           TheTime$ = TIME$
  38.           
  39.           Redo:
  40.           
  41.           CALL MainRoutine
  42.           
  43.           ErrorHandler:
  44.           SOUND 1000, 2
  45.           PRINT
  46.           ErrorCode = ERR
  47.           SELECT CASE ErrorCode
  48.            CASE 64
  49.             PRINT "Bad File Name ==> "; FileName$; " <=="
  50.             INPUT "Please Press Any Key To Continue"; A$
  51.             RESUME Redo
  52.            CASE 53
  53.             PRINT "File Not Found ==> "; FileName$; " <=="
  54.             INPUT "Please Press Any Key To Continue"; A$
  55.             RESUME Redo
  56.            CASE ELSE
  57.             PRINT "ERROR CODE = "; ErrorCode
  58.             PRINT "ErrorHandler Not Setup For This Error"
  59.             INPUT "Please Press Any Key To Continue"; A$
  60.             CALL EojRoutine
  61.           END SELECT
  62.           
  63.           END
  64.           
  65.  
  66.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   2
  67.                              CompleteList (Sub Routine) Page   1
  68.           --------------------------------------------------------------------------------
  69.  
  70.           SUB CompleteList
  71.           
  72.           START$ = "Y"
  73.           
  74.           DO
  75.            LINE INPUT #1, Line$
  76.            LinesRead = LinesRead + 1
  77.             IF LEFT$(Line$, 4) = "SUB " THEN
  78.               NamePosition = 5
  79.               GOSUB GetSubName
  80.               CALL ProgramTitle
  81.               SubPageCount = 1
  82.               SubRoutineType = 2
  83.               CALL SubTitle
  84.               START$ = "N"
  85.             ELSEIF LEFT$(Line$, 8) = "FUNCTION" THEN
  86.               NamePosition = 10
  87.               GOSUB GetSubName
  88.               CALL ProgramTitle
  89.               SubPageCount = 1
  90.               SubRoutineType = 3
  91.               CALL SubTitle
  92.               START$ = "N"
  93.             ELSEIF (LEFT$(Line$, 4) <> "SUB " OR LEFT$(Line$, 8) <> "FUNCTION") AND 
  94.     <<*>> START$ = "Y" THEN
  95.                SubPageCount = 1
  96.                CALL ProgramTitle
  97.                SubName$ = FileName$
  98.                SubRoutineType = 1
  99.                CALL SubTitle
  100.                START$ = "N"
  101.             END IF
  102.           START$ = "N"
  103.           CALL WriteLine
  104.           LOOP WHILE NOT EOF(1)
  105.           
  106.           PRINT #2, CHR$(12)
  107.           CLOSE #1, #2
  108.           CALL EndOfList
  109.           CALL MainRoutine
  110.           
  111.           GetSubName:
  112.             
  113.           SpacePos = INSTR(NamePosition, Line$, " ")
  114.            IF SpacePos = 0 THEN
  115.               SpacePos = LEN(Line$)
  116.               SpacePos = SpacePos - (NamePosition - 1)
  117.               SubName$ = MID$(Line$, NamePosition, SpacePos)
  118.            ELSEIF SpacePos > 0 AND NamePosition = 5 THEN
  119.               SpacePos = SpacePos - 4
  120.               SubName$ = MID$(Line$, 5, SpacePos - 1)
  121.            ELSEIF SpacePos > 0 AND NamePosition = 10 THEN
  122.               SpacePos = SpacePos - 9
  123.               SubName$ = MID$(Line$, 10, SpacePos - 1)
  124.            END IF
  125.           RETURN
  126.           
  127.           END SUB
  128.           
  129.  
  130.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   3
  131.                              DataStmtLine (Sub Routine) Page   1
  132.           --------------------------------------------------------------------------------
  133.  
  134.           SUB DataStmtLine
  135.           
  136.           CommaPos = 0
  137.           LastComma = 0
  138.           SaveLastComma = 0
  139.           Line1$ = ""
  140.           Line2$ = ""
  141.           Line3$ = ""
  142.           Line4$ = ""
  143.           
  144.           DO
  145.             LastComma = INSTR(LastComma + 1, Line$, ",")
  146.             IF LastComma <> 0 THEN SaveLastComma = LastComma
  147.             IF LastComma <= 80 AND LastComma <> 0 THEN CommaPos = SaveLastComma
  148.           LOOP UNTIL LastComma = 0
  149.           Line1$ = LEFT$(Line$, CommaPos)
  150.           
  151.           IF LineLen > 80 AND LineLen <= 160 THEN
  152.              Line2$ = MID$(Line$, CommaPos + 1, LineLen - CommaPos)
  153.              EXIT SUB
  154.           END IF
  155.           LastComma = 0
  156.           Temp$ = MID$(Line$, CommaPos + 1, LineLen - CommaPos)
  157.           DO
  158.             LastComma = INSTR(LastComma + 1, Temp$, ",")
  159.             IF LastComma <> 0 THEN SaveLastComma = LastComma
  160.             IF LastComma <= 80 AND LastComma <> 0 THEN CommaPos = SaveLastComma
  161.           LOOP UNTIL LastComma = 0
  162.           Line2$ = LEFT$(Temp$, CommaPos)
  163.           LastComma = 0
  164.           
  165.           IF LineLen > 160 AND LineLen <= 240 THEN
  166.              Line3$ = MID$(Temp$, CommaPos + 1, LineLen - CommaPos)
  167.              EXIT SUB
  168.           END IF
  169.           LastComma = 0
  170.           Temp$ = MID$(Temp$, CommaPos + 1, LineLen - CommaPos)
  171.           DO
  172.             LastComma = INSTR(LastComma + 1, Temp$, ",")
  173.             IF LastComma <> 0 THEN SaveLastComma = LastComma
  174.             IF LastComma <= 80 AND LastComma <> 0 THEN CommaPos = SaveLastComma
  175.           LOOP UNTIL LastComma = 0
  176.           Line3$ = LEFT$(Temp$, CommaPos)
  177.           LastComma = 0
  178.           
  179.           IF LineLen > 240 AND LineLen <= 255 THEN
  180.              Line4$ = MID$(Temp$, CommaPos + 1, LineLen - LastComma)
  181.              EXIT SUB
  182.           END IF
  183.           LastComma = 0
  184.           Temp$ = MID$(Temp$, CommaPos + 1, LineLen - CommaPos)
  185.           DO
  186.             LastComma = INSTR(LastComma + 1, Temp$, ",")
  187.             IF LastComma <> 0 THEN SaveLastComma = LastComma
  188.             IF LastComma <= 80 AND LastComma <> 0 THEN CommaPos = SaveLastComma
  189.           LOOP UNTIL LastComma = 0
  190.           Line4$ = LEFT$(Temp$, CommaPos)
  191.           
  192.           END SUB
  193.           
  194.  
  195.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   4
  196.                              EndOfList (Sub Routine) Page   1
  197.           --------------------------------------------------------------------------------
  198.  
  199.           SUB EndOfList
  200.           
  201.           LOCATE 20, 12, 0
  202.           PRINT "===> End Of List, Please Press Any Key To Continue <==="
  203.           SOUND 1000, 2
  204.           CALL WaitforAnswer(A$)
  205.           
  206.           END SUB
  207.           
  208.  
  209.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   5
  210.                              EojRoutine (Sub Routine) Page   1
  211.           --------------------------------------------------------------------------------
  212.  
  213.           SUB EojRoutine
  214.           
  215.           CLOSE #1, #2
  216.           CLS
  217.           SYSTEM
  218.           
  219.           END SUB
  220.           
  221.  
  222.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   6
  223.                              FunctionList (Sub Routine) Page   1
  224.           --------------------------------------------------------------------------------
  225.  
  226.           SUB FunctionList
  227.           
  228.           StartFunc:
  229.           CALL ScreenTitle
  230.           DO
  231.           LOCATE 6, 1
  232.           PRINT "Please Enter Function To List"
  233.           PRINT "(L)ist To List Functions"
  234.           INPUT "Or (Q)uit to End ==> "; FuncTofind$
  235.           LOOP WHILE FuncTofind$ = ""
  236.           IF UCASE$(FuncTofind$) = "QUIT" OR UCASE$(FuncTofind$) = "Q" THEN
  237.            CALL EndOfList
  238.            CALL MainRoutine
  239.           END IF
  240.           IF UCASE$(FuncTofind$) = "LIST" OR UCASE$(FuncTofind$) = "L" THEN
  241.            CALL ListFunc
  242.            CALL EndOfList
  243.            CALL MainRoutine
  244.           END IF
  245.           
  246.           LineCount = 4
  247.           FoundFunc$ = "N"
  248.           
  249.           FindFunc:
  250.           DO
  251.              LINE INPUT #1, Line$
  252.              IF LEFT$(Line$, 8) = "FUNCTION" THEN GOSUB FoundFunc
  253.           LOOP UNTIL EOF(1) OR FoundFunc$ = "Y"
  254.           
  255.           IF FoundFunc$ = "Y" THEN
  256.             PRINT #2, CHR$(12)
  257.             CLOSE #1, #2
  258.             CALL EndOfList
  259.             CALL MainRoutine
  260.           END IF
  261.           
  262.           IF FoundFunc$ = "N" THEN
  263.             PRINT SPC(10); "===> FUNCTION "; UCASE$(FuncTofind$); " Not Found <==="
  264.             SOUND 1000, 2
  265.             PRINT "Please Press Any Key To Continue"
  266.             CALL WaitforAnswer(A$)
  267.             CLOSE #1, #2
  268.             CALL OpenFiles
  269.             GOTO StartFunc
  270.           END IF
  271.           
  272.           FoundFunc:
  273.             SpacePos = INSTR(10, Line$, " ")
  274.             IF SpacePos = 0 THEN
  275.                SpacePos = LEN(Line$)
  276.                SpacePos = SpacePos - 9
  277.                FuncName$ = MID$(Line$, 10, SpacePos)
  278.             ELSEIF SpacePos > 0 THEN
  279.                SpacePos = SpacePos - 9
  280.                FuncName$ = MID$(Line$, 10, SpacePos - 1)
  281.             END IF
  282.             IF UCASE$(FuncName$) = UCASE$(FuncTofind$) THEN
  283.               CALL ProgramTitle
  284.               SubRoutineType = 3
  285.               SubName$ = FuncName$
  286.               CALL SubTitle
  287.               FoundFunc$ = "Y"
  288.               GOSUB PrintFunc
  289.             END IF
  290.           RETURN
  291.           
  292.           PrintFunc:
  293.             DO
  294.               CALL WriteLine
  295.               LINE INPUT #1, Line$
  296.             LOOP UNTIL LEFT$(Line$, 4) = "SUB " OR LEFT$(Line$, 8) = "FUNCTION" OR EOF(1)
  297.           RETURN
  298.           
  299.           END SUB
  300.           
  301.  
  302.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   7
  303.                              ListFunc (Sub Routine) Page   1
  304.           --------------------------------------------------------------------------------
  305.  
  306.           SUB ListFunc
  307.           
  308.           X = 1
  309.           GOSUB FuncHeading
  310.           FuncFound$ = "N"
  311.           
  312.           DO
  313.             LINE INPUT #1, Line$
  314.             IF LEFT$(Line$, 8) = "FUNCTION" THEN
  315.               GOSUB ListFunc
  316.               FuncFound$ = "Y"
  317.             END IF
  318.           LOOP WHILE NOT EOF(1)
  319.           
  320.           IF FuncFound$ = "N" THEN PRINT SPC(31); "No Functions Found"
  321.           CALL EndOfList
  322.           CLOSE #1
  323.           OPEN FileName$ FOR INPUT AS #1
  324.           CALL FunctionList
  325.           
  326.           ListFunc:
  327.             SpacePos = INSTR(10, Line$, " ")
  328.             IF SpacePos = 0 THEN
  329.                SpacePos = LEN(Line$)
  330.                SpacePos = SpacePos - 9
  331.                FuncName$ = MID$(Line$, 10, SpacePos)
  332.             ELSEIF SpacePos > 0 THEN
  333.                    SpacePos = SpacePos - 9
  334.                    FuncName$ = MID$(Line$, 10, SpacePos - 1)
  335.             END IF
  336.           PRINT FuncName$
  337.           X = X + 1
  338.           IF X > 10 THEN
  339.             CALL PressAKey
  340.             GOSUB FuncHeading
  341.             X = 1
  342.           END IF
  343.           RETURN
  344.           
  345.           FuncHeading:
  346.             CALL ScreenTitle
  347.             PRINT SPC(31); "List Of Functions"
  348.             PRINT SPC(31); "-----------------"
  349.           RETURN
  350.           
  351.           END SUB
  352.           
  353.  
  354.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   8
  355.                              ListSubs (Sub Routine) Page   1
  356.           --------------------------------------------------------------------------------
  357.  
  358.           SUB ListSubs
  359.           
  360.           X = 1
  361.           GOSUB SubHeading
  362.           SubFound$ = "N"
  363.           
  364.           DO
  365.             LINE INPUT #1, Line$
  366.             IF LEFT$(Line$, 4) = "SUB " THEN
  367.               GOSUB ListSub
  368.               SubFound$ = "Y"
  369.             END IF
  370.           LOOP WHILE NOT EOF(1)
  371.           
  372.           IF SubFound$ = "N" THEN PRINT SPC(30); "No SubRoutines Found"
  373.           CALL EndOfList
  374.           CLOSE #1
  375.           OPEN FileName$ FOR INPUT AS #1
  376.           CALL SubRoutineList
  377.           
  378.           ListSub:
  379.             SpacePos = INSTR(5, Line$, " ")
  380.             IF SpacePos = 0 THEN
  381.                SpacePos = LEN(Line$)
  382.                SpacePos = SpacePos - 4
  383.                SubName$ = MID$(Line$, 5, SpacePos)
  384.             ELSEIF SpacePos > 0 THEN
  385.                    SpacePos = SpacePos - 4
  386.                    SubName$ = MID$(Line$, 5, SpacePos - 1)
  387.             END IF
  388.           PRINT SubName$
  389.           X = X + 1
  390.           IF X > 10 THEN
  391.             CALL PressAKey
  392.             GOSUB SubHeading
  393.             X = 1
  394.           END IF
  395.           RETURN
  396.           
  397.           SubHeading:
  398.             CALL ScreenTitle
  399.             PRINT SPC(30); "List Of SubRoutines"
  400.             PRINT SPC(30); "-------------------"
  401.           RETURN
  402.           
  403.           END SUB
  404.           
  405.  
  406.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page   9
  407.                              MainModuleList (Sub Routine) Page   1
  408.           --------------------------------------------------------------------------------
  409.  
  410.           SUB MainModuleList
  411.           
  412.           LineCount = 4
  413.           START$ = "Y"
  414.           SubName$ = FileName$
  415.           CALL ProgramTitle
  416.           SubRoutineType = 1
  417.           CALL SubTitle
  418.           
  419.           DO
  420.            LINE INPUT #1, Line$
  421.             IF LEFT$(Line$, 4) = "SUB " AND (START$ = "Y" OR START$ = "N") THEN
  422.               IF LEFT$(Line$, 8) = "FUNCTION" AND (START$ = "Y" OR START$ = "N") THEN
  423.                 PRINT #2, SPC(10); "No Main Module"
  424.                 CLOSE #1
  425.                 CALL EndOfList
  426.                 CALL MainRoutine
  427.               END IF
  428.             END IF
  429.           START$ = "N"
  430.           IF LEFT$(Line$, 4) = "SUB " OR LEFT$(Line$, 8) = "FUNCTION" THEN EXIT DO
  431.           CALL WriteLine
  432.           LOOP WHILE NOT EOF(1)
  433.           
  434.           PRINT #2, CHR$(12)
  435.           CLOSE #1, #2
  436.           CALL EndOfList
  437.           CALL MainRoutine
  438.           
  439.           END SUB
  440.           
  441.  
  442.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  10
  443.                              MainRoutine (Sub Routine) Page   1
  444.           --------------------------------------------------------------------------------
  445.  
  446.           SUB MainRoutine
  447.           
  448.           FullPageCount = 1
  449.           SubPageCount = 1
  450.           LineCount = 4
  451.           
  452.           CALL ScreenTitle
  453.           DO
  454.           LOCATE 6, 1
  455.           PRINT "Please Enter Program To List"
  456.           INPUT "Or (Q)uit To End ==> "; FileName$
  457.           LOOP WHILE FileName$ = ""
  458.           IF UCASE$(FileName$) = "QUIT" OR UCASE$(FileName$) = "Q" THEN CALL EojRoutine
  459.           FileName$ = UCASE$(FileName$ + ".BAS")
  460.           
  461.           CALL OpenFiles
  462.           
  463.           DO
  464.           CALL ScreenTitle
  465.           PRINT SPC(22); "(1) Complete": PRINT ""
  466.           PRINT SPC(22); "(2) Main Moudule": PRINT
  467.           PRINT SPC(22); "(3) SubRoutine": PRINT
  468.           PRINT SPC(22); "(4) Function": PRINT
  469.           PRINT SPC(22); "(5) Quit"
  470.           Retry:
  471.           LOCATE 16, 1
  472.           PRINT "Please Enter Type Of Listing You Want ==> "
  473.           LOCATE 16, 43, 1
  474.           CALL WaitforAnswer(A$)
  475.           Answer = VAL(A$)
  476.           LOCATE 16, 43, 1
  477.           PRINT A$
  478.           SELECT CASE Answer
  479.            CASE IS = 1
  480.              LOCATE 17, 1
  481.              PRINT "                          "
  482.              CALL CompleteList
  483.              CALL EndOfList
  484.            CASE IS = 2
  485.              LOCATE 17, 1
  486.              PRINT "                          "
  487.              CALL MainModuleList
  488.              CALL EndOfList
  489.            CASE IS = 3
  490.              CALL SubRoutineList
  491.              CALL EndOfList
  492.            CASE IS = 4
  493.              CALL FunctionList
  494.              CALL EndOfList
  495.            CASE IS = 5
  496.              CALL EojRoutine
  497.            CASE ELSE
  498.              LOCATE 17, 1
  499.              SOUND 1000, 2
  500.              PRINT "==> Invalid Selection <=="
  501.              GOTO Retry
  502.           END SELECT
  503.           LOOP
  504.           
  505.           END SUB
  506.           
  507.  
  508.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  11
  509.                              OpenFiles (Sub Routine) Page   1
  510.           --------------------------------------------------------------------------------
  511.  
  512.           SUB OpenFiles
  513.           
  514.           OPEN FileName$ FOR INPUT AS #1
  515.           DotPos = INSTR(FileName$, ".")
  516.           OutName$ = LEFT$(FileName$, DotPos - 1)
  517.           OutName$ = OutName$ + ".LST"
  518.           OPEN OutName$ FOR OUTPUT AS #2
  519.           
  520.           END SUB
  521.           
  522.  
  523.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  12
  524.                              PressAKey (Sub Routine) Page   1
  525.           --------------------------------------------------------------------------------
  526.  
  527.           SUB PressAKey
  528.           
  529.           LOCATE 20, 12, 0
  530.           PRINT "===> Please Press Any Key To Continue <==="
  531.           SOUND 1000, 2
  532.           CALL WaitforAnswer(A$)
  533.           
  534.           END SUB
  535.           
  536.  
  537.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  13
  538.                              ProgramTitle (Sub Routine) Page   1
  539.           --------------------------------------------------------------------------------
  540.  
  541.           SUB ProgramTitle
  542.           
  543.           PRINT #2, CHR$(12)
  544.           PRINT #2, SPC(10); "Program Listing Of "; FileName$;
  545.           PRINT #2, " As Of "; Today$; " At "; TheTime$;
  546.           PRINT #2, "            Page "; USING "###"; FullPageCount
  547.           FullPageCount = FullPageCount + 1
  548.           
  549.           END SUB
  550.           
  551.  
  552.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  14
  553.                              ScreenTitle (Sub Routine) Page   1
  554.           --------------------------------------------------------------------------------
  555.  
  556.           SUB ScreenTitle
  557.           
  558.           CLS
  559.           COLOR 15, 1
  560.           PRINT "DATE = "; DATE$;
  561.           LOCATE 1, 66
  562.           PRINT "TIME = "; TIME$
  563.           PRINT
  564.           PRINT SPC(22); "Qbasic Or QuickBasic Program Lister"
  565.           PRINT SPC(22); "-----------------------------------"
  566.           
  567.           END SUB
  568.           
  569.  
  570.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  15
  571.                              SplitLine (Sub Routine) Page   1
  572.           --------------------------------------------------------------------------------
  573.  
  574.           SUB SplitLine
  575.           
  576.           BlankPos = 0
  577.           LastBlank = 0
  578.           SaveLastBlank = 0
  579.           Line1$ = ""
  580.           Line2$ = ""
  581.           Line3$ = ""
  582.           Line4$ = ""
  583.           
  584.           DO
  585.             LastBlank = INSTR(LastBlank + 1, Line$, " ")
  586.             IF LastBlank <> 0 THEN SaveLastBlank = LastBlank
  587.             IF LastBlank <= 80 AND LastBlank <> 0 THEN BlankPos = SaveLastBlank
  588.           LOOP UNTIL LastBlank = 0
  589.           Line1$ = LEFT$(Line$, BlankPos)
  590.           
  591.           IF LineLen > 80 AND LineLen <= 160 THEN
  592.              Line2$ = MID$(Line$, BlankPos + 1, LineLen - BlankPos)
  593.              EXIT SUB
  594.           END IF
  595.           LastBlank = 0
  596.           Temp$ = MID$(Line$, BlankPos + 1, LineLen - BlankPos)
  597.           DO
  598.             LastBlank = INSTR(LastBlank + 1, Temp$, " ")
  599.             IF LastBlank <> 0 THEN SaveLastBlank = LastBlank
  600.             IF LastBlank <= 80 AND LastBlank <> 0 THEN BlankPos = SaveLastBlank
  601.           LOOP UNTIL LastBlank = 0
  602.           Line2$ = LEFT$(Temp$, BlankPos)
  603.           LastBlank = 0
  604.           
  605.           IF LineLen > 160 AND LineLen <= 240 THEN
  606.              Line3$ = MID$(Temp$, BlankPos + 1, LineLen - BlankPos)
  607.              EXIT SUB
  608.           END IF
  609.           LastBlank = 0
  610.           Temp$ = MID$(Temp$, BlankPos + 1, LineLen - BlankPos)
  611.           DO
  612.             LastBlank = INSTR(LastBlank + 1, Temp$, " ")
  613.             IF LastBlank <> 0 THEN SaveLastBlank = LastBlank
  614.             IF LastBlank <= 80 AND LastBlank <> 0 THEN BlankPos = SaveLastBlank
  615.           LOOP UNTIL LastBlank = 0
  616.           Line3$ = LEFT$(Temp$, BlankPos)
  617.           LastBlank = 0
  618.           
  619.           IF LineLen > 240 AND LineLen <= 255 THEN
  620.              Line4$ = MID$(Temp$, BlankPos + 1, LineLen - LastBlank)
  621.              EXIT SUB
  622.           END IF
  623.           LastBlank = 0
  624.           Temp$ = MID$(Temp$, BlankPos + 1, LineLen - BlankPos)
  625.           DO
  626.             LastBlank = INSTR(LastBlank + 1, Temp$, " ")
  627.             IF LastBlank <> 0 THEN SaveLastBlank = LastBlank
  628.             IF LastBlank <= 80 AND LastBlank <> 0 THEN BlankPos = SaveLastBlank
  629.           LOOP UNTIL LastBlank = 0
  630.           Line4$ = LEFT$(Temp$, BlankPos)
  631.           
  632.           END SUB
  633.           
  634.  
  635.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  16
  636.                              SubRoutineList (Sub Routine) Page   1
  637.           --------------------------------------------------------------------------------
  638.  
  639.           SUB SubRoutineList
  640.           
  641.           StartSub:
  642.           CALL ScreenTitle
  643.           DO
  644.           LOCATE 6, 1
  645.           PRINT "Please Enter SubRoutine To List"
  646.           PRINT "(L)ist To List SubRoutines"
  647.           INPUT "Or (Q)uit to End ==> "; SubToFind$
  648.           LOOP WHILE SubToFind$ = ""
  649.           IF UCASE$(SubToFind$) = "QUIT" OR UCASE$(SubToFind$) = "Q" THEN
  650.            CLOSE #1, #2
  651.            CALL EndOfList
  652.            CALL MainRoutine
  653.           END IF
  654.           IF UCASE$(SubToFind$) = "LIST" OR UCASE$(SubToFind$) = "L" THEN
  655.            CALL ListSubs
  656.           END IF
  657.           
  658.           LineCount = 4
  659.           FoundSub$ = "N"
  660.           
  661.           FindSub:
  662.           DO
  663.              LINE INPUT #1, Line$
  664.              IF LEFT$(Line$, 4) = "SUB " THEN GOSUB FoundSub
  665.           LOOP UNTIL EOF(1) OR FoundSub$ = "Y"
  666.           
  667.           IF FoundSub$ = "Y" THEN
  668.             PRINT #2, CHR$(12)
  669.             CLOSE #1, #2
  670.             CALL EndOfList
  671.             CALL MainRoutine
  672.           END IF
  673.           
  674.           IF FoundSub$ = "N" THEN
  675.             PRINT SPC(10); "===> Sub Routine "; UCASE$(SubToFind$); " Not Found <==="
  676.             SOUND 1000, 2
  677.             PRINT "Please Press Any Key To Continue"
  678.             CALL WaitforAnswer(A$)
  679.             CLOSE #1, #2
  680.             CALL OpenFiles
  681.             GOTO StartSub
  682.           END IF
  683.           
  684.           FoundSub:
  685.             SpacePos = INSTR(5, Line$, " ")
  686.             IF SpacePos = 0 THEN
  687.                SpacePos = LEN(Line$)
  688.                SpacePos = SpacePos - 4
  689.                SubName$ = MID$(Line$, 5, SpacePos)
  690.             ELSEIF SpacePos > 0 THEN
  691.                SpacePos = SpacePos - 4
  692.                SubName$ = MID$(Line$, 5, SpacePos - 1)
  693.             END IF
  694.             IF UCASE$(SubName$) = UCASE$(SubToFind$) THEN
  695.               CALL ProgramTitle
  696.               SubRoutineType = 2
  697.               CALL SubTitle
  698.               FoundSub$ = "Y"
  699.               GOSUB PrintSub
  700.             END IF
  701.           RETURN
  702.           
  703.           PrintSub:
  704.             DO
  705.               CALL WriteLine
  706.               LINE INPUT #1, Line$
  707.             LOOP UNTIL LEFT$(Line$, 4) = "SUB " OR LEFT$(Line$, 8) = "FUNCTION" OR EOF(1)
  708.           RETURN
  709.           
  710.           END SUB
  711.           
  712.  
  713.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  17
  714.                              SubTitle (Sub Routine) Page   1
  715.           --------------------------------------------------------------------------------
  716.  
  717.           SUB SubTitle
  718.           
  719.           IF SubRoutineType = 1 THEN SubType$ = "Main Module"
  720.           IF SubRoutineType = 2 THEN SubType$ = "Sub Routine"
  721.           IF SubRoutineType = 3 THEN SubType$ = "Function"
  722.           
  723.           PRINT #2, SPC(29); SubName$; " ("; SubType$; ")";
  724.           PRINT #2, " Page "; USING "###"; SubPageCount
  725.           PRINT #2, SPC(10); STRING$(80, 45)
  726.           PRINT #2,
  727.           SubPageCount = SubPageCount + 1
  728.           LineCount = 4
  729.           
  730.           END SUB
  731.           
  732.  
  733.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  18
  734.                              WaitforAnswer (Sub Routine) Page   1
  735.           --------------------------------------------------------------------------------
  736.  
  737.           SUB WaitforAnswer (A$)
  738.           
  739.           Answer$ = ""
  740.           A$ = ""
  741.            DO
  742.              A$ = UCASE$(INKEY$)
  743.            LOOP WHILE A$ = ""
  744.           
  745.           END SUB
  746.           
  747.  
  748.           Program Listing Of QBLIST.BAS As Of 10-26-1992 At 07:52:47            Page  19
  749.                              WriteLine (Sub Routine) Page   1
  750.           --------------------------------------------------------------------------------
  751.  
  752.           SUB WriteLine
  753.            
  754.           LineLen = LEN(Line$)
  755.           
  756.           DataWord = INSTR(1, Line$, "DATA ")
  757.           IF DataWord <> 0 AND LineLen > 80 THEN
  758.              CALL DataStmtLine
  759.              GOTO Skip
  760.           END IF
  761.           
  762.           IF LineLen <= 80 THEN
  763.              PRINT #2, SPC(10); Line$
  764.              LineCount = LineCount + 1
  765.              GOSUB HeadRtn:
  766.              EXIT SUB
  767.           END IF
  768.           
  769.           IF LineLen > 80 THEN
  770.              CALL SplitLine
  771.           Skip:
  772.              PRINT #2, SPC(10); Line1$
  773.              LineCount = LineCount + 1
  774.              GOSUB HeadRtn
  775.              PRINT #2, SPC(4); "<<*>> ";
  776.              PRINT #2, Line2$
  777.              LineCount = LineCount + 1
  778.              GOSUB HeadRtn
  779.              IF Line3$ = "" THEN EXIT SUB
  780.              PRINT #2, SPC(4); "<<*>> ";
  781.              PRINT #2, Line3$
  782.              LineCount = LineCount + 1
  783.              GOSUB HeadRtn
  784.              IF Line4$ = "" THEN EXIT SUB
  785.              PRINT #2, SPC(4); "<<*>> ";
  786.              PRINT #2, Line4$
  787.              LOCATE 17, 1
  788.              LineCount = LineCount + 1
  789.              GOSUB HeadRtn
  790.           END IF
  791.           EXIT SUB
  792.           
  793.           HeadRtn:
  794.              IF LineCount = 82 THEN
  795.              CALL ProgramTitle
  796.              CALL SubTitle
  797.           END IF
  798.           RETURN
  799.           
  800.           END SUB
  801.           
  802.  
  803.