Vous avez un ancien programme avec une série de numéro de lignes, vous voulez l'adapter en le rendant plus clair.
A l'ancien temps Crosoft avait fait un logiciel en basic permettant de supprimer les numéros de lignes inutiles.
Impossible de le retrouver chez Crosoft, mais dans mes archives, il existe.
Le voici :
DEFINT A-Z
'
' Microsoft SupLigne - Utilitaire de suppression des numéros de ligne
' Copyright (C) Microsoft Corporation - 1985, 1986, 1987, 1988, 1989
'
' SUPLIGNE.BAS est un programme qui supprime les numéros de ligne des
' programmes écrits en BASIC Microsoft. Il ne supprime que les numéros de
' ligne ne qui font pas l'objet de l'une des instructions suivantes :
' GOSUB, RETURN, GOTO, THEN, ELSE, RESUME, RESTORE, ou RUN.
DECLARE FUNCTION CherchElement$ (Recherche$, Separ$)
DECLARE FUNCTION ExplChaine% (ChaineEntree$, Separateur$)
DECLARE FUNCTION RuptChaine% (ChaineEntree$, Separateur$)
DECLARE FUNCTION EstChiffre% (Car$)
DECLARE SUB CherchNomsFich ()
DECLARE SUB BatiTable ()
DECLARE SUB CreeFichSortie ()
DECLARE SUB InitTableTouches ()
CONST VRAI = -1
CONST FAUX = 0
CONST MaxLignes = 400
DIM SHARED TableLignes!(MaxLignes)
DIM SHARED CompteLignes
DIM SHARED Seps$, FichEntree$, FichSortie$, FichTemp$
CONST CompteMotsCles = 8
DIM SHARED TableMotsCles$(CompteMotsCles)
DonneesTouches:
DATA THEN,ELSE,GOSUB,GOTO,RESUME,RETURN,RESTORE,RUN
Seps$ = " ,:" + CHR$(9)
InitTableTouches
CherchNomsFich
ON ERROR GOTO ErrFich1
OPEN FichEntree$ FOR INPUT AS 1
ON ERROR GOTO 0
COLOR 7: PRINT "Traitement en cours";: COLOR 23: PRINT " . . .": COLOR 7: PRINT
BatiTable
CLOSE #1
OPEN FichEntree$ FOR INPUT AS 1
ON ERROR GOTO ErrFich2
OPEN FichSortie$ FOR OUTPUT AS 2
ON ERROR GOTO 0
CreeFichSortie
CLOSE #1, #2
IF FichSortie$ <> "CON" THEN CLS
END
ErrFich1:
CLS
PRINT " Nom de fichier incorrect": PRINT
INPUT " Entrez un nouveau nom de fichier (puis appuyez sur ENTREE): ", FichEntree$
IF FichEntree$ = "" THEN END
ErrFich2:
INPUT " Nom du fichier de sortie (appuyez sur ENTREE pour l'afficher à l'écran) :", FichSortie$
PRINT
IF (FichSortie$ = "") THEN FichSortie$ = "CON"
IF FichTemp$ = "" THEN
RESUME
ELSE
FichTemp$ = ""
RESUME NEXT
END IF
SUB BatiTable STATIC
DO WHILE NOT EOF(1)
LINE INPUT #1, LigneEntree$
element$ = CherchElement$(LigneEntree$, Seps$)
DO WHILE (element$ <> "")
FOR IndexCles = 1 TO CompteMotsCles
IF (TableMotsCles$(IndexCles) = UCASE$(element$)) THEN
element$ = CherchElement$("", Seps$)
DO WHILE (EstChiffre(LEFT$(element$, 1)))
CompteLignes = CompteLignes + 1
TableLignes!(CompteLignes) = VAL(element$)
element$ = CherchElement$("", Seps$)
IF element$ <> "" THEN IndexCles = 0
LOOP
END IF
NEXT IndexCles
element$ = CherchElement$("", Seps$)
LOOP
LOOP
END SUB
FUNCTION CherchElement$ (Recherche$, Separ$) STATIC
IF (Recherche$ <> "") THEN
PosDebut = 1
ChaineSauv$ = Recherche$
END IF
NouvPos = ExplChaine(MID$(ChaineSauv$, PosDebut, LEN(ChaineSauv$)), Separ$)
IF NouvPos THEN
PosDebut = NouvPos + PosDebut - 1
ELSE
CherchElement$ = ""
EXIT FUNCTION
END IF
NouvPos = RuptChaine(MID$(ChaineSauv$, PosDebut, LEN(ChaineSauv$)), Separ$)
IF NouvPos THEN
NouvPos = PosDebut + NouvPos - 1
ELSE
NouvPos = LEN(ChaineSauv$) + 1
END IF
CherchElement$ = MID$(ChaineSauv$, PosDebut, NouvPos - PosDebut)
PosDebut = NouvPos
END FUNCTION
SUB CherchNomsFich STATIC
IF (COMMAND$ = "") THEN
CLS
PRINT " Microsoft SupLigne : utilitaire de suppression des numéros de ligne"
PRINT " (l'extension .BAS est affectée par défaut si aucune extension n'est spécifiée), le fichier à modifier est un fichier.bas "
PRINT
INPUT " Nom du fichier d'entrée (ENTREE pour terminer) : ", FichEntree$
IF FichEntree$ = "" THEN END
INPUT " Nom du fichier de sortie (ENTREE pour l'afficher) : ", FichSortie$
PRINT
IF (FichSortie$ = "") THEN FichSortie$ = "CON"
ELSE
FichEntree$ = UCASE$(CherchElement$(COMMAND$, Seps$))
FichSortie$ = UCASE$(CherchElement$("", Seps$))
IF (FichSortie$ = "") THEN
INPUT " Nom du fichier de sortie (ENTREE pour l'afficher) : ", FichSortie$
PRINT
IF (FichSortie$ = "") THEN FichSortie$ = "CON"
END IF
END IF
IF INSTR(FichEntree$, ".") = 0 THEN
FichEntree$ = FichEntree$ + ".BAS"
END IF
IF INSTR(FichSortie$, ".") = 0 THEN
SELECT CASE FichSortie$
CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3"
EXIT SUB
CASE ELSE
FichSortie$ = FichSortie$ + ".BAS"
END SELECT
END IF
DO WHILE FichEntree$ = FichSortie$
FichTemp$ = LEFT$(FichEntree$, INSTR(FichEntree$, ".")) + "BAK"
ON ERROR GOTO ErrFich1
NAME FichEntree$ AS FichTemp$
ON ERROR GOTO 0
IF FichTemp$ <> "" THEN FichEntree$ = FichTemp$
LOOP
END SUB
SUB CreeFichSortie STATIC
Sep$ = " " + CHR$(9)
DO WHILE NOT EOF(1)
LINE INPUT #1, LigneEntree$
IF (LigneEntree$ <> "") THEN
element$ = CherchElement$(LigneEntree$, Sep$)
IF EstChiffre(LEFT$(element$, 1)) THEN
NumeroLigne! = VAL(element$)
NumeroTrouve = FAUX
FOR index = 1 TO CompteLignes
IF (NumeroLigne! = TableLignes!(index)) THEN
NumeroTrouve = VRAI
END IF
NEXT index
IF (NOT NumeroTrouve) THEN
element$ = SPACE$(LEN(element$))
MID$(LigneEntree$, ExplChaine(LigneEntree$, Sep$), LEN(element$)) = element$
END IF
END IF
END IF
IF FichSortie$ = "CON" THEN
PRINT LigneEntree$
ELSE
PRINT #2, LigneEntree$
END IF
LOOP
END SUB
FUNCTION EstChiffre (Car$) STATIC
IF (Car$ = "") THEN
EstChiffre = FAUX
ELSE
CarAsc = ASC(Car$)
EstChiffre = (CarAsc >= ASC("0")) AND (CarAsc <= ASC("9"))
END IF
END FUNCTION
FUNCTION ExplChaine% (ChaineEntree$, Separateur$) STATIC
Ln = LEN(ChaineEntree$)
PosDebut = 1
DO WHILE INSTR(Separateur$, MID$(ChaineEntree$, PosDebut, 1))
IF PosDebut > Ln THEN
ExplChaine = 0
EXIT FUNCTION
ELSE
PosDebut = PosDebut + 1
END IF
LOOP
ExplChaine = PosDebut
END FUNCTION
SUB InitTableTouches STATIC
RESTORE DonneesTouches
FOR Comptage = 1 TO CompteMotsCles
READ MotCle$
TableMotsCles$(Comptage) = MotCle$
NEXT
END SUB
FUNCTION RuptChaine (ChaineEntree$, Separateur$) STATIC
Ln = LEN(ChaineEntree$)
PosDebut = 1
DO WHILE INSTR(Separateur$, MID$(ChaineEntree$, PosDebut, 1)) = 0
IF PosDebut > Ln THEN
RuptChaine = 0
EXIT FUNCTION
ELSE
PosDebut = PosDebut + 1
END IF
LOOP
RuptChaine = PosDebut
END FUNCTION
Testez-le
En principe pas de soucis mais au cas ou téléchargez - le avec ce lien
https://app.box.com/s/looeqmslkkilnn1rka8z1wjop8gg4bm1
