BIBLIO.BI
TYPE teinte
   noir   AS INTEGER
   brun   AS INTEGER
   Lcyan  AS INTEGER
   Lbrun  AS INTEGER
END TYPE
TYPE RegType
     ax    AS INTEGER
     bx    AS INTEGER
     cx    AS INTEGER
     dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     flags AS INTEGER
END TYPE
 
DIM SHARED dir$(500), x%, xy%, Mk%, indic%
DIM SHARED I$(20), A%(20)
DIM SHARED Cleur AS teinte
DIM SHARED A$(1 TO 5)                    ' Chaine pour les cadres
DIM SHARED Cardef%, Carcurs%              ' Couleur caractere
DIM SHARED FondDef%, FondCurs%            ' Couleur du fond
DIM SHARED NS$(1 TO 10)                  ' Nø de message
DIM SHARED TT$(1000), TBAS$(223)
DIM SHARED FONCTION$(50)
DIM SHARED SUBROUT$(200)
DIM SHARED R$(30), guil%
DIM SHARED NL%, IM$, rep$
 
COMMON SHARED Li%, Col%, tra%, trb%, trc%
COMMON SHARED R$, IM, Oper%
COMMON SHARED Temoin%, Blanc$
COMMON SHARED A$()                         ' Tableau pour les cadres
COMMON SHARED TT$(), TBAS$(), delier#, M$, N$, x$, V%, N%, I$()
 
DECLARE SUB INTERRUPT (intnum AS INTEGER, inreg AS RegType, outreg AS RegType)
 
' AFFICHAGE
DECLARE SUB AFFcur (WI%)                 ' traitement du curseur
DECLARE SUB AFFscr (PLin%, Row%, NMEs%, MO%)
DECLARE SUB AFFmen (E%, Y$())
DECLARE SUB ALIGNE (E%)
DECLARE SUB collect ()
DECLARE SUB controle ()
DECLARE SUB curmenu (x%, Y$(), Choix$)
DECLARE SUB KleanSCR (Li%, NOMBR%) ' Nettoyage ‚cran
DECLARE SUB PREsent ()
DECLARE SUB RAZ (Y%, U$())
DECLARE SUB TRI (am$())
DECLARE SUB SEPGUIL ()
DECLARE SUB VERIF ()
 
DECLARE FUNCTION AFFctre% (Mnum%)
DECLARE FUNCTION Comple$ (Y$(), K%)
 
'Entree Clavier
DECLARE SUB APPEnter (AF%)
 
'Temps reel
DECLARE SUB DELay ()                     ' Temposisareur
 
CONST PasCUrseur% = &H1F1F           ' pour ne pas voir le curseur
CONST PtiCUrseur% = &HF10            ' Pour voir un petit curseur
CONST GrdCUrseur% = &H210            ' Pour voir un grand curseur
CONST Xtrue% = -1                    ' constante logique
CONST Xfalse% = 0                    ' constante logique
CONST AO% = Xtrue%                   ' flag pour message "Appenter"
CONST PO% = Xfalse%                  '  "   sans message     "
 
 Cleur.noir  = 0
 Cleur.brun  = 6
 Cleur.Lcyan = 11
 Cleur.Lbrun = 14
 
 ' Definition des attributs de caracteres
 Cardef%   = Cleur.Lcyan
 FondDef%  = Cleur.noir
 Carcurs%  = Cleur.Lbrun
 FondCurs% = Cleur.brun
 
Blanc$ = SPACE$(77)
 --------------------------------------------
XREF1.BAS
 
'******************************************************************************
'               Programme de references croisees
'                  Par RENIER Alain Copyright (C) 1998
'                  le 01/02/1998
'                  Modification :
'                  Sortie sur fichier le 02/12/2006
'                  reprise des commentaires "sans" accents 06/01/2007
'                  re-Indentation 12/01/2007
'                  ajouter sortie sur fichier
'******************************************************************************
' $INCLUDE: 'biblio.bi'
 
