home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / heimwerk / archi.bas next >
Encoding:
BASIC Source File  |  1989-05-02  |  22.3 KB  |  645 lines
  1. '* ------------------------------------------------------- *
  2. '*                      ARCHI.BAS                          *
  3. '*            (c) 1989  G.Kraus & TOOLBOX                  *
  4. '* ------------------------------------------------------- *
  5. %FALSE = 0 : %TRUE = NOT %FALSE
  6. Kein$ = "" : Leer$ = " "
  7. SNr% = 0   : FuNr% = 0
  8.                      '*   aktuelle Anzahl der Unterprogramme
  9. CalNr% = 0 : FunNr% = 0
  10.                      '* aktuelle Anzahl der Unterpgm-Aufrufe
  11. FuncName$ = Kein$
  12. '* ------------------------------------------------------- *
  13. %MaxIncFiles = 20
  14. DIM IncFiles$ (0 : %MaxIncFiles)
  15.                      '*   IncFile$ (0) ist das Hauptprogramm
  16. %MaxRout = 100
  17. DIM UpNamen$ (1:2, %MaxRout)   ' SUB- und DEF FN-Namen
  18. DIM UpStart% (1:2, %MaxRout)   ' Zeilennummern, Beginn
  19. DIM UpEnde%  (1:2, %MaxRout)   ' Zeilennummern, Ende
  20. DIM UpFile%  (1:2, %MaxRout)   ' Nummer des INCLUDE-Files
  21. DIM RufName$ (1:2, %MaxRout)   ' Unterpgm-Aufrufe
  22. DIM StartLoeschen% (0 : %MaxIncFiles, %MaxRout)
  23. DIM EndeLoeschen%  (0 : %MaxIncFiles, %MaxRout)
  24. DIM FileLoeschen%  (0 : %MaxIncFiles, %MaxRout)
  25. '* ------------------------------------------------------- *
  26. '*  Befehlsgruppe 1 : Zeichen, die die Suche beenden       *
  27. '* ------------------------------------------------------- *
  28. AnzahlNOBefehle% = 4
  29. DIM NOBefehl$ (AnzahlNOBefehle%), _
  30.     NOBefehlsLaenge% (AnzahlNOBefehle%)
  31.  
  32. NOBefehl$ (1) = CHR$ (39)   ' Rem-Zeichen
  33. NOBefehl$ (2) = "REM"
  34. NOBefehl$ (3) = "EXIT"
  35. NoBefehl$ (4) = CHR$ (34)   ' Anführungszeichen
  36.  
  37. FOR i% = 1 TO AnzahlNOBefehle%
  38.   NOBefehlsLaenge% (i%) = LEN (NOBefehl$ (i%))
  39. NEXT i%
  40. '* ------------------------------------------------------- *
  41. '*  Befehlsgruppe 2 : Befehle, die eine Prozedur einleiten *
  42. '*  Sonderfall      : GOSUB (wird ausgefiltert)            *
  43. '* ------------------------------------------------------- *
  44. AnzahlUPBefehle% = 3
  45.  
  46. DIM UPBefehl$ (AnzahlUPBefehle%), _
  47.     UPBefehlsLaenge% (AnzahlUPBefehle%)
  48.  
  49. UPBefehl$ (1) = "GOSUB"
  50. UPBefehl$ (2) = "SUB"
  51. UPBefehl$ (3) = "DEF FN"
  52.  
  53. FOR i% = 1 TO AnzahlUPBefehle%
  54.   UPBefehlsLaenge% (i%) = LEN (UPBefehl$ (i%))
  55. NEXT i%
  56. '* ------------------------------------------------------- *
  57. '*  Befehlsgruppe 3 : Befehle, die eine Prozedur aufrufen  *
  58. '* ------------------------------------------------------- *
  59. AnzahlPRCBefehle% = 2
  60.  
  61. DIM PRCBefehl$ (AnzahlPRCBefehle%), _
  62.     PRCBefehlsLaenge% (AnzahlPRCBefehle%)
  63.  
  64. PRCBefehl$ (1) = "CALL"
  65. PRCBefehl$ (2) = "FN"
  66.  
  67. FOR i% = 1 TO AnzahlPRCBefehle%
  68.   PRCBefehlsLaenge% (i%) = LEN (PRCBefehl$ (i%))
  69. NEXT i%
  70. '* ------------------------------------------------------- *
  71. '*  Befehlsgruppe 4 : Befehle, die eine Prozedur beenden   *
  72. '* ------------------------------------------------------- *
  73. AnzahlExBefehle% = 2
  74.  
  75. DIM ExBefehl$ (AnzahlExBefehle%), _
  76.     ExBefehlsLaenge% (AnzahlExBefehle%)
  77.  
  78. ExBefehl$ (1) = "END SUB"
  79. ExBefehl$ (2) = "END DEF"
  80.  
  81. FOR i% = 1 TO AnzahlExBefehle%
  82.   ExBefehlsLaenge% (i%) = LEN (ExBefehl$ (i%))
  83. NEXT i%
  84. '* ------------------------------------------------------- *
  85. SUB TitelBild
  86.  
  87.   CLS
  88.   COLOR 14, 2
  89.   LOCATE 1,  1 : PRINT STRING$ (80, 32);
  90.   LOCATE 1, 28 : PRINT " A R C H I V A R    V.1.0"
  91.   LOCATE 1, 63 : PRINT "(C) 1989  TOOLBOX"
  92.   COLOR 15, 0
  93.   LOCATE 3, 1  : PRINT "Input-Datei           : ";
  94.  
  95. END SUB
  96. '* ------------------------------------------------------- *
  97. DEF FNEinrueck% (source$)  '*  Anzahl blanks am Zeilenanfang
  98. SHARED Leer$
  99. LOCAL ch$ = "" : ni% = 0
  100.  
  101.   DO
  102.     INCR ni%
  103.     ch$ = MID$ (source$, ni%, 1)
  104.   LOOP UNTIL ch$ <> Leer$ OR ni% > LEN (source$)
  105.   FNEinrueck% = ni%
  106.  
  107. END DEF
  108. '* ------------------------------------------------------- *
  109. DEF FNGetKeyWord$ (start%, source$)
  110. ' sucht das erste Wort der Programmzeile
  111. ' start% ist das erste Zeichen des Wortes
  112. SHARED Leer$
  113. LOCAL wort$
  114.  
  115.   DO
  116.     wort$ = wort$ + MID$ (source$, start%, 1)
  117.     INCR start%
  118.   LOOP UNTIL MID$ (source$, start%, 1) = Leer$ _
  119.              OR start% > LEN (source$)
  120.   FNGetKeyWord$ = wort$
  121.  
  122. END DEF
  123. '* ------------------------------------------------------- *
  124. SUB IncFile (Zeile$, start%, Modi%)
  125. ' liefert den Namen des INCLUDE-Files
  126. ' Modi% : falls true, wird die Extension geändert
  127. SHARED IncFiles$ ()
  128. STATIC IncNr%
  129.           '* vorbelegt mit 0, wird mit jedem $INCLUDE erhöht
  130. LOCAL  FileName$
  131.  
  132.                                              ' ohne $INCLUDE
  133.   FileName$ = MID$ (Zeile$, start% + 8,  LEN (Zeile$))
  134.                             ' führende Leerzeichen entfernen
  135.   start%  = FnEinrueck% (FileName$)
  136.   FileName$ = FnGetKeyWord$ (start%, FileName$)
  137.                                ' Anführungszeichen entfernen
  138.   FileName$ = MID$ (FileName$, 2, LEN (FileName$) - 2)
  139.                        ' falls keine Extension vorhanden ist
  140.   IF INSTR (FileName$, ".") = %FALSE THEN
  141.     FileName$ = FileName$ + ".BAS"
  142.   END IF
  143.   IF (incnr% + 1) <= %MaxIncFiles THEN
  144.     INCR incnr%
  145.     IncFiles$ (incnr%) = FileName$
  146.   ELSE
  147.     BEEP
  148.     PRINT : PRINT "Mehr als 20 Include-Files ! "
  149.     STOP
  150.   END IF
  151.   IF Modi% THEN CALL Extension (FileName$)
  152.  
  153. END SUB
  154. '* ------------------------------------------------------- *
  155. SUB Extension (Zeile$)
  156. ' ändert die Extension der Include-File-Namen
  157. SHARED Ext$
  158.  
  159.   IF INSTR (Zeile$, ".") = %FALSE THEN Zeile$ = Zeile$ + "."
  160.   Zeile$ = LEFT$ (Zeile$, INSTR (Zeile$, ".")) + Ext$
  161.  
  162. END SUB
  163. '* ------------------------------------------------------- *
  164. DEF FNDoppelt% (RoutNam$, Rout%, Nr%)
  165. ' ermittelt, ob eine Routine bereits aufgerufen wurde
  166. ' wenn man ein zusätzliches ARRAY einführt, kann man leicht
  167. ' feststellen, wie oft eine Routine aufgerufen wurde
  168. SHARED RufName$ ()
  169. LOCAL  i%
  170.  
  171.   FNDoppelt% = %FALSE
  172.   FOR i% = 1 TO Nr%
  173.     IF RoutNam$ = RufName$ (Rout%, i%) THEN
  174.       FNDoppelt% = %TRUE
  175.       EXIT DEF
  176.     END IF
  177.   NEXT i%
  178.  
  179. END DEF
  180. '* ------------------------------------------------------- *
  181. SUB Vorh (RoutNr%, RufNr%, UpNr%, Loesch%)
  182.  
  183. SHARED SNr%, FuNr%, UpNamen$ (), UpStart% (), UpEnde% (), _
  184.        UpFile% (), CalNr%, FunNr%, RufName$ (), Kein$, _
  185.        Leer$, Drucker$, FileNr%, StartLoeschen% (), _
  186.        EndeLoeschen% (), FileLoeschen% ()
  187. LOCAL  OK%, i%, j%
  188.  
  189.   Loesch% = 1
  190.   IF Drucker$ = "J" THEN
  191.     LPRINT
  192.     IF RoutNr% = 1 THEN
  193.        LPRINT "- Nicht benötigte Subroutinen"
  194.     ELSE
  195.        LPRINT "- Nicht benötigte Funktionen"
  196.     END IF
  197.   END IF
  198.   OK% = %FALSE : i% = 1
  199.   DO
  200.     j% = 1 : OK% = %FALSE
  201.     DO
  202.       IF UpNamen$ (RoutNr%,i%) = RufName$ (RoutNr%,j%) THEN
  203.         OK% = %TRUE
  204.       ELSE
  205.         INCR j%
  206.       END IF
  207.     LOOP UNTIL j% > RufNr% OR OK%
  208.  
  209. ' falls die Routine nicht aufgerufen wurde, wird der Feld-
  210. ' inhalt mit dem Inhalt des letzten Feldes überschrieben
  211.     IF NOT OK% THEN
  212.       StartLoeschen% (RoutNr%, Loesch%) = _
  213.                                       UpStart% (RoutNr%, i%)
  214.       EndeLoeschen%  (RoutNr%, Loesch%) = _
  215.                                       UpEnde%  (RoutNr%, i%)
  216.       FileLoeschen%  (RoutNr%, Loesch%) = _
  217.                                        UpFile% (RoutNr%, i%)
  218.       IF Drucker$ = "J" THEN
  219.         LPRINT UpNamen$ (RoutNr%, i%),
  220.         LPRINT TAB (35); USING "#####"; _
  221.                           StartLoeschen% (RoutNr%, Loesch%),
  222.         LPRINT USING "#####"; _
  223.                           EndeLoeschen%  (RoutNr%, Loesch%),
  224.         LPRINT USING "#####"; UpFile% (RoutNr%, i%)
  225.       END IF
  226.       UpNamen$ (RoutNr%, i%) = UpNamen$ (RoutNr%, UpNr%)
  227.       UpStart% (RoutNr%, i%) = UpStart% (RoutNr%, UpNr%)
  228.       UpEnde%  (RoutNr%, i%) = UpEnde%  (RoutNr%, UpNr%)
  229.       UpFile%  (RoutNr%, i%) = UpFile%  (RoutNr%, UpNr%)
  230.       INCR Loesch%
  231.       DECR UpNr%
  232.     END IF
  233.  
  234. ' Falls nicht ok, muß das Feld nochmal untersucht werden,
  235. ' da der Inhalt des vorher letzten Feldes gespeichert wurde
  236.     IF OK% THEN INCR i%
  237.   LOOP UNTIL i% > UpNr%
  238.   DECR Loesch%
  239.  
  240. END SUB
  241. '* ------------------------------------------------------- *
  242. SUB Sortieren (RufName$ (2), RoutNr%, Nr%)
  243. ' einfache Sortierroutine
  244. LOCAL i%, j%, Merk%
  245.  
  246.   FOR i% = 1 TO Nr% - 1
  247.     Merk% = i%
  248.     FOR j% = i% + 1 TO Nr%
  249.       IF RufName$ (RoutNr%,j%) < RufName$ (RoutNr%, i%) THEN
  250.         Merk% = j%
  251.       END IF
  252.     NEXT
  253.     IF Merk% <> i% THEN
  254.       SWAP RufName$ (RoutNr%, i%), RufName$ (RoutNr%, Merk%)
  255.     END IF
  256.   NEXT
  257.  
  258. END SUB
  259. '* ------------------------------------------------------- *
  260. DEF FNExist% (FileName$)
  261. ' stellt fest, ob das File bereits vorhanden ist
  262.  
  263.   ON ERROR GOTO Fehler
  264.   OPEN FileName$ FOR INPUT AS #1
  265.   CLOSE #1 : FnExist% = %TRUE : GOTO Meldung
  266. Fehler :
  267.   FnExist% = %FALSE : RESUME Weiter
  268. Meldung :
  269.   PRINT
  270.   PRINT "Das File ";FileName$, " ist bereits vorhanden !"
  271.   PRINT "Bitte vor einem weiteren Programmaufruf umbenennen"
  272. Weiter :
  273.   ON ERROR GOTO 0
  274.  
  275. END DEF
  276. '* ------------------------------------------------------- *
  277. SUB ZeileBearbeiten (Text$, LineNr%)
  278. SHARED FileNr%
  279. LOCAL Antw%, PRC%
  280.  
  281.   IF NOT FNNoBefehl% (Text$) THEN
  282.                     ' die Zeile muß weiter untersucht werden
  283.     Antw% = FNUPBefehl% (Text$, LineNr%)
  284.                     ' die Zeile muß weiter untersucht werden
  285.     IF NOT Antw% THEN PRC% = FNPRCBefehl% (Text$)
  286.     PRC% = FNExBefehl% (Text$, LineNr%)
  287.   END IF
  288.  
  289. END SUB
  290. '* ------------------------------------------------------- *
  291. DEF FNNoBefehl% (Text$)
  292. ' filtert Zeilen mit den Befehlsworten NoBefehl$ ()
  293. ' behandelter Sonderfall : nach dem Anführungszeichen (Text)
  294. ' folgt ein Funktions- oder Prozeduraufruf !
  295.  
  296. SHARED AnzahlNoBefehle%, NoBefehl$ (), NoBefehlsLaenge% ()
  297. LOCAL  Dummy%, Vorh%, AktPos%, t%, Laenge%
  298.  
  299.   Vorh% = %FALSE : AktPos% = 1 : t% = 1
  300.   Laenge% = LEN (Text$)
  301.   DO
  302.     DO
  303.       IF MID$ (Text$, AktPos%, NOBefehlsLaenge% (t%)) =_
  304.                                          NoBefehl$ (t%) THEN
  305.         Vorh% = %TRUE
  306. ' Sonderfall: vor einem der NoBefehle steht REM, ' oder EXIT
  307.         IF t% < 4 THEN
  308.           Text$ = LEFT$ (Text$, AktPos% - 1)
  309.           FNNoBefehl% = %FALSE
  310.           EXIT DEF
  311.         END IF
  312. ' Sonderfall : Anführungszeichen in der Zeile
  313.         IF NoBefehl$ (t%) = CHR$ (34) THEN       ' t% = 4
  314.                               ' Anführungszeichen gefunden !
  315.           Text$ = RIGHT$ (Text$, LEN (Text$) - AktPos%)
  316.     ' die Zeile wird bis zum Anführungszeichen abgeschnitten
  317.           Dummy% = INSTR (Text$, CHR$ (34))
  318.           Text$ = RIGHT$ (Text$, LEN (Text$) - Dummy%)
  319.     ' die Zeile wird bis zum Anführungszeichen abgeschnitten
  320. ' im folgenden wird der Text nach dem Anf.zeichen untersucht
  321.           Vorh% = %FALSE
  322.                       ' oder FNNoBefehl% = %FALSE : EXIT DEF
  323.         END IF        ' IF NoBefehl$ (t%) = CHR$ (34)
  324.       ELSE
  325.         INCR t%
  326.       END IF          ' IF MID$ (Text$, AktPos%, ...
  327.     LOOP UNTIL Vorh% OR t% > AnzahlNoBefehle%
  328.     IF NOT Vorh% THEN
  329.       INCR AktPos%
  330.       t% = 1
  331.     END IF
  332.   LOOP UNTIL Vorh% OR AktPos% > Laenge%
  333.   FNNoBefehl% = Vorh%
  334.    ' true, wenn eines der gesuchten Zeichen/Befehle gefunden
  335.  
  336. END DEF
  337. '* ------------------------------------------------------- *
  338. DEF FNUPBefehl% (Text$, LineNr%)
  339. ' filtert Zeilen mit den Befehlsworten UPBefehl$ ()
  340. ' also "SUB" und "DEF FN" .  Sonderfall : GOSUB
  341. SHARED AnzahlUPBefehle%, UPBefehl$ (), UPBefehlsLaenge% (),_
  342.        FileNr%, FuncName$, SNr%, FuNr%, UpNamen$ (), _
  343.        UpStart% (), UpEnde% (), UpFile% (), Kein$, Leer$
  344. LOCAL  Vorh%, AktPos%, t%, Laenge%, Nam$, ch$, Nr%, Func%
  345.  
  346.   Vorh% = %FALSE : AktPos% = 1 : t% = 1
  347.   Func% = %FALSE
  348.   Laenge% = LEN (Text$)
  349.   DO
  350.     DO
  351.       IF MID$ (Text$, AktPos%, UPBefehlsLaenge% (t%)) =_
  352.                                          UPBefehl$ (t%) THEN
  353.         Vorh% = %TRUE
  354.         IF t% = 1 THEN Vorh% = FALSE : Nam$ = Kein$
  355.                               ' Namen der Prozedur ermitteln
  356.           AktPos% = AktPos% + UPBefehlsLaenge% (t%)
  357.                            ' 1. Zeichen nach dem Befehlswort
  358.           Nam$ = Kein$
  359.           DO
  360.             IF MID$ (Text$, AktPos%, 1) <> Leer$ THEN
  361.               Nam$ = Nam$ + MID$ (Text$, AktPos%, 1)
  362.             END IF
  363.             INCR AktPos%
  364.             Ch$ = MID$ (Text$, AktPos%, 1)
  365.           LOOP UNTIL Ch$ = Leer$ OR Ch$ = "(" _
  366.                                     OR AktPos% > LEN (Text$)
  367.                            ' Sonderfall : 1-zeilige Funktion
  368.           IF INSTR (Text$, "DEF FN") THEN
  369.             Func% = %TRUE : FuncName$ = Nam$
  370.             IF INSTR (Text$, "=") THEN
  371.               UpEnde% (t%-1, FuNr%+1) = LineNr%
  372.             END IF
  373.                            ' -->   Ende-Zeile = Anfangszeile
  374.           ELSE
  375.             FuncName$ = Kein$
  376.           END IF                ' IF INSTR (Text$, "DEF FN")
  377.                     ' Sonderfall : END SUB, GOSUB oder Label
  378.           IF Nam$ = ":" OR t% = 1 THEN Nam$ = Kein$
  379.           IF Nam$ <> Kein$ THEN
  380.           IF Func% THEN
  381.             INCR FuNr% : Nr% = FuNr%
  382.           ELSE
  383.             INCR SNr%  : Nr% = SNr%
  384.           END IF
  385.           UpNamen$ (t%-1, Nr%) = Nam$
  386.           UpStart% (t%-1, Nr%) = LineNr%
  387.           UPFile%  (t%-1, Nr%) = FileNr%
  388.         END IF                            ' IF Nam$ <> Kein$
  389.       ELSE
  390.         INCR t%
  391.       END IF                  ' IF MID$ (Text$, AktPos%, ...
  392.     LOOP UNTIL Vorh% OR t% > AnzahlUPBefehle%
  393.     IF NOT Vorh% THEN
  394.       INCR AktPos%
  395.       t% = 1
  396.     END IF
  397.   LOOP UNTIL Vorh% OR AktPos% > Laenge%
  398.   FNUPBefehl% = Vorh%
  399.  
  400. END DEF
  401. '* ------------------------------------------------------- *
  402. DEF FNPRCBefehl% (Text$)
  403. ' filtert Zeilen mit den Befehlsworten PRCBefehl$ ()
  404. ' also "CALL" und "FN"
  405. ' es können mehrere Aufrufe in einer Zeile stehen, also muß
  406. ' die ganze Zeile überprüft werden
  407. SHARED AnzahlPRCBefehle%, PRCBefehl$ (), _
  408.        PRCBefehlsLaenge% (); FuncName$, SNr%, FuNr%, _
  409.        UpNamen$ (), CalNr%, FunNr%, RufName$(), Kein$, Leer$
  410. LOCAL  Vorh%, AktPos%, t%, Laenge%, Nam$, ch$, Nr%, Func%
  411.  
  412.   Vorh% = %FALSE : AktPos% = 1 : t% = 1
  413.   Func% = %FALSE
  414.   Laenge% = LEN (Text$)
  415.   DO
  416.     DO
  417.       IF MID$ (Text$, AktPos%, PRCBefehlsLaenge% (t%)) =_
  418.                                         PRCBefehl$ (t%) THEN
  419.         Vorh% = %TRUE
  420.                               ' Namen der Prozedur ermitteln
  421.         AktPos% = AktPos% + PRCBefehlsLaenge% (t%)
  422.                            ' 1. Zeichen nach dem Befehlswort
  423.         Nam$ = Kein$
  424.         DO
  425.           IF MID$ (Text$, AktPos%, 1) <> Leer$ THEN
  426.             Nam$ = Nam$ + MID$ (Text$, AktPos%, 1)
  427.           END IF
  428.           INCR AktPos%
  429.           Ch$ = MID$ (Text$, AktPos%, 1)
  430.         LOOP UNTIL Ch$ = Leer$ OR Ch$ = "(" _
  431.                                     OR AktPos% > LEN (Text$)
  432. ' Sonderfall : Wertzuweisung innerhalb der Funktion
  433. '              gilt natürlich nicht als Funktionsaufruf !
  434.         IF PRCBefehl$ (t%) = "FN" THEN
  435.           Func% = %TRUE
  436.           IF Nam$ = FuncName$ THEN
  437.             Func% = %FALSE : Nam$ = Kein$
  438.           END IF
  439.         END IF                   ' IF PRCBefehl$ (t%) = "FN"
  440.         IF Nam$ <> Kein$ THEN
  441.           IF Func% THEN
  442.             Nr% = FunNr% : Rout% = 2
  443.           ELSE
  444.             Nr% = CalNr% : Rout% = 1
  445.           END IF                                  ' IF Func%
  446.              ' wurde die Routine bereits einmal aufgerufen ?
  447.   ' wenn ja, muß der Aufruf nicht nochmal gespeichert werden
  448.           IF FNDoppelt% (Nam$, Rout%, Nr%) THEN
  449.             Func% = %FALSE : Nam$ = Kein$
  450.           END IF
  451.         END IF                           ' IF Nam$ < > Kein$
  452.                                      ' Speichern des Aufrufs
  453.         IF Nam$ <> Kein$ THEN
  454.           IF Func% THEN
  455.             INCR FunNr% : Nr% = FunNr% : Rout% = 2
  456.           ELSE
  457.             INCR CalNr% : Nr% = CalNr% : Rout% = 1
  458.           END IF                                  ' IF Func%
  459.           RufName$ (t%, Nr%) = Nam$
  460.         END IF                            ' IF Nam$ <> Kein$
  461.       ELSE
  462.         INCR t%
  463.       END IF  ' IF MID$ (Text$, AktPos%, ...
  464.     LOOP UNTIL Vorh% OR t% > AnzahlPRCBefehle%
  465.     INCR AktPos%
  466.     t% = 1
  467.     Func% = %FALSE
  468.   LOOP UNTIL AktPos% > Laenge%
  469.   FNPRCBefehl% = Vorh%
  470.  
  471. END DEF
  472. '* ------------------------------------------------------- *
  473. DEF FNExBefehl% (Text$, LineNr%)
  474. ' filtert Zeilen mit den Befehlsworten ExBefehl$ ()
  475. ' also "END SUB" und "END DEF"
  476. SHARED AnzahlExBefehle%, ExBefehl$ (), ExBefehlsLaenge% (),_
  477.        SNr%, FuNr%, UpNamen$ (),UpStart% (), UpEnde% ()_
  478.        Kein$, Leer$
  479. LOCAL  Vorh%, AktPos%, t%, Laenge%, Nr%
  480.  
  481.   Vorh% = %FALSE : AktPos% = 1 : t% = 1
  482.   Laenge% = LEN (Text$)
  483.   DO
  484.     DO
  485.       IF MID$ (Text$, AktPos%, ExBefehlsLaenge% (t%)) =_
  486.                                          ExBefehl$ (t%) THEN
  487.         Vorh% = %TRUE
  488.         IF t% = 1 THEN Nr% = SNr% ELSE Nr% = FuNr%
  489.                          ' die Zeilennummer wird gespeichert
  490.         UpEnde% (t%, Nr%) = LineNr%
  491.       ELSE
  492.         INCR t%
  493.       END IF                  ' IF MID$ (Text$, AktPos%, ...
  494.     LOOP UNTIL Vorh% OR t% > AnzahlExBefehle%
  495.     IF NOT Vorh% THEN
  496.       INCR AktPos% : t% = 1
  497.     END IF
  498.   LOOP UNTIL Vorh% OR AktPos% > Laenge%
  499.   FNExBefehl% = Vorh%
  500.  
  501. END DEF
  502. '* ------------------------------------------------------- *
  503. SUB ZeileTesten (RoutNr%, ZeilenNr%, MaxNr%, Gefunden%)
  504. ' falls eine nicht erforderliche Routine gefunden wird,
  505. ' werden die Zeilen bis zum Ende der Routine nur eingelesen
  506. SHARED FileNr%, FileLoeschen% (),_
  507.        StartLoeschen% (), EndeLoeschen% ()
  508. LOCAL  i%, Zeile$
  509.  
  510.   FOR i% = 1 TO MaxNr%
  511.     IF FileLoeschen% (RoutNr%, i%) = FileNr% _
  512.            AND ZeilenNr% = StartLoeschen% (RoutNr%, i%) THEN
  513.       IF ZeilenNr% = EndeLoeschen% (RoutNr%, i%) THEN
  514.                            ' Sonderfall : 1-zeilige Funktion
  515.         Gefunden% = %TRUE
  516.       ELSE
  517.         DO
  518.           LINE INPUT #1, Zeile$
  519.           INCR ZeilenNr%
  520.         LOOP UNTIL ZeilenNr% = EndeLoeschen% (RoutNr%, i%) _
  521.                                                   OR EOF (1)
  522.         Gefunden% = %TRUE
  523.       END IF       ' ZeilenNr% = EndeLoeschen% (RoutNr%, i%)
  524.     END IF         ' IF FileLoeschen% (RoutNr%, i%) = ...
  525.     IF Gefunden% THEN EXIT FOR
  526.   NEXT i%
  527.  
  528. END SUB
  529. '* ------------------------------------------------------- *
  530. '*  Hauptteil                                              *
  531. '* ------------------------------------------------------- *
  532. CALL TitelBild
  533. INPUT FileName$
  534. IF INSTR (FileName$, ".") = %FALSE THEN
  535.   FileName$ = FileName$ + ".BAS"
  536. END IF
  537. PRINT : PRINT "neue Extension        : ";
  538. INPUT Ext$ : Ext$ = UCASE$ (Ext$)
  539. IF Ext$ = Kein$ THEN Ext$ = "BIB"
  540. PRINT : PRINT "Druckerprotokoll  J/N : ";
  541. INPUT Drucker$ : Drucker$ = UCASE$ (Drucker$)
  542. IF Drucker$ <> "J" THEN Drucker$ = "N"
  543.  
  544. '* ------------------------------------------------------- *
  545. '*  Die Original-Files werden bearbeitet                   *
  546. '* ------------------------------------------------------- *
  547. IncFiles$ (0) = Filename$ : FileNr% = 0 : LineNr% = 0
  548. COLOR 14, 5 : PRINT : PRINT " 1. Durchlauf : " : COLOR 15, 0
  549. DO
  550.   PRINT "In Bearbeitung : "; IncFiles$ (FileNr%)
  551.   OPEN IncFiles$ (FileNr%) FOR INPUT AS #1
  552.   WHILE NOT EOF (1)
  553.     LINE INPUT #1, Zeile$
  554.     Zeile$ = UCASE$ (Zeile$) : INCR LineNr%
  555.     Zeile$ = MID$ (Zeile$, _
  556.                          FNEinRueck% (Zeile$), LEN (Zeile$))
  557.                       ' führende Leerzeichen werden entfernt
  558.                       ' Include-Files werden gesammelt
  559.     IF INSTR (Zeile$, "$INCLUDE") THEN
  560.       KeyWord$ = FNGetKeyWord$ (FNEinRueck%(Zeile$), Zeile$)
  561.       IF UCASE$ (MID$ (KeyWord$, 1, 8)) = "$INCLUDE" THEN
  562.         CALL IncFile (Zeile$, FNEinRueck% (Zeile$), %False)
  563.       END IF
  564.     END IF
  565.     CALL ZeileBearbeiten (Zeile$, LineNr%)
  566.   WEND
  567.   CLOSE #1
  568.   INCR FileNr% : LineNr% = 0
  569. LOOP UNTIL (FileNr% > %MaxIncFiles) _
  570.                               OR  (INCFiles$ (FileNr%) = "")
  571. '* ------------------------------------------------------- *
  572. '*  Die ARRAYs werden sortiert und verglichen              *
  573. '* ------------------------------------------------------- *
  574. COLOR 14, 5 : PRINT : PRINT " Sortieren " : COLOR 15, 0
  575. CALL Sortieren (RufName$ (), 1, CalNr%)
  576. CALL Sortieren (RufName$ (), 2, FunNr%)
  577. '* ------------------------------------------------------- *
  578. '*  die nicht benötigten Routinen werden aussortiert       *
  579. '* ------------------------------------------------------- *
  580. CALL Vorh (1, CalNr%, SNr%, SbDel%)
  581. CALL Vorh (2, FunNr%, FuNr%, FunDel%)
  582. '* ------------------------------------------------------- *
  583. '*  Die neuen Files werden zusammengestellt                *
  584. '* ------------------------------------------------        *
  585. COLOR 14, 5 : PRINT : PRINT " 2. Durchlauf : " : COLOR 15, 0
  586. FileNr% = 0 : LineNr% = 0
  587. DO
  588.   PRINT "In Bearbeitung : "; IncFiles$ (FileNr%)
  589.   OPEN IncFiles$ (FileNr%) FOR INPUT AS #1
  590.   CALL Extension (IncFiles$ (FileNr%))
  591.   PRINT TAB (20); "--> "; IncFiles$ (FileNr%)
  592.                ' vorhandene Files werden nicht überschrieben
  593.   IF FNExist% (IncFiles$ (FileNr%)) THEN STOP
  594.   OPEN IncFiles$ (FileNr%) FOR OUTPUT AS #2
  595.   WHILE NOT EOF (1)
  596.     LINE INPUT #1, Zeile$
  597.     INCR LineNr%
  598.     Found% = %FALSE
  599.     IF INSTR (UCASE$ (Zeile$), "$INCLUDE") THEN
  600.       KeyWord$ = FNGetKeyWord$ (FNEinRueck%(Zeile$), Zeile$)
  601.       IF UCASE$ (MID$ (KeyWord$, 1, 8)) = "$INCLUDE" THEN
  602.         CALL Extension (Zeile$)
  603.         Zeile$ = Zeile$ + CHR$ (34)
  604.       END IF
  605.     END IF
  606.     CALL ZeileTesten (1, LineNr%, SbDel%, Found%)
  607.     IF NOT Found% THEN
  608.       CALL ZeileTesten (2, LineNr%, FunDel%, Found%)
  609.     END IF
  610.     IF NOT Found% THEN PRINT #2, Zeile$
  611.   WEND
  612.   CLOSE #1 : CLOSE #2
  613.   INCR FileNr% : LineNr% = 0
  614. LOOP UNTIL (FileNr% > %MaxIncFiles) _
  615.                               OR  (INCFiles$ (FileNr%) = "")
  616. '* ------------------------------------------------------- *
  617. IF Drucker$ = "J" THEN
  618.   LPRINT : LPRINT CalNr%; "Sub-Aufrufe"
  619.   FOR i% = 1 TO CalNr%
  620.     LPRINT RufName$ (1, i%)
  621.   NEXT i%
  622.   LPRINT : LPRINT FunNr%; "Funktions-Aufrufe"
  623.   FOR i% = 1 TO FunNr%
  624.     LPRINT RufName$ (2, i%)
  625.   NEXT i%
  626.   LPRINT : LPRINT SNr%; "Sub-Routinen"
  627.   FOR i% = 1 TO SNr%
  628.     LPRINT UpNamen$ (1, i%); TAB (35); _
  629.            USING "#####"; UpStart% (1, i%),_
  630.            USING "#####"; UpEnde% (1, i%), upfile% (1, i%)
  631.   NEXT i%
  632.   LPRINT : LPRINT FuNr%; "Funktionen"
  633.   FOR i% = 1 TO FuNr%
  634.     LPRINT UpNamen$ (2, i%); TAB (35); _
  635.            USING "#####"; UpStart% (2, i%),_
  636.            USING "#####"; UpEnde% (2, i%), upfile% (2, i%)
  637.   NEXT i%
  638.   LPRINT
  639. END IF                                   ' IF Drucker$ = "J"
  640. COLOR 14, 5 : PRINT : PRINT " ENDE " : COLOR 15, 0
  641. END
  642. '* ------------------------------------------------------- *
  643. '*                  Ende von ARCHI.BAS                     *
  644.  
  645.