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 " " 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 " vec impression ou " PRINT " ans impression ou " PRINT " sortie sur ichier "; ""; 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 PRINT "****FUNCTIONS****" FOR I% = 1 TO trb1% delier# = .2 ' appliquer un délai pour DELay ' avoir le temps de lire PRINT FONCTION$(I%) NEXT I% END IF ELSEIF rep$ = "F" THEN IF tra1% > 0 THEN PRINT NO2fich%, "" PRINT NO2fich%, "" PRINT NO2fich%, "****SUBroutines****" FOR I% = 1 TO tra1% PRINT NO2fich%, SUBROUT$(I%) NEXT I% END IF IF trb1% > 0 THEN PRINT NO2fich%, "" PRINT NO2fich%, "" PRINT NO2fich%, "****FUNCTIONS****" FOR I% = 1 TO trb1% PRINT NO2fich%, FONCTION$(I%) NEXT I% END IF END IF CLOSE NO2fich% ' fermer le fichier de sortie END traiterreur: PRINT "erreur a la ligne"; ERL IF ERR = 6 THEN PRINT "depassement de capacite ERREUR 6" ON ERROR GOTO 0 ELSEIF ERR = 7 THEN PRINT "memoire insuffisante ERREUR 7" ON ERROR GOTO 0 ELSEIF ERR = 14 THEN PRINT "espace pour chaines sature ERREUR 14" ON ERROR GOTO 0 ELSEIF ERR = 25 THEN PRINT "defaillance du peripherique ERREUR 25" ON ERROR GOTO 0 ELSEIF ERR = 51 THEN PRINT "Erreur interne non recuperable ERREUR 51" ON ERROR GOTO 0 ELSEIF ERR = 52 THEN PRINT "nom ou n° de fichier incorrect ERREUR 52" ELSEIF ERR = 53 THEN PRINT "Fichier non trouve ERREUR 53" ON ERROR GOTO 0 ELSEIF ERR = 62 THEN PRINT "entree hors limite du Fichier ERREUR 62" ON ERROR GOTO 0 ELSEIF ERR = 68 THEN PRINT "Peripherique non disponnible ERREUR 68" ON ERROR GOTO 0 ELSEIF ERR = 70 THEN PRINT "Acces refuse ERREUR 70" ON ERROR GOTO 0 ELSEIF ERR = 71 OR ERR = 72 THEN PRINT "Disque non pret ou defectueux ERREUR 71 ou 72" ON ERROR GOTO 0 ELSEIF ERR = 75 THEN PRINT "Erreur Chemin d'acces" PRINT "ou Erreur d'acces au fichier ERREUR 75" ON ERROR GOTO 0 ELSEIF ERR = 76 THEN PRINT "Chemin d'acces introuvable ERREUR 76" ON ERROR GOTO 0 END IF RESUME NEXT '------------------------------------------------------------------------------ ' eof() xref1.bas. '****************************************************************************** FUNCTION AFFctre% (Mnum%) ' centre le message a afficher ' (Mnum% = Nø Message) ' AFFctre% retourne le nombre d'espaces de déplacement '------------------------------------------------------------------------------ AFFctre% = INT((78 - LEN(NS$(Mnum%))) / 2) END FUNCTION '****************************************************************************** SUB AFFcur (WI%) ' Affichage du curseur ' si WI% = 0 --> efface le curseur ' si WI% = 1 --> affiche le curseur '------------------------------------------------------------------------------ 20 DIM lregsi AS RegType IF WI% = 1 THEN lregsi.ax = &H100 lregsi.cx = PtiCUrseur ELSE lregsi.ax = &H200 lregsi.bx = &H0 lregsi.dx = PasCUrseur END IF CALL INTERRUPT(&H10, lregsi, lregsi) END SUB '****************************************************************************** SUB AFFmen (E%, Y$()) '****************************************************************************** 30 K% = 1 ' indice tableau xy% = 1 ' indicateur multi colonnes Col% = 1 ' colonne écran de début DO FOR Sr% = E% TO 24 ' ligne ecran 3 a 24 IF LEN(Y$(K%)) > 0 THEN ' si tableau non vide NS$(2) = Y$(K%) AFFscr E%, Col%, 2, PO% ' afficher E% = E% + 1 ' actualiser la ligne K% = K% + 1 ' pointe sur l'indice suivant ELSE Mk% = K% - 1 ' conserver la borne supérieure EXIT DO ' END IF NEXT Sr% Col% = Col% + 13 ' pointer sur la prochaine colonne IF Col% > 76 THEN Mk% = K% - 1 FOR indic% = 1 TO UBOUND(Y$, 1) IF LEN(Y$(indic%)) = 0 THEN indic% = indic% - 1 EXIT FOR END IF NEXT indic% EXIT DO END IF E% = 3 ' ligne = 2 xy% = xy% + 1 ' Nø de colonne LOOP END SUB '****************************************************************************** SUB AFFscr (PLin%, Row%, NMEs%, MO%) ' Affiche à l'écran le message sur la ligne et la colonne ' parametres: PLin% = Nø de rangee sur l'ecran ' Row% = Nø de Colonne ' NMEs% = Nø de message ' MO% = BOOLEAN (curseur) '------------------------------------------------------------------------------ 40 IF MO% THEN COLOR Carcurs%, FondCurs% ELSE COLOR Cardef%, Fondef% END IF LOCATE PLin%, Row% PRINT NS$(NMEs%); END SUB '****************************************************************************** SUB ALIGNE (E%) ' Mise en forme des elements ' pour l'ecran, l'imprimante et sortie sur fichier '------------------------------------------------------------------------------ 50 K% = LEN(TT$(E%)) IF rep$ = "A" THEN IF IM$ = "2" THEN LGI% = 127 LGR% = 108 ELSE LGI% = 79 LGR% = 55 END IF ELSE LGI% = 79 LGR% = 55 END IF IF K% <= LGI% THEN x% = INSTR(TT$(E%), " ") IF x% <= 20 THEN R$(1) = TT$(E%) ELSEIF x% > 20 THEN Ar$ = TT$(E%) R$(1) = LEFT$(Ar$, x% - 1) Ar$ = RIGHT$(TT$(E%), (K% - x%) + 1) R$(2) = Ar$ END IF ELSEIF K% > LGI% + 1 THEN Ar$ = TT$(E%) x% = INSTR(Ar$, " ") IF x% <= 20 THEN x% = INSTR(LGR% - 5, Ar$, " ") R$(1) = LEFT$(Ar$, x% - 1) Ar$ = RIGHT$(TT$(E%), K% - x%) ELSEIF x% > 20 THEN R$(1) = LEFT$(Ar$, x% - 1) Ar$ = RIGHT$(TT$(E%), (K% - x%) + 1) END IF FOR LZ% = 2 TO 30 IF LEN(Ar$) > LGR% THEN x% = INSTR(LGR% - 1, Ar$, " ") R$(LZ%) = LEFT$(Ar$, x% - 1) Ar$ = RIGHT$(Ar$, LEN(Ar$) - LEN(R$(LZ%)) - 1) ELSE R$(LZ%) = Ar$ EXIT FOR END IF NEXT LZ% END IF END SUB '****************************************************************************** SUB APPEnter (AF%) ' Attend un caractere Clavier ' si AF% = 0 ---> attente d'un caractere ' si AF% = 1 ---> affiche message et attente caractere '------------------------------------------------------------------------------ 60 IF AF% THEN NS$(2) = "Appuyez sur pour continuer ..." AFFscr Li%, Col%, 2, PO% Col% = Col% + LEN(NS$(2)) + 2 END IF LOCATE Li%, Col% AFFcur 1 DO R$ = INKEY$ IF R$ <> "" THEN AFFcur 0: EXIT DO LOOP IF R$ = "o" OR R$ = "n" THEN R$ = UCASE$(R$) ELSEIF R$ = CHR$(44) THEN R$ = CHR$(46) END IF END SUB '****************************************************************************** SUB collect ' obtenir le catalogue des repertoires et des fichiers. '------------------------------------------------------------------------------ 70 CLS SHELL "dir /A:D > dir.rep" ' répertoires SHELL "dir *.bas /A:-D /B > dir.txt" ' fichiers basics NNfich% = FREEFILE OPEN "dir.rep" FOR INPUT AS #NNfich% K% = 0 DO UNTIL EOF(NNfich%) LINE INPUT #NNfich%, ir$ IF INSTR(ir$, "") THEN K% = K% + 1 dir$(K%) = RTRIM$(LEFT$(ir$, 12)) + "\" ELSEIF INSTR(ir$, "") THEN K% = K% + 1 dir$(K%) = RTRIM$(LEFT$(ir$, 12)) + "\" END IF LOOP CLOSE #NNfich% NN1Fich% = FREEFILE OPEN "dir.txt" FOR INPUT AS #NN1Fich% DO UNTIL EOF(NN1Fich%) K% = K% + 1 LINE INPUT #NN1Fich%, dir$(K%) LOOP CLOSE #NN1Fich% KILL "dir.rep" KILL "dir.txt" END SUB '****************************************************************************** FUNCTION Comple$ (Y$(), K%) ' complete le format par des espaces '------------------------------------------------------------------------------ 80 IF LEN(Y$(K%)) <= 12 THEN Comple$ = Y$(K%) + SPACE$(12 - LEN(Y$(K%))) END IF END FUNCTION '****************************************************************************** SUB controle ' examen de chaque caractere de la ligne ' X$ = 1 caractere, ' M$ = collection des caracteres apres controle '------------------------------------------------------------------------------ 90 DO IF V% = 0 AND x$ <= "Z" AND x$ >= "A" THEN V% = 1 ' flag de caractere valide M$ = x$ ' M$ = variable ou instruction EXIT DO ELSEIF V% = 0 THEN EXIT DO END IF x% = ASC(x$) SELECT CASE x% CASE 9, 10 x% = 32 ' remplacer par espace CASE 46, 48 TO 57, 63 TO 90, IS < 32 ' cas "." , de 0 à 9, de "? a Z, et inferieur a espace M$ = M$ + x$ EXIT DO CASE 33, 35 TO 38 ' pour les caracteres "! # $ % &" SELECT CASE M$ CASE "FIELD", "CLOSE", "GET", "PUT", "INPUT", "PRINT", "WRITE", "READ", "OPEN" ' ne rien faire !! CASE ELSE M$ = M$ + x$ END SELECT END SELECT FOR K% = 1 TO 223 IF M$ = TBAS$(K%) THEN ' boucle de filtrage des instructions basic K% = 223 ' correspondance, mettre fin a la recherche V% = 0 EXIT DO END IF NEXT K% V% = 0 LG% = LEN(M$) IF LG% < 20 THEN TY$ = LEFT$(M$ + SPACE$(20 - LG%), 20) + N$ ELSE TY$ = LEFT$(M$, LG%) + N$ END IF FOR Z% = NO% TO N% ' boucle de controle x% = INSTR(TT$(Z%), " ") ' avant affectation ' *** Si la variable existe deja, on n'ajoute que le ' Nø d'etiquette ou de ligne IF x% > 0 THEN IF M$ = LEFT$(TT$(Z%), x% - 1) THEN IF INSTR(TT$(Z%), N$) = 0 THEN TT$(Z%) = TT$(Z%) + " " + N$ EXIT DO ELSE EXIT DO END IF END IF END IF NEXT Z% N% = N% + 1 TT$(N%) = TY$ ' affectation de la variable V% = 0 EXIT DO LOOP END SUB '****************************************************************************** SUB curmenu (x%, Y$(), Choix$) STATIC ' Large curseur x% = Ligne% ' Y$() = Tableau ' Choix$ = Valeur de retour --> NF$ '------------------------------------------------------------------------------ 100 AFFmen x%, Y$() mxy% = 1 'Nø actuel de colonne K% = 1 'indice de tableau x% = 3 'ligne Col% = 1 'adresse reelle de colonne DO NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% APPEnter 0 SELECT CASE R$ 'Handle touches speciales CASE CHR$(0) + "H" 'fleche haut IF mxy% >= 1 AND x% > 3 THEN AFFscr x%, Col%, 2, PO% x% = x% - 1 K% = K% - 1 NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% END IF IF mxy% > 1 AND x% = 3 THEN AFFscr x%, Col%, 2, PO% x% = 24 mxy% = mxy% - 1 Col% = Col% - 13 K% = K% - 1 NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% END IF CASE CHR$(0) + "P" 'Fleche bas IF mxy% >= 1 THEN IF x% < 24 THEN IF Mk% > K% THEN AFFscr x%, Col%, 2, PO% x% = x% + 1 K% = K% + 1 NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% END IF ELSE IF Mk% > K% THEN AFFscr x%, Col%, 2, PO% x% = 3 K% = K% + 1 Col% = Col% + 13 mxy% = mxy% + 1 NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% END IF END IF END IF CASE CHR$(0) + "K" 'fleche gauche IF mxy% > 1 THEN AFFscr x%, Col%, 2, PO% mxy% = mxy% - 1 Col% = Col% - 13 K% = K% - ((x% - 3) + (25 - x%)) NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% END IF CASE CHR$(0) + "M" 'fleche droite IF mxy% < xy% THEN AFFscr x%, Col%, 2, PO% mxy% = mxy% + 1 K% = K% + ((25 - x%) + (x% - 3)) IF K% > Mk% THEN delt% = K% - Mk% K% = Mk% x% = x% - delt% END IF Col% = Col% + 13 NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% END IF CASE CHR$(0) + "G" 'touche Home AFFscr x%, Col%, 2, PO% mxy% = 1 Col% = 1 x% = 3 K% = 1 NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% CASE CHR$(0) + "O" ' touche End AFFscr x%, Col%, 2, PO% x% = 2 + Mk% MOD (25 - 3) K% = Mk% Col% = 1 + (Mk% \ (25 - 3)) * 13 mxy% = xy% NS$(2) = Comple$(Y$(), K%) AFFscr x%, Col%, 2, AO% CASE CHR$(13) ' Retour Chariot K% = K% Choix$ = LTRIM$(Y$(K%)) COLOR Cardef%, FondDef% IF RIGHT$(Choix$, 1) <> "\" THEN EXIT DO ELSEIF RIGHT$(Choix$, 1) = "\" THEN ERASE dir$ x% = 3 Choix$ = LTRIM$(RTRIM$(Choix$)) Choix$ = LEFT$(Choix$, LEN(Choix$) - 1) SHELL "CHDIR " + Choix$ collect AFFmen x%, Y$() x% = 3 Col% = 1 K% = 1 mxy% = 1 END IF CASE ELSE ' Autres cas BEEP END SELECT LOOP END SUB '****************************************************************************** SUB DELay ' delai d'affichage base sur le timer ' donc independant du type de Processeur '------------------------------------------------------------------------------ 110 debut# = TIMER DO temp# = TIMER IF temp# - debut# >= delier# THEN EXIT DO LOOP delier# = 0 END SUB '****************************************************************************** SUB RAZ (Y%, U$()) ' remise a zero du tableau U$() d'indices Y% '------------------------------------------------------------------------------ 120 FOR I% = 1 TO Y% IF LEN(U$(I%)) = 0 THEN EXIT FOR ELSE U$(I%) = "" END IF NEXT I% END SUB '****************************************************************************** SUB SEPGUIL ' suppression des guillemets et leurs contenus '------------------------------------------------------------------------------ 130 IF guil% > 1 THEN K% = 0 FOR J% = 1 TO guil% SELECT CASE J% CASE IS = 1 MI$ = LEFT$(I$(1), a%(J%) - 1) CASE 3, 5, 7, 9, 11, 13, 15, 17, 19 K% = ((a%(J%) - 1) - (a%(J% - 1))) MI$ = MI$ + MID$(I$(1), a%(J% - 1) + 1, K%) END SELECT NEXT J% I$(1) = MI$ ELSEIF guil% = 1 THEN LOCATE 20, 10 PRINT "structure du programme anormale a la ligne "; NL% PRINT "Appuyez sur entree pour continuer ..." C$ = INPUT$(1) LOCATE 20, 10 PRINT SPACE$(54) PRINT SPACE$(54) END IF END SUB '****************************************************************************** SUB TRI (am$()) ' selon la methode de shell '------------------------------------------------------------------------------ 140 PA% = N% DO PA% = INT(PA% / 2) IF PA% < 1 THEN EXIT DO J% = 1 K% = N% - PA% DO I% = J% DO L% = I% + PA% IF am$(I%) < am$(L%) THEN EXIT DO ELSE SWAP am$(L%), am$(I%) I% = I% - PA% IF I% <= 0 THEN EXIT DO END IF END IF LOOP J% = J% + 1 LOOP WHILE J% <= K% LOOP END SUB '****************************************************************************** SUB VERIF ' separation des instructions multiples '------------------------------------------------------------------------------ 150 ch$ = I$(1) NB% = 0 x% = 0 IF LEN(ch$) > 1 THEN DO x% = INSTR(x% + 1, ch$, ":") ' recherche des ":" IF x% > 0 THEN ' si existe, incrementer NB% NB% = NB% + 1 ELSEIF x% = 0 THEN ' sinon, sortir EXIT DO END IF LOOP IF NB% > 0 THEN ' si NB% superieur a 0 FOR I% = 1 TO NB% x% = INSTR(ch$, ":") ' recherche d'autre ":" IF x% > 0 THEN ' si existe, alors retenir les elements a gauxhe I$(I%) = LEFT$(ch$, x% - 1) ' en excluant les ":" ch$ = MID$(ch$, x% + 1) ' en memoire dans ch$ END IF NEXT I% IF NB% > 0 THEN I$(I%) = ch$ ' puis dans le tableau i$(i%) END IF END IF END IF END SUB