deux:
   DATA AS, DO, IF, IS, ON, OR, TO
   DATA ABS, AND, ANY, ASC, ATN, CLS, COM, COS, CVD, CVI, CVL, CVS, DEF, DIM
   DATA END, EOF, EQV, ERL, ERR, EXP, FIX, FOR, FRE, GET, IMP, INP, INT, KEY
   DATA LEN, LET, LOC, LOF, LOG, MOD, NOT, OFF, OUT, PEN, POS, PUT, REM, RND
   DATA RUN, SEG, SGN, SIN, SPC, SQR, SUB, TAB, TAN, VAL, XOR
   DATA BASE, BEEP, CALL, CASE, CDBL, CHR$, CINT, CLNG, CSNG, DATA, DRAW, ELSE
   DATA EXIT, GOTO, HEX$, KILL, LINE, LIST, LOCK, LONG, LOOP, LPOS, LSET, MID$
   DATA MKD$, MKI$, MKL$, MKS$, NAME, NEXT, OCT$, OPEN, PEEK, PLAY, PMAP, POKE
   DATA PSET, READ, RSET, SADD, SEEK, STEP, STOP, STR$, SWAP, THEN, TRON, TYPE
   DATA VIEW, WAIT, WEND
   DATA ALIAS, BLOAD, BSAVE, BYVAL, CALLS, CDECL, CHAIN, CHDIR, CLEAR, CLOSE
   DATA COLOR, CONST, DATE$, ENDIF, ERASE, ERDEV, ERROR, FIELD, FILES, GOSUB
   DATA INPUT, INSTR, IOCTL, LEFT$, LOCAL, MKDIR, PAINT, PCOPY, POINT, PRINT
   DATA REDIM, RESET, RMDIR, SHELL, SLEEP, SOUND, STICK, STRIG, TIME$, TIMER
   DATA TROFF, UNTIL, USING, WHILE, WIDTH, WRITE
   DATA ACCESS, APPEND, BINARY, CIRCLE, COMMON, CSRLIN, CVDMBF, CVSMBF, DEFDBL
   DATA DEFINT, DEFLNG, DEFSNG, DEFSTR, DOUBLE, ELSEIF, ERDEV$, INKEY$, INPUT$
   DATA IOCTL$, LBOUND, LCASE$, LOCATE, LPRINT, LTRIM$, OPTION, OUTPUT, PRESET
   DATA RANDOM, RESUME, RETURN, RIGHT$, RTRIM$, SCREEN, SELECT, SETMEM, SHARED
   DATA SIGNAL, SINGLE, SPACE$, STATIC, STRING, SYSTEM, UBOUND, UCASE$, UEVENT
   DATA UNLOCK, VARPTR, VARSEG, WINDOW
   DATA DECLARE, DYNAMIC, ENVIRON, INTEGER, MKDMRF$, MKSMBF$, PALETTE, RESTORE
   DATA INCLUDE, STRING$, VARPTR$
   DATA COMMAND$, ENVIRON$, FILEATTR, FREEFILE, FUNCTION, RANDOMIZE
   '$DYNAMIC:"dir$()", "x%", "xy%", "Mk%", "I$()", "A%()"
    ON ERROR GOTO traiterreur
    COLOR Cardef%, FondDef%
    CLS
    PRINT " Ce programme developpe en Quick Basic V 4.5 permet d' obtenir les variables"
    PRINT " manipulees  dans un programme Basic. "
    PRINT
    PRINT " Il ne fait pas d'analyse structurelle, ni d'analyse fonctionnelle! "
    PRINT
    PRINT " Il peut etre employe avec un programme pour QUICK BASIC avec programmation"
    PRINT " structuree ou avec un programme pour Mbasic ou Gwbasic avec des numeros"
    PRINT " de label (etiquette) "
    PRINT
    PRINT " En sortie, les variables sont triees, et l'adresse d'utilisation est "
    PRINT " indiquee par un nombre qui represente un Label s'il est seul, ou un"
    PRINT " numero de ligne s'il est dote du prefixe '*'"
    PRINT
    PRINT " Un ecran 'MENU' est affiche apres ces elements d'aide."
    PRINT " Le grand curseur se deplace a l'aide des touches fleche HAUT,"
    PRINT " fleche BAS, fleche GAUCHE, fleche DROITE, touche HOME, touche END."
    PRINT
    PRINT " L'utilisateur selectionne, a l'aide de la touche ENTER, la directory "
    PRINT " (dossier) dans lequel se trouve le programme Basic a analyser."
    PRINT " La representation '.' represente le dossier dans lequel figurent les "
    PRINT " fichiers visibles. La representation '..' represente le dossier superieur."
    PRINT " L'utilisateur change de dossier s'il selectionne '..' "
    PRINT " Les dossiers figurent avec la barre oblique inverse (antislash) "
    PRINT " si le programme a analyser est visible, positionner le curseur sur cet "
    PRINT " element, et appuyer sur ENTER."
    DO
       PRINT " <Appuyez sur la  touche S pour continuer > "
       atrp$ = UCASE$(INPUT$(1))
    LOOP UNTIL atrp$ = "S"
    CLS
