JL35
Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007
| Sujet: Re: A la recherche des variables... Ven 27 Fév 2015 - 13:31 | |
| Je m'y suis déjà cassé les dents (ce qu'il en reste, ça n'a pas arrangé les choses) autrefois, voici un des résultats, utilisable: - Code:
-
' Analyse d'un programme source Panoramic (.bas) DIM w0, h0, a$, a1$, b$, c$, v$, sva$, fm$, fn$, f$, fs$, font$, fsz%, fpr%, afl% DIM i%, j%, k%, k1%, k2%, n%, nl%, u%, ign%, lv%, flf%, fls%, dir$, flsz%, lc%, nc% DIM objn$(100), var$(200), obj$(200), eti$(100), tob%, nvar%, nobj%, neti%, wf, hf DIM indt%, car$(20), tca%, p$, s$, marg%, ll%(5000), ats$
LABEL opn, opn1, sav, savs, sauve, impr, quit, chp, cnl, vfont, vlf, new, copy LABEL paste, cut, Misfo, Listvar, Recvar, Reclab, Receti, Recobj, Recif, Recsou LABEL Instrs, Mids, der, ra, rb, rc, rd, re, rf, rg, rk, rces, rcvs LABEL Suit1, Suit2, Suit3, Suit4, Suit41, Suit5, Suit51, Suit6, Suit7, Suit8, Suit9 LABEL Recwhile, Recrep, Recseq, Debug, Ecsva, Supelem, Charsou, Afl, Supquot
' ERROR_FRENCH: ON_ERROR_GOTO Debug ' Noms des objets Panoramic: DATA "SCENE3D ","BUTTON ","EDIT ","MEMO ","COMBO ","ALPHA ","FORM ","LIST " DATA "PICTURE ","CHECK ","OPTION ","MAIN_MENU ","SUB_MENU ","SOUND ","MOVIE " DATA "TRACK_BAR ","OPEN_DIALOG ","SAVE_DIALOG ","SCROLL_BAR ","PROGRESS_BAR " DATA "SPIN ","GRID ","CONTAINER ","DLIST ","SCENE2D ","TIMER ","CONTAINER_OPTION " DATA "IMAGE " DATA "#" tob% = 0: READ a$ WHILE a$ <> "#": tob% = tob% + 1: objn$(tob%) = a$: READ a$ : END_WHILE ' Caractères susceptibles de côtoyer les variables dans le code ' (254 si variable en début de ligne, 255 si variable en fin de ligne) DATA " ","=",":","+","-","*","/",",",">","<","(",")",";",CHR$(254),CHR$(255) DATA "#" tca% = 0: READ a$ WHILE a$ <> "#": tca% = tca% + 1: car$(tca%) = a$: READ a$: END_WHILE
fm$ = "C:\TEMP\fpri.tmp" fn$ = "C:\TEMP\ftmp.tmp" dir$ = "C:\LANGAGES\Panoramic": ' répertoire des sources Panoramic ats$ = CHR$(92): ' anti-slash (escamoté par le forum panoramic si entre quotes)
w0 = 800: h0 = 900: h0 = SCREEN_Y-30 WIDTH 0, w0: HEIGHT 0, h0 CAPTION 0, " - ANALYSE D'UN PROGRAMME SOURCE PANORAMIC (.bas) - afl% = 1: ' affichage implicite des numéros de lignes marg% = 8
' Menus --------------------------------------------------------------- MAIN_MENU 1
' Menu principal SUB_MENU 2: CAPTION 2,"Fichier" : PARENT 2, 1 SUB_MENU 3: CAPTION 3,"Edition" : PARENT 3, 1 SUB_MENU 4: CAPTION 4,"Affichage": PARENT 4, 1 SUB_MENU 5: CAPTION 5,"Recherches": PARENT 5, 1
' Sous-menus 2 (Fichier) SUB_MENU 21: CAPTION 21,"Nouveau" : PARENT 21, 2 SUB_MENU 22: CAPTION 22,"Ouvrir" : PARENT 22, 2 SUB_MENU 23: CAPTION 23,"Ouvrir dernier enregistré": PARENT 23, 2 SUB_MENU 24: CAPTION 24,"Enregistrer" : PARENT 24, 2 SUB_MENU 25: CAPTION 25,"Enregistrer sous...": PARENT 25, 2 SUB_MENU 26: CAPTION 26,"Imprimer": PARENT 26, 2 SUB_MENU 27: CAPTION 27,"Quitter" : PARENT 27, 2 ON_CLICK 21, new: ON_CLICK 22, opn: ON_CLICK 23, der: ON_CLICK 24, sav ON_CLICK 25, savs: ON_CLICK 26, impr: ON_CLICK 27, quit
' Sous-menus 3 (Edition) SUB_MENU 31: CAPTION 31,"Copier" : PARENT 31, 3 SUB_MENU 32: CAPTION 32,"Coller" : PARENT 32, 3 SUB_MENU 33: CAPTION 33,"Couper" : PARENT 33, 3 ON_CLICK 31, copy: ON_CLICK 32, paste: ON_CLICK 33, cut
' Sous-menus 4 (Affichage) SUB_MENU 41: CAPTION 41,"Police": PARENT 41, 4 SUB_MENU 42: PARENT 42, 4 IF afl% = 0 CAPTION 42,"Numéros de lignes" ELSE CAPTION 42, "Suppr. N°s de lignes" END_IF ON_CLICK 41, chp: ON_CLICK 42, cnl
' Sous-menus 5 (Recherches) SUB_MENU 51: CAPTION 51,"Variables": PARENT 51, 5 SUB_MENU 52: CAPTION 52,"Labels": PARENT 52, 5 SUB_MENU 53: CAPTION 53,"Objets": PARENT 53, 5 SUB_MENU 54: CAPTION 54,"If...Then...End_If": PARENT 54, 5 SUB_MENU 55: CAPTION 55,"While...End_While": PARENT 55, 5 SUB_MENU 56: CAPTION 56,"Repeat...Until": PARENT 56, 5 SUB_MENU 57: CAPTION 57,"Sous-programmes": PARENT 57, 5 SUB_MENU 58: CAPTION 58,"Séquence...": PARENT 58, 5 ON_CLICK 51, Listvar: ON_CLICK 52, Reclab: ON_CLICK 53, Recobj ON_CLICK 54, Recif: ON_CLICK 55, Recwhile: ON_CLICK 56, Recrep ON_CLICK 57, Recsou: ON_CLICK 58, Recseq ' Fin menus -------------------------------------------------------------
FORM 96: TOP 96, 60: LEFT 96, 50: HEIGHT 96, 180: WIDTH 96, 260: HIDE 96 CAPTION 96, "Police/Taille" LIST 97: PARENT 97, 96: TOP 97, 5: HEIGHT 97, 90: WIDTH 97, 150 FONT_NAMES_LOAD 97: ON_CLICK 97, vfont SPIN 98: PARENT 98, 96: TOP 98, 5: LEFT 98, 160: WIDTH 98, 60 POSITION 98, 10: MIN 98, 6: MAX 98, 30: ON_CLICK 98, vfont BUTTON 99: PARENT 99, 96: TOP 99, 60: LEFT 99, 160: WIDTH 99, 80 CAPTION 99, "OK": ON_CLICK 99, vlf LIST 100: PARENT 100, 96: TOP 100, 100: WIDTH 100, 240: HEIGHT 100, 40 font$ = "Bitstream Vera Sans Mono": fsz% = 10 FONT_NAME 100, font$: FONT_SIZE 100, fsz% ITEM_ADD 100, font$ ITEM_ADD 100, "Voyez le Brick Géant Que J'examine Près du Wharf"
OPEN_DIALOG 11 FILTER 11,"Sources .bas|*.bas|Textes .txt|*.txt|Tous|*.*" SAVE_DIALOG 13 FILTER 13,"Sources|*.bas|Textes|*.txt|Tous|*.*"
' Fenêtre principale d'affichage fpr% = 12 MEMO fpr%: WIDTH fpr%, w0-16: HEIGHT fpr%, h0-56 FONT_NAME fpr%, font$: FONT_SIZE fpr%, fsz% BAR_BOTH fpr%
' Fenêtre des résultats de recherches flf% = 78: wf = 500: hf = h0-100 FORM flf%: TOP flf%, 60: LEFT flf%, 200: WIDTH flf%, wf: HEIGHT flf%, hf HIDE flf% fls% = flf%+1 LIST fls%: PARENT fls%, flf% TOP fls%, 0: LEFT fls%, 0: WIDTH fls%, wf-16: HEIGHT fls%, hf-40 COLOR fls%, 255,255,220 flsz% = 10: ' taille caractères FONT_NAME fls%, "Lucida Console": FONT_SIZE fls%, flsz%: FONT_COLOR fls%,0,0,128 lc% = INT(flsz%/1.25): IF FRAC(flsz%/1.25) >= 5 THEN lc% = lc%+1 nc% = INT(wf-20)/lc% - 4: ' nb de caractères affichables par ligne END ' -------------------------------------------------------------------- quit: TERMINATE ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- copy: CLIPBOARD_COPY fpr% RETURN paste: CLIPBOARD_PASTE fpr% RETURN cut: CLIPBOARD_CUT fpr% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- new: CLEAR fpr% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- opn: f$ = FILE_NAME$(11): IF f$ = "_" OR f$ = "" THEN RETURN opn1: IF afl% = 0 FILE_LOAD fpr%, f$ ELSE FILE_OPEN_READ 1, f$: FILE_OPEN_WRITE 2, fn$: nl% = 0 WHILE FILE_EOF(1) = 0 FILE_READLN 1, a$: nl% = nl% + 1 a$ = STR$(nl%) + ": " + a$ IF nl% < 1000 THEN a$ = STRING$(4-LEN(STR$(nl%)), " ") + a$ FILE_WRITELN 2, a$ END_WHILE FILE_CLOSE 1: FILE_CLOSE 2 FILE_LOAD fpr%, fn$: FILE_DELETE fn$ END_IF select_text fpr%, 4500, 50 CAPTION 0, f$ + " " + STR$(COUNT(fpr%)) + " lignes." RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- der: EXECUTE_WAIT "Cmd.exe /C DIR " + dir$ + "\*.bas /O:-D /B >" + fm$ FILE_OPEN_READ 1, fm$ FILE_READLN 1, f$: FILE_CLOSE 1: FILE_DELETE fm$ f$ = dir$ + ats$ + f$: GOTO opn1 RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- sav: fs$ = f$: GOSUB sauve RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- savs: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN fs$ = FILE_NAME$(13): IF fs$ = "_" OR fs$ = "" THEN RETURN GOSUB sauve RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- sauve: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN FILE_OPEN_WRITE 1, fs$ FOR i% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, i%) IF afl% = 1 ' sauvegarde sans les numéros de lignes k% = INSTR(a$, ":") IF k% <= 5 IF LEN(a$) > (k%+1) a$ = MID$(a$, k%+2, LEN(a$)-k%-1) ELSE a$ = "" END_IF END_IF END_IF FILE_WRITELN 1, a$ NEXT i% FILE_CLOSE 1 RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- impr: FILE_SAVE fpr%, fm$ EXECUTE_WAIT "write.exe /p " + fm$ FILE_DELETE fm$ RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- chp: SHOW 96 RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- cnl: FILE_OPEN_WRITE 2, fn$ IF afl% = 0 FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%) FILE_WRITELN 2, STRING$(4-LEN(STR$(nl%)), " ") + STR$(nl%) + ": " + a$ NEXT nl% afl% = 1: CAPTION 42, "Suppr. N°s de lignes" ELSE FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%) k% = INSTR(a$, ": ") IF k%<=5 IF LEN(a$)>(k%+1) a$ = MID$(a$, k%+2, LEN(a$)-k%-1) ELSE a$ = "" END_IF END_IF FILE_WRITELN 2, a$ NEXT nl% afl% = 0: CAPTION 42, "Numéros de lignes" END_IF FILE_CLOSE 2 CLEAR fpr% FILE_LOAD fpr%, fn$: FILE_DELETE fn$ RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- vfont: CLEAR 100 IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97) fsz% = POSITION(98) FONT_NAME 100, font$: FONT_SIZE 100, fsz% ITEM_ADD 100, font$ ITEM_ADD 100, "Voyez le Brick Géant Que J'examine Près du Wharf" RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- vlf: IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97) fsz% = POSITION(98) FONT_NAME fpr%, font$: FONT_SIZE fpr%, fsz% HIDE 96 RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Misfo: ' Mise en forme de a$ avant analyse (élimination des éléments superflus) ign% = 0 CAPTION flf%, STR$(nl%)+" / "+STR$(COUNT(fpr%)) IF afl% = 1 k% = INSTR(a$, ":"): IF k% > 0 THEN a$ = MID$(a$, k%+1, LEN(a$)) END_IF a$ = TRIM$(a$): IF a$ = "" THEN ign% = 1: RETURN GOSUB Supquot: ' *** Éliminer les contenus éventuels entre quotes ' *** Éliminer les commentaires IF a$ = "" OR LEFT$(LTRIM$(a$), 1) = CHR$(39) OR LEFT$(UPPER$(LTRIM$(a$)), 3) = "REM" ign% = 1: RETURN END_IF b$ = UPPER$(a$) + " ": k% = INSTR(b$, "REM ") k% = INSTR(UPPER$(a$), "REM"): IF k% = 0 THEN k% = INSTR(a$, CHR$(39)) IF k% > 0 IF MID$(a$, k%-1, 1) = " " OR MID$(a$, k%-1, 1) = ":" a$ = RTRIM$(LEFT$(a$, k%-2)) IF a$ = "" THEN ign% = 1: RETURN END_IF END_IF IF RIGHT$(a$, 1) = ":" THEN a$ = LEFT$(a$, LEN(a$) - 1) RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Supquot: ' *** Éliminer les contenus entre quotes k1% = 0: k2% = 0 FOR i% = 1 TO LEN(a$)-2 IF MID$(a$, i%, 1) = CHR$(34) THEN k1% = i%: EXIT_FOR NEXT i% IF k1% > 0 FOR i% = k1%+1 TO LEN(a$) IF MID$(a$, i%, 1) = CHR$(34) THEN k2% = i%: EXIT_FOR NEXT i% IF k2% > 0 THEN a$ = LEFT$(a$, k1%-1) + MID$(a$, k2%+1, LEN(a$)): GOTO Supquot a$ = LEFT$(a$, k1%-1): ' 2ème quote non trouvé END_IF RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Listvar: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN ' ***** VARIABLES DÉCLARÉES (DIM) ***************************************** CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES VARIABLES ******" ITEM_ADD fls%, "" ITEM_ADD fls%, " un moment svp..." nvar% = 0 FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit1 ra: k% = INSTR(UPPER$(a$), "DIM ") IF k% > 0 a$ = MID$(a$, k%+4, LEN(a$)-k%-3) k% = INSTR(a$, ":"): a1$ = "" IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1)
FOR i% = 1 TO LEN(a$) k1% = 0 IF MID$(a$, i%, 1) = "(" FOR j% = i%+1 TO LEN(a$) IF MID$(a$, j%, 1) = ")" FOR k% = i%+1 TO j%-1 IF MID$(a$, k%, 1) = "," a$ = LEFT$(a$, i%-1)+"["+MID$(a$, i%+1, LEN(a$)) a$ = LEFT$(a$, k%-1)+"."+MID$(a$, k%+1, LEN(a$)) a$ = LEFT$(a$, j%-1)+"]"+MID$(a$, j%+1, LEN(a$)) k1% = 1: EXIT_FOR END_IF NEXT k% EXIT_FOR END_IF NEXT j% END_IF NEXT i% rb: k% = INSTR(a$, ",") nvar% = nvar% + 1: b$ = STR$(nl%): b$ = STRING$(5-LEN(b$)," ") + b$ IF k% > 0 var$(nvar%) = TRIM$(LEFT$(a$, k%-1)) + b$ a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rb END_IF var$(nvar%) = TRIM$(a$) + b$ IF a1$ <> "" THEN a$ = a1$: GOTO ra END_IF Suit1: NEXT nl% IF nvar% = 0 THEN GOTO Suit41 ' remise en forme des déclarations de tableaux à double entrée ' (remplacement des crochets par des parenthèses et du point par virgule) FOR i% = 1 TO nvar% a$ = var$(i%) k% = INSTR(a$, "[") IF k% > 0 a$ = LEFT$(a$, k%-1) + "(" + MID$(a$, k%+1, LEN(a$)-k%) k% = INSTR(a$, "]") IF k% > 0 a$ = LEFT$(a$, k%-1) + ")" + MID$(a$, k%+1, LEN(a$)-k%) k% = INSTR(a$, ".") IF k% > 0 THEN a$ = LEFT$(a$, k%-1) + "," + MID$(a$, k%+1, LEN(a$)-k%) END_IF b$ = LEFT$(a$, LEN(a$)-5) FOR k% = 1 TO LEN(b$): ' suppression éventuelle des espaces superflus IF MID$(a$, k%, 1)=" " THEN b$=LEFT$(b$, k%-1) + MID$(b$,k%+1,LEN(b$)-k%) NEXT k% var$(i%) = b$ + RIGHT$(a$, 5) END_IF NEXT i% ' Tri alphabétique des résultats DLIST 89: FOR i% = 1 TO nvar%: ITEM_ADD 89, var$(i%): NEXT i% SORT 89: FOR i% = 1 TO nvar%: var$(i%) = ITEM_READ$(89, i%): NEXT i% DELETE 89 ' ajout des crochets autour des numéros de lignes (ligne de déclaration DIM) FOR i% = 1 TO nvar% var$(i%) = LEFT$(var$(i%), LEN(var$(i%))-5) + " [" + TRIM$(RIGHT$(var$(i%),5)) + "]" NEXT i% ' ***** RECHERCHE DES VARIABLES DANS LE CODE ******************************* FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit4 k% = INSTR(UPPER$(a$), "DIM ") IF k% = 0 THEN k% = INSTR(UPPER$(a$), "LABEL ") IF k% > 0 ' c'est une ligne de DIM ou de LABEL a1$ = "": IF k% > 1 THEN a1$ = LEFT$(a$, k%-1) b$ = MID$(a$, k%, LEN(a$)-k%+1) k1% = INSTR(b$, ":") IF k1% > 0 a$ = a1$ + MID$(b$, k1%, LEN(b$)-k1%+1) ELSE a$ = a1$ END_IF IF TRIM$(a$) = "" THEN GOTO Suit4 END_IF k% = INSTR(UPPER$(a$), "LABEL") FOR n% = 1 TO nvar% v$ = var$(n%): k% = INSTR(v$, " "): v$ = LEFT$(v$, k%-1) GOSUB Recvar IF ign% = 0 THEN var$(n%) = var$(n%) + "," + STR$(nl%) NEXT n% Suit4: NEXT nl% Suit41: HIDE flf%: CLEAR fls% ITEM_ADD fls%, " ****** LISTE DES VARIABLES ("+STR$(nvar%)+") ******" ITEM_ADD fls%, "" IF nvar% > 0 FOR i% = 1 TO nvar% a$ = var$(i%): GOSUB Afl NEXT i% END_IF SHOW flf% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recvar: ' Recherche de la variable v$ dans a$ sva$ = a$: ign% = 0 k% = INSTR(v$, "("): ' tableaux IF k% > 0 THEN v$ = LEFT$(v$, k%) lv% = LEN(v$) c$ = CHR$(254) rf: k% = INSTR(a$, v$): IF k% < 1 THEN ign% = 1: GOTO rcvs s$ = CHR$(255) IF k% > 1 THEN c$ = MID$(a$, k%-1,1): ' caractère précédent (si pas le 1er) IF k% < (LEN(a$)-lv%+1) THEN s$ = MID$(a$, k%+lv%, 1): ' caractère suivant (si pas le dernier) j% = 0 FOR i% = 1 TO tca% IF c$ = car$(i%) THEN j% = 1: EXIT_FOR NEXT i% IF j% = 0 THEN a$ = MID$(a$, k%+1, LEN(a$)): GOTO rf j% = 0 FOR i% = 1 TO tca% IF s$ = car$(i%) THEN j% = 1: EXIT_FOR NEXT i% IF RIGHT$(v$, 1) <> "(" IF j% = 0 THEN c$ = MID$(a$, k%, 1): a$ = MID$(a$, k%+1, LEN(a$)): GOTO rf END_IF ' trouvé rcvs: a$ = sva$ RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Afl: k% = INSTR(a$, " "): b$ = MID$(a$, k%, LEN(a$)): a$ = LEFT$(a$, k%-1) IF LEN(a$) < marg% THEN a$ = a$ + STRING$(marg%-LEN(a$), " ") a$ = a$ + b$ rk: IF LEN(a$) > nc% FOR j% = nc%+1 TO 0 STEP -1 IF MID$(a$, j%, 1) = "," THEN EXIT_FOR NEXT j% ITEM_ADD fls%, LEFT$(a$, j%) a$ = STRING$(marg%+1, " ") + MID$(a$, j%+1, LEN(a$)-j%): GOTO rk END_IF ITEM_ADD fls%, a$ RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Instrs: ' recherche de b$ dans a$ à partir de u% -> k1% k1% = 0 IF u% <= LEN(a$) c$ = MID$(a$, u%, LEN(a$)-u%+1): k1% = INSTR(c$, b$) IF k1% > 0 THEN k1% = k1% + u% - 1 END_IF RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Mids: ' renvoie la chaîne b$, reste de a$ à partir de k% (y compris vide) b$ = "": IF k% <= LEN(a$) THEN b$ = MID$(a$, k%, LEN(a$)-k%+1) RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Reclab: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES LABELS ******" ITEM_ADD fls%, "" ITEM_ADD fls%, " un moment svp..." neti% = 0 ' ***** ÉTIQUETTES DÉCLARÉES (LABEL) *********************************** FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit2 k% = INSTR(UPPER$(a$), "LABEL ") IF k% > 0 a$ = MID$(a$, k%+6, LEN(a$)-k%-5) rc: k% = INSTR(a$, ":"): a1$ = "" IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1) rd: k% = INSTR(a$, ",") neti% = neti% + 1: b$ = STR$(nl%): b$ = STRING$(5-LEN(b$)," ") + b$ IF k% > 0 eti$(neti%) = TRIM$(LEFT$(a$, k%-1)) + b$ a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rd END_IF eti$(neti%) = TRIM$(a$) + b$ IF a1$ <> "" THEN a$ = a1$: GOTO rc END_IF Suit2: NEXT nl% IF neti% = 0 THEN GOTO Suit51 FOR i% = 1 TO neti% eti$(i%) = LEFT$(eti$(i%), LEN(eti$(i%))-5) + " [" + TRIM$(RIGHT$(eti$(i%),5)) + "]" NEXT i% ' Tri alphabétique du résultat DLIST 89: FOR i% = 1 TO neti%: ITEM_ADD 89, eti$(i%): NEXT i% SORT 89: FOR i% = 1 TO neti%: eti$(i%) = ITEM_READ$(89, i%): NEXT i% DELETE 89 ' ***** RECHERCHE DES APPELS AUX LABELS DANS LE CODE ************************ FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit5 k% = INSTR(UPPER$(a$), "LABEL "): IF k% > 0 THEN GOTO Suit5 FOR i% = 1 TO neti% v$ = eti$(i%): k% = INSTR(v$, " "): v$ = LEFT$(v$, k%-1) GOSUB Receti IF ign% = 0 THEN eti$(i%) = eti$(i%) + "," + STR$(nl%) NEXT i% Suit5: NEXT nl% Suit51: HIDE flf% CLEAR fls%: ITEM_ADD fls%, " ****** LISTE DES LABELS ("+STR$(neti%)+") ******" ITEM_ADD fls%, "" IF neti% > 0 FOR i% = 1 TO neti% a$ = eti$(i%): GOSUB Afl NEXT i% END_IF SHOW flf% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Receti: ' Recherche de l'étiquette v$ dans a$ sva$ = a$: ign% = 0: lv% = LEN(v$) k% = INSTR(a$, v$) IF k% = 1 AND a$ = v$ THEN GOTO rces: ' étiquette en place IF k% < 6 THEN ign% = 1: GOTO rces IF MID$(a$, k%-1, 1) <> " " AND MID$(a$, k%-1, 1) <> "," THEN ign% = 1: GOTO rces IF LEN(a$) < (k% + lv%) THEN GOTO rces c$ = MID$(a$, k%+lv%, 1) IF c$ <> ":" AND c$ <> " " THEN ign% = 1: GOTO rces rces: a$ = sva$ RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recobj: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN ' ***** OBJETS DÉCLARÉS ******************************************* CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES OBJETS ******" ITEM_ADD fls%, "" ITEM_ADD fls%, " un moment svp..." nobj% = 0 FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit3 a$ = UPPER$(a$) k% = INSTR(a$, "DATA ") IF k% > 0 THEN GOSUB Supelem: IF ign% = 1 THEN GOTO Suit3 k% = INSTR(a$, "DIM ") IF k% > 0 THEN GOSUB Supelem: IF ign% = 1 THEN GOTO Suit3 k% = INSTR(a$, "LABEL ") IF k% > 0 THEN GOSUB Supelem: IF ign% = 1 THEN GOTO Suit3 FOR i% = 1 TO tob% v$ = objn$(i%): lv% = LEN(v$) u% = 1 re: b$ = v$: GOSUB Instrs: k% = k1% IF k% > 0 IF k% > 1 n% = ASC(MID$(a$, k%-1, 1)) IF n%>32 THEN GOTO rg END_IF u% = k%: b$ = ":": GOSUB Instrs IF k1% > 0 c$ = MID$(a$, k%+lv%, k1%-k%-lv%) ELSE k% = k% + lv%: GOSUB Mids: c$ = b$ END_IF c$ = TRIM$(c$) nobj% = nobj% + 1: obj$(nobj%) = v$ + c$ + " ["+STR$(nl%)+"]" rg: IF k1% > 0 THEN u% = k1%+1: GOTO re END_IF NEXT i% Suit3: NEXT nl% ' Tri du résultat DLIST 89: FOR i% = 1 TO nobj%: ITEM_ADD 89, obj$(i%): NEXT i% SORT 89: FOR i% = 1 TO nobj%: obj$(i%) = ITEM_READ$(89, i%): NEXT i% DELETE 89 HIDE flf% CLEAR fls% ITEM_ADD fls%, " ****** LISTE DES OBJETS ("+STR$(nobj%)+") ******" ITEM_ADD fls%, "" FOR i% = 1 TO nobj%: ITEM_ADD fls%, obj$(i%): NEXT i% SHOW flf% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recif: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES IF...ELSE...END_IF ******" ITEM_ADD fls%, "": WAIT 10 indt% = 0: ' indentation FOR nl% = 1 TO COUNT(fpr%) CAPTION flf%, STR$(nl%)+" / "+STR$(COUNT(fpr%)) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ IF afl% = 1 k% = INSTR(a$, ":"): a$ = MID$(a$, k%+1, LEN(a$)-k%) END_IF IF LEN(a$) < 4 THEN GOTO Suit6 a$ = UPPER$(TRIM$(a$)): IF a$ = "" THEN GOTO Suit6 k% = INSTR(a$, ":") IF k% > 0 k1% = 0 FOR i% = 1 TO k%-1 IF MID$(a$, i%, 1) = " " THEN k1% = 1: EXIT_FOR NEXT i% IF k1% = 0 AND k% = LEN(a$) ITEM_ADD fls%, RTRIM$(sva$)+" *****" indt% = 0: GOTO Suit6: ' étiquette END_IF END_IF IF LEFT$(a$, 6) = "RETURN" OR LEFT$(a$, 9) = "TERMINATE" ITEM_ADD fls%, RTRIM$(sva$)+" "+STRING$(nc%-12, "-") indt% = 0: GOTO Suit6 END_IF GOSUB Supquot: ' suppression des expressions entre quotes k% = INSTR(a$, CHR$(39)): IF k% = 1 THEN GOTO Suit6 IF k% > 0 THEN a$ = LEFT$(a$, k%-1): IF TRIM$(a$) = "" THEN GOTO Suit6 k% = INSTR(a$, "REM"): IF k% = 1 THEN GOTO Suit6 IF k% > 0 THEN a$ = LEFT$(a$, k%-1): IF TRIM$(a$) = "" THEN GOTO Suit6 k% = INSTR(a$, "IF ") IF k%>0 IF k% = 1 GOSUB Ecsva k% = INSTR(a$, "THEN "): IF k% < 1 THEN indt% = indt% + 4 GOTO Suit6 END_IF IF k% > 1 THEN c$ = MID$(a$, k%-1, 1) IF c$=" " OR c$<>":" THEN GOSUB Ecsva: GOTO Suit6 END_IF k% = INSTR(a$, "ELSE") IF k% = 1 THEN indt%=indt%-4: GOSUB Ecsva: indt% = indt% + 4: GOTO Suit6 k% = INSTR(a$, "END_IF") IF k% = 1 THEN indt% = indt%-4: GOSUB Ecsva Suit6: NEXT nl% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Ecsva: c$ = "": IF indt% > 0 THEN c$ = STRING$(indt%, " ") IF afl% = 1 k% = INSTR(sva$, ":"): c$ = LEFT$(sva$, k%+1)+c$: sva$ = MID$(sva$, k%+2, LEN(sva$)) END_IF ITEM_ADD fls%, c$ + TRIM$(sva$) RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recwhile: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES WHILE...END_WHILE ******" ITEM_ADD fls%, "": WAIT 10 indt% = 0: ' indentation FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit7 a$ = TRIM$(UPPER$(a$)) k% = INSTR(a$, "WHILE "): k1% = INSTR(a$, "END_WHILE") IF k%>0 OR k1%>0 THEN ITEM_ADD fls%, sva$ Suit7: NEXT nl% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recrep: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES REPEAT...UNTIL ******" ITEM_ADD fls%, "": WAIT 10 indt% = 0: ' indentation FOR nl% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ GOSUB Misfo: IF ign% = 1 THEN GOTO Suit8 a$ = TRIM$(UPPER$(a$)) k% = INSTR(a$, "REPEAT"): k1% = INSTR(a$, "UNTIL ") IF k%>0 OR k1%>0 THEN ITEM_ADD fls%, sva$ Suit8: NEXT nl% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Supelem: ' suppression d'un élément ign% = 0 u% = k%+1: b$ = ":": GOSUB Instrs IF k1% = 0 a$ = LEFT$(a$, k%-1) ELSE a$ = LEFT$(a$, k%-1) + MID$(a$, k1%+1, LEN(a$)) END_IF IF a$ = "" THEN ign% = 1 RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recsou: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN CLEAR fls%: SHOW flf%: ITEM_ADD fls%, " ****** LISTE DES SOUS-PROGRAMMES ET LABELS ******" ITEM_ADD fls%, "" FOR nl% = 1 TO COUNT(fpr%) CAPTION flf%, STR$(nl%)+" / "+STR$(COUNT(fpr%)) a$ = ITEM_READ$(fpr%, nl%): sva$ = a$ IF afl% = 1 k% = INSTR(a$, ":"): a$ = MID$(a$, k%+1, LEN(a$)-k%) END_IF IF LEN(a$) < 4 THEN GOTO Suit9 a$ = UPPER$(TRIM$(a$)): IF a$ = "" THEN GOTO Suit9 k% = INSTR(a$, ":") IF k% > 0 IF LEN(RTRIM$(a$)) > k% THEN GOTO Suit9 k1% = 0 FOR i% = 1 TO k%-1 IF MID$(a$, i%, 1) = " " THEN k1% = 1: EXIT_FOR NEXT i% IF k1% = 0 ITEM_ADD fls%, RTRIM$(sva$) GOTO Suit9: ' étiquette END_IF END_IF IF LEFT$(a$, 6) = "RETURN" OR LEFT$(a$, 9) = "TERMINATE" ITEM_ADD fls%, RTRIM$(sva$) ITEM_ADD fls%, "----------------" GOTO Suit9 END_IF Suit9: NEXT nl% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Recseq: IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN s$ = MESSAGE_INPUT$("Recherche séquence","Séquence cherchée:","") IF s$ = "" THEN RETURN FOR i% = 1 TO COUNT(fpr%): ll%(i%) = LEN(ITEM_READ$(fpr%, i%))+2: NEXT i% FOR i% = 1 TO COUNT(fpr%) a$ = ITEM_READ$(fpr%, i%) k% = INSTR(UPPER$(a$), UPPER$(s$)) IF k% > 0 n% = 0 FOR j% = 1 TO i%-1: n% = n% + ll%(j%): NEXT j% ' SELECT_TEXT fpr%, n%+k%, LEN(s$) b$ = "- Séquence cherchée: " + chr$(34)+s$ + chr$(34)+" -"+chr$(10) b$ = b$ + "============================="+chr$(10)+a$ b$ = b$ + chr$(10)+ "=============================" b$ = b$ + chr$(10)+" - Suivant ? -" IF MESSAGE_CONFIRMATION_YES_NO(b$ ) <> 1 THEN RETURN END_IF NEXT i% RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Charsou: MESSAGE "Pas de programme source à analyser !" RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Debug: MESSAGE "Erreur ligne: " + str$(error_line)+" " + error_type$ TERMINATE RETURN ' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- Usage: - Lancer le programme (on s'en doutait...), un éditeur s'affiche. - Menu 'Fichier', 'Ouvrir' le fichier source à analyser - Menu 'Recherches', choisir le type de recherche: variables, labels, objets, structures, etc., et attendre le résultat, qui peut être un peu long (quelques secondes), en effet il y a analyse de toutes les lignes. Effectivement il y a des mises à jour à faire, il manque les derniers objets Panoramic, peut-être même les subs... mais c'est utilisable en l'état. - | |
|