5  
    collect
    NS$(2) = "** Analyseur croise de programmes basic **"
    Li% = 2
    ' calcul centre de l'ecran
    Col% = AFFctre%(Li%)
    ' affichage centre de l'ecran
    AFFscr Li%, Col%, 2, PO%
    Li% = 3
    ' curseur "menu" pour le choix du fichier a analyser
    curmenu Li%, dir$(), NF$
    CLS
    ' recuperer de la memoire
    ERASE dir$
    PRINT " <A>vec impression ou "
    PRINT " <S>ans impression ou "
    PRINT " sortie sur <F>ichier "; "<A , S, ou F>";
    DO
       rep$ = UCASE$(INPUT$(1))
    LOOP UNTIL rep$ = "A" OR rep$ = "S" OR rep$ = "F"
    IF rep$ = "F" THEN
         DO
              PRINT
              PRINT "Entrez un nom de fichier (8 lettres max)  "
              INPUT ""; NAME$
              IF LEN(NAME$) <= 8 THEN
                   ' par defaut, l'extension du fichier est .ref
                   NAME$ = NAME$ + ".ref"
                   EXIT DO
              ELSE
                   PRINT
                   PRINT " Nom de fichier non-conforme"
                   PRINT " Recommencez s.v.p."
                   delier# = 4
                   DELay
              END IF
         LOOP
         NO2fich% = FREEFILE
         OPEN NAME$ FOR OUTPUT AS #NO2fich%
    END IF
    IF rep$ = "A" THEN
        NS$(2) = "Imprimante <1> = 80 ou <2> = 132 colonnes ?"
        AFFscr 6, 10, 2, PO%
        DO
             IM$ = INPUT$(1)
        LOOP UNTIL IM$ = "1" OR IM$ = "2"
    END IF
    IF rep$ = "A" AND IM$ = "2" THEN
        WIDTH LPRINT 136
    END IF
 '********' lecture des donnees*************
10  
    tra% = 0
    trb% = 0
    trc% = 0
    FOR J% = 1 TO 223
        READ TBAS$(J%)
    NEXT J%
    NL% = 0                            ' NL% = Nø de ligne
    g$ = CHR$(34)                      ' '"'
    Nofich% = FREEFILE                    ' N° de fichier pour ouverture
    OPEN NF$ FOR INPUT AS #Nofich%     ' ouverture du fichier a analyser
    DO
         DO
              LINE INPUT #Nofich%, I$(1)
              ' ligne a analyser
              I$(1) = LTRIM$(RTRIM$(I$(1)))
              DO
                    ' si en fin de ligne caractere underscore, alors
                    ' completer la ligne
                    IF RIGHT$(I$(1), 1) = "_" THEN
                       LINE INPUT #Nofich%, M2$
                       I$(1) = LEFT$(I$(1), INSTR(I$(1), "_") - 1) + M2$
                    ELSEIF INSTR(I$(1), "_") > 0 THEN
                       IF INSTR(I$(1), "'") > 0 THEN          ' rechercher commentaire
                           I$(1) = LTRIM$(RTRIM$(LEFT$(I$(1), INSTR(I$(1), "'") - 1))) 'le supprimer
                       ELSEIF INSTR(I$(1), "REM") > 0 THEN
                           I$(1) = LTRIM$(RTRIM$(LEFT$(I$(1), INSTR(I$(1), "REM") - 1))) 'le supprimer
                       END IF
                       LINE INPUT #Nofich%, M2$
                       I$(1) = LEFT$(I$(1), INSTR(I$(1), "_") - 1) + M2$
                    ELSE
                        EXIT DO
                    END IF
              LOOP
              K% = 0
              NL% = NL% + 1                         ' NL% = N° de ligne
              NO% = N%                             ' nombre de variables
              Pxl% = 0                               ' flag N° etiquette
              guil% = 0                               ' compteur de guillemets
              ap% = 0                               ' compteur d'apostrophe
              IF LEN(I$(1)) = 0 THEN EXIT DO           ' Si la ligne est vide
              FOR J% = 1 TO LEN(I$(1))                ' examen de la ligne
                   C$ = MID$(I$(1), J%, 1)              ' et recherche des
                   SELECT CASE C$                  ' guillemets
                       CASE IS = g$
                          guil% = guil% + 1
                          a%(guil%) = J%
                       CASE IS = "'"                   ' et apostrophes = REM
                          ap% = ap% + 1
                   END SELECT
              NEXT J%
              IF guil% THEN
                  SEPGUIL                           ' suppression des guillemets
              END IF
              C$ = LEFT$(I$(1), 1)                    ' 1er caractere
              IF ASC(C$) > 47 AND ASC(C$) < 58 THEN ' Si c'est un chiffre
                   K% = INSTR(I$(1), " ")             ' alors c'est un N° de label
                   IF K% > 0 THEN                     'recherche du caratere espace
                      N$ = LEFT$(I$(1), K% - 1)      ' garder le N° a gauche de l'espace
                      Pxl% = 1                     ' temoin presence des N°
                      I$(1) = MID$(I$(1), K% + 1)     ' supprimer le N° de label
                      C$ = LEFT$(I$(1), 1)           ' caratere suivant
                   END IF
              END IF
              IF C$ = "'" THEN                      ' si 1er caractère = apostrophe
                    EXIT DO                        ' apostrophe seule, ignorer
              END IF
              IF ap% > 0 THEN                         ' si presence apostrophe,
                  K% = INSTR(1, I$(1), "'")             ' supprimer le commentaire
                  IF K% > 0 THEN
                      I$(1) = RTRIM$(LEFT$(I$(1), K% - 1))
                  END IF
              END IF
              K% = INSTR(I$(1), ":")                  ' rechercher des ":" --> instructions
              IF K% > 0 THEN                          ' multiples, et
                 VERIF                             ' les separer
              END IF
              IF Pxl% > 0 THEN                      ' si presence etiquettes,
                 Pxl% = 0                          ' remettre a 0 le flag des N°
              ELSE
                 N$ = "*" + LTRIM$(STR$(NL%))               ' ou prendre le N° de ligne
              END IF
              N$ = RIGHT$("     " + N$, 5)              ' numero de ligne
              LOCATE 7, 10
                                                    ' affiche le traitement en cours
              PRINT "Ligne #"; N$; "     Variables #"; N%
              ' si data ou rem, ignorer
              IF LEFT$(I$(1), 4) = "DATA" OR LEFT$(I$(1), 3) = "REM" THEN EXIT DO
              V% = 0
              IF UCASE$(LEFT$(I$(1), 3)) = "SUB" THEN
                   tra1% = tra1% + 1
                   nm% = INSTR(I$(1), " ")              ' rechercher un espace separateur
                   nm2% = INSTR(nm% + 1, I$(1), " ")    ' et un second s'il existe
                   IF nm2% > 0 THEN                 ' si pas trouve
                        nm3% = INSTR(nm% + 1, I$(1), "'") 'recherche un apostrophe de commentaire
                        nm3a% = INSTR(nm% + 1, UCASE$(I$(1)), "REM") ' ou un REM
                        IF nm3% = 0 AND nm3a% = 0 THEN
                              SUBROUT$(tra1%) = RTRIM$(RIGHT$(I$(1), (LEN(I$(1)) - nm%)))
                        ELSE
                              IF nm3% > 0 THEN
                                   SUBROUT$(tra1%) = RTRIM$(LEFT$(I$(1), LEN(I$(1)) - (LEN(I$(1)) - LEN(RIGHT$(I$(1), nm3% - 1)))))
                              ELSEIF nm3a% > 0 THEN
                                 SUBROUT$(tra1%) = RTRIM$(LEFT$(I$(1), LEN(I$(1)) - (LEN(I$(1)) - LEN(RIGHT$(I$(1), nm3a% - 1)))))
                              END IF
                        END IF
                   ELSEIF nm2% = 0 THEN
                          SUBROUT$(tra1%) = RTRIM$(RIGHT$(I$(1), (LEN(I$(1)) - nm%)))
                   END IF
              END IF
              IF UCASE$(LEFT$(I$(1), 8)) = "FUNCTION" THEN
                   trb1% = trb1% + 1
                   nm% = INSTR(I$(1), " ")
                   nm2% = INSTR(LEN("FUNCTION") + 1, I$(1), " ")
                   IF nm2% > 0 THEN
                        nm3% = INSTR(nm% + 1, I$(1), "'") 'recherche un apostrophe de commentaire
                        nm3a% = INSTR(nm% + 1, UCASE$(I$(1)), "REM") ' ou un REM
                        IF nm3% = 0 AND nm3a% = 0 THEN
                            FONCTION$(trb1%) = RTRIM$(RIGHT$(I$(1), (LEN(I$(1)) - nm%)))
                        ELSEIF nm3% > 0 THEN
                                   FONCTION$(trb1%) = RTRIM$(LEFT$(I$(1), LEN(I$(1)) - (LEN(I$(1)) - LEN(RIGHT$(I$(1), nm3% - 1)))))
                        ELSEIF nm3a% > 0 THEN
                                 FONCTION$(trb1%) = RTRIM$(LEFT$(I$(1), LEN(I$(1)) - (LEN(I$(1)) - LEN(RIGHT$(I$(1), nm3a% - 1)))))
                        END IF
                   ELSEIF nm2% = 0 THEN
                         FONCTION$(trb1%) = RTRIM$(RIGHT$(I$(1), (LEN(I$(1)) - nm%)))
                   END IF
              END IF
              FOR J% = 1 TO 20                      ' boucle d'examen de la ligne
                   IF LEN(I$(J%)) > 0 THEN
                        FOR I% = 1 TO LEN(I$(J%)) + 1
                            IF I% = LEN(I$(J%)) + 1 THEN
                                 x$ = " "             ' ajouter 1 espace pour valider
                            ELSE                    ' la derniere variable
                                 x$ = UCASE$(MID$(I$(J%), I%, 1))
                            END IF
                            controle                  ' sous prog. de recueuil des variables
                        NEXT I%
                   END IF
              NEXT J%
              EXIT DO
         LOOP
         RAZ 20, I$()                          ' remise a 0 du tableau I$
         IF EOF(Nofich%) THEN EXIT DO                ' si fin de fichier,
    LOOP                                       ' sortie de boucle
    CLOSE Nofich%                                   ' fermeture du fichier
    ERASE I$, a%                               ' recuperer de la memoire
    PRINT "Tri en cours (nombre d'elements a trier:"; N%; ")"
    TRI TT$()                                  ' trier les elements
    IF rep$ = "A" THEN                         ' si "A" --> impression
         LPRINT
         LPRINT "    Analyse croisee du programme "; NF$
         LPRINT
         LPRINT "    Nombre de variables : "; N%
         LPRINT
    END IF
    PRINT
    PRINT "    Analyse croisee du programme "; NF$
    PRINT
    PRINT "    Nombre de variables : "; N%
    PRINT
    IF rep$ = "F" THEN
         PRINT NO2fich%, "    Analyse croisee du programme "; NF$
         PRINT NO2fich%, ""
         PRINT NO2fich%, "    Nombre de variables : "; N%
         PRINT NO2fich%, ""
    END IF
    FOR I% = 1 TO N%
        RAZ 30, R$()                             ' remise a 0 tableau R$
        ALIGNE I%                                ' mise en forme
        FOR J% = 1 TO 30
             IF LEN(R$(J%)) > 0 THEN               ' si non vide, impression
                   IF rep$ = "S" THEN
                       IF J% > 1 THEN
                           PRINT SPACE$(20);
                       END IF
                       PRINT R$(J%)
                       delier# = .2                      ' appliquer un délai pour
                       DELay                             ' avoir le temps de lire
                   ELSEIF rep$ = "A" THEN
                        IF J% > 1 THEN
                            LPRINT SPACE$(20);
                        END IF
                        LPRINT R$(J%)
                   ELSE
                        IF J% > 1 THEN
                            PRINT NO2fich%, SPACE$(20);
                        END IF
                        PRINT NO2fich%, R$(J%)
                   END IF
             ELSE                                  ' sinon continuer
                  EXIT FOR
             END IF
        NEXT J%
    NEXT I%
    IF rep$ = "A" THEN
        IF tra1% > 0 THEN
           LPRINT
           LPRINT
           LPRINT "****SUBroutines****"
           LPRINT
           FOR I% = 1 TO tra1%
               LPRINT SUBROUT$(I%)
           NEXT I%
        END IF
        IF trb1% > 0 THEN
           LPRINT ""
           LPRINT ""
           LPRINT "****FUNCTIONS****"
           FOR I% = 1 TO trb1%
                LPRINT FONCTION$(I%)
           NEXT I%
        END IF
    ELSEIF rep$ = "S" THEN
        IF tra1% > 0 THEN
           PRINT
           PRINT
           PRINT "****SUBroutines****"
           PRINT
           FOR I% = 1 TO tra1%
                 delier# = .2                      ' appliquer un délai pour
                 DELay                          ' avoir le temps de lire
                 PRINT SUBROUT$(I%)
           NEXT I%
        END IF
        IF trb1% > 0 THEN
           PRINT
           PRINT