Forum Liberty Basic France

Projets open source » Recenser--Remplacer des handles et des chaînes
Le 23/07/2017 à 10h03

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 1915
Un truc pour recenser les handles et les chaînes et pour remplacer.
mais pour remplacer, le suivant est mieux (permet le copier-coller pour la saisie.
Le recensement:
Code VB :
 
nomainwin
   on error goto [huh]
   dim info$(10,10)
   dim hand$(1000)
   dim chain$(1000)
   dim label$(800)  'increase if needed '**************************
   dim temp$(1000)
  [start]
    filedialog "Open Source File", "C:\JUST BASIC\*.bas", fileName$
    if fileName$="" then
       confirm "No file chosen!"+chr$(13)+"Re-open file dialog?";yn$
       if yn$="yes" then
          goto [start]
       else
          goto [quit.test]
       end if
    end if
 
  WindowWidth=600
  WindowHeight=570
    UpperLeftX=INT((DisplayWidth-WindowWidth)/1)
    UpperLeftY=10'INT((DisplayHeight-WindowHeight)/6)
   BUTTON #w.edi, "JB's editor", [JBeditor], UL, 10, 0 , 70, 20
   STATICTEXT #w.ab, "Handles:", 90, 3, 45, 20
   TEXTBOX #w.a, 140, 0,80, 20
   STATICTEXT #w.ac, "<-- Analyse -- Item", 225, 3, 90, 20
   STATICTEXT #w.ab, "Font:", 10, 28 , 30, 20
   BUTTON #w.zoo, "", [zoo], UL, 40, 25 , 40, 20
   STATICTEXT #w.bb, "Chaînes:", 90, 28, 45, 20
   TEXTBOX #w.b, 140, 25,80, 20
   STATICTEXT #w.bb, "<-- Analyse -- Item", 225, 28, 90, 20
   listbox #w.ha, hand$(), [matchhand], 5, 50, 80, 570
   listbox #w.ch, chain$(), [matchain], 90, 50, 80, 570
   listbox #w.lb, label$(), [match], 175, 50, 120, 570
   texteditor #w.te, 300, 50, 285, 570
   STATICTEXT #w.ca, "REMPLACE tous Les:", 325, 3, 105, 20
   TEXTBOX #w.c, 435, 0,80, 20
   STATICTEXT #w.da, "Par:", 400, 28, 20, 20
   TEXTBOX #w.d, 435, 25,80, 20
   BUTTON #w.goch, "<-Go", [goch], UL, 520, 25 , 35, 20
 
   menu #w, "File", "Open", [nouv]
  open "Label Extractor  -  ";fileName$ for window as #w
    #w "trapclose [quit]"
    #w.te, "!autoresize"
    #w.lb "font Courier_New 9"
    #w.a, "Patience...":#w.b, "ça va venir."
    zoo=2:fonte=9
    #w.zoo, word$("8 9 10",zoo)
    path$ = GetPath$(fileName$)
    name$ = GetName$(fileName$)
    tknfile$ = left$(name$,len(name$)-3)+"tkn"
  [cont]
    #w.zoo, word$("8 9 10",zoo)
    open fileName$ for input as #me
    label$(1) = "- TOP -"
    n=2
    while eof(#me)=0
       line input #me, ln$
       if len(ln$) = 0 then
          blank = blank + 1
       else
          text = text + 1
       end if
       if left$(trim$(ln$), 1)="[" then gosub [getlabel]:n=n+1
       if lower$(word$(trim$(ln$), 1))="sub" then gosub [getsub]:n=n+1
       if lower$(word$(trim$(ln$), 1))="function" then gosub [getfunction]:n=n+1
       #w.te ln$
    wend
    label$(n) = "- BOTTOM -"
    close #me
    #w.lb, "reload"
    '---------------------------------- HANDLES---------------------
    #w.te, "!contents? code$" ' le texteditor dans une chaîne--> code$
    xx=1:nn=1
    for x=1 to len(code$)
       xx=0
       if mid$(code$,x,1)="#" then
          xx=x 'trouve "#" et mémorise l'endroit
          a$=""
          for y=xx to xx+10
             a$= mid$(code$,y,1)
             if a$="," or a$=" " or a$=")" or a$=chr$(34) then yy=y:exit for
          next y
          b$=""
          for u=xx to yy-1 'reconstruit handle
             b$=b$+mid$(code$,u,1)
          next u
          temp$(nn)=b$ 
          nn=nn+1
       end if
    next x
    for x=1 to nn
       q$=q$+temp$(x)+" " 'fixe
       w$=w$+temp$(x)+" " 'variable
    next x
     '-----------------dédoublonnage handles
       for x=1 to len(w$) 'detect fin
          if word$(w$,x)="" then n=x-1: exit for
       next x
    for h=1 to n 'boucle de supervision
       for x=1 to len(w$) 'detect fin
          if word$(w$,x)="" then nn=x-1: exit for
       next x
       for x=1 to nn
          mot$=word$(w$,x)
          for y=x+1 to nn
             if word$(w$,y)=mot$ then yy=y:exit for
          next y
          yy=y 'N° mot
          after$=""
          for u=yy+1 to nn
             after$=after$+word$(w$,u)+" "
          next u
          avant$=""
          for av=1 to yy-1
             avant$=avant$+word$(w$,av)+" "
          next av
          w$=avant$+after$
       next x
       #w.a, str$(h-1);" - ";str$(x-1)
   next h  '-------FIN dédoublonnage handles
    for x=1 to len(w$)
       if word$(w$,x)="" then fin=x-1: exit for
    next x
    for x=1 to fin
       hand$(x)=word$(w$,x)
    next x
    #w.ha, "reload"
  '---------------------------------- FIN HANDLES -----------------
    #w.te, "!contents? code$" ' le texteditor dans une chaîne--> code$
    redim temp$(1000):w$=""
       xx=1:nn=1
    for x=xx+1 to len(code$)
       if mid$(code$,x,1)="$" then
          xx=x 'trouve "$" et mémorise l'endroit
          for y=xx to xx-15 step-1 '----cherche debut
             a$= mid$(code$,y,1)
             if a$=chr$(10) then yy=y:exit for
             if a$=chr$(34) then yy=y:exit for
             if a$="?" then yy=y:exit for
             if a$="  " then yy=y:exit for
             if a$=" " then yy=y:exit for
             if a$="" then yy=y:exit for
             if a$="," then yy=y:exit for
             if a$=":" then yy=y:exit for
             if a$=";" then yy=y:exit for
             if a$="(" then yy=y:exit for
             if a$=")" then yy=y:exit for
             if a$="+" then yy=y:exit for
             if a$="-" then yy=y:exit for
             if a$="=" then yy=y:exit for
             if a$="<" then yy=y:exit for
             if a$=">" then yy=y:exit for
          next y
          b$=""
          for z=yy+1 to xx  '-------reconstruit nom chaîne
             b$=b$+ mid$(code$,z,1)
          next z
          temp$(nn)=b$ ' tableau temporaire
          nn=nn+1
       end if
            #w.b, "0"
    next x
    for x=1 to nn  '-----------------dédoublonnage chaînes
       q$=q$+temp$(x)+" " 'fixe
       w$=w$+temp$(x)+" " 'variable
    next x
       for x=1 to len(w$) 'detect fin
          if word$(w$,x)="" then n=x-1: exit for
       next x
    for h=1 to n 'boucle de supervision
       for x=1 to len(w$) 'detect fin
          if word$(w$,x)="" then nn=x-1: exit for
       next x
       for x=1 to nn
          mot$=word$(w$,x)
          for y=x+1 to nn
             if word$(w$,y)=mot$ then yy=y:exit for
          next y
          yy=y 'N° mot
          after$=""
          for u=yy+1 to nn
             after$=after$+word$(w$,u)+" "
          next u
          avant$=""
          for av=1 to yy-1
             avant$=avant$+word$(w$,av)+" "
          next av
          w$=avant$+after$
       next x
       #w.b, str$(h-1);" - ";str$(x-1)
   next h  '-------FIN dédoublonnage chaînes
    for x=1 to len(w$)
       if word$(w$,x)="" then fin=x-1: exit for
    next x
    for x=1 to fin
       chain$(x)=word$(w$,x)
    next x
    #w.ch, "reload" ' chain$()
      wait  '------------------------------ FIN DES CHAINES ---------------------
  [getlabel]
    l$=word$(ln$, 1)
    label$(n)=l$
  return
  [getsub]
    l$=ln$
    label$(n)=l$
  return
  [getfunction]
    l$=ln$
    label$(n)=l$
  return
  [match]
    #w.lb "selection? label$"
    open fileName$ for input as #me
    i=0
    while eof(#me)=0
       i=i+1
       line input #me, ln$
       select case label$
         case word$(ln$, 1),ln$
         #w.te "!origin 1 ";i - 4
         exit while
         case "- TOP -"
         #w.te "!origin 1 ";1
         exit while
         case "- BOTTOM -"
         #w.te "!origin 1 ";text + blank - 34
         exit while
       end select
    wend
     close #me
  wait
  [nouv]
    close #w
    blank = 0
    text = 0
    redim label$(500)
    goto [start]
  wait
  [JBeditor]
    run "C:\Conteneur J\Just BASIC v1.01\jbasic.exe ";fileName$ '
  wait
  [execute]
    run "C:\Conteneur J\Just BASIC v1.01\jbrun101.exe ";left$(fileName$,len(fileName$)-3);"tkn"
  wait
  [goch]
    #w.c, "!contents? orig$":lonor=len(orig$)
    #w.d, "!contents? rempl$" ' :lonREP=len(rempl$)
    #w.te, "!contents? a$": lon=len(a$)
 
   i = 1: b$ = ""
   do
     if mid$(a$,i,lonor)=orig$ then
        b$ = b$ + rempl$
        i = i + lonor
     else
        b$ = b$ +mid$(a$,i,1)
        i=i+1
     end if
  if i>=lon then sortir=1
  loop until sortir
  #w.te, "!contents b$"
    notice "Le changement a été fait dans le texteditor, il faudra collé son contenu"+chr$(10)+_
     "dans l'éditeur qui va s'ouvrir au clic sur 'ok'."+chr$(10)+_
     "Après avoir fait: New (En haut à gauche) Pour le vider."+chr$(10)+_
     " Le fichier sera sauvegardé dans son dossier d'origine"
    #w.c, "!contents? orig$":lonor=len(orig$)
    #w.d, "!contents? rempl$" ' :lonREP=len(rempl$)
    #w.te, "!contents? a$": lon=len(a$)
    goto [JBeditor]
  wait
  [zoo]
    zoo=zoo+1
    if zoo =4 then zoo=1
    #w.zoo, word$("8 9 10",zoo)
    if zoo =1 then fonte=8
    if zoo =2 then fonte=9
    if zoo =3 then fonte=10
       #w.te, "!contents? ctemp$"
       #w.te,"!cls"
       #w.te, "!font Comic sans MS ";" ";fonte: #w.te, "!contents ctemp$"
  wait
   '----------------------------- FONCTIONS ----------------------
  FUNCTION fileExists(path$, filename$)
    files path$, filename$, info$(  ' path$ = 'DefaultDir$' generally.
    fileExists = val(info$(0, 0))  'not zero if true
  END FUNCTION
  FUNCTION GetPath$(input$)
    bsPos = len(input$)
    while mid$(input$, bsPos, 1) <> "\" and bsPos > 0
        bsPos = bsPos - 1
    wend
    if bsPos <> 0 then
        GetPath$ = left$(input$,bsPos)
    else
        GetPath$ = ""
    end if
  END FUNCTION
  FUNCTION GetName$(input$)
    bsPos = len(input$)
    while mid$(input$, bsPos, 1) <> "\" and bsPos > 0
        bsPos = bsPos - 1
    wend
    if bsPos <> 0 then
        GetName$ = right$(input$,len(input$)-bsPos)
    else
        GetName$ = ""
    end if
  END FUNCTION
   ' fonctions optimisées
   'return just the directory path from a full file path
  FUNCTION GetPath22$(fullPath$)
    GetPath$ = fullPath$
    while right$(GetPath$, 1) <> "\" and GetPath$ <> ""
        GetPath$ = left$(GetPath$, len(GetPath$)-1)
    wend
  END FUNCTION
   'return just the filename from a full file path
  FUNCTION GetName22$(fullPath$)
    pathLength = len(GetPath$(fullPath$))
    GetName$ = right$(fullPath$, len(fullPath$)-pathLength)
  END FUNCTION
 
  [quit]
    close #w
  end
 
  [quit.test]
  end
 
  [huh]
    if Err = 9 then
       notice "Il faut augmenter La taille des tableaux en début de code"
       close #me
       goto [quit]
  end if
 
 


Et le Remplacement:
Code VB :
 
 ' ATTENTION au: run "D:\Conteneur J\Just ....(nom du disque

nomainwin
   on error goto [huh]
   dim info$(10,10)
   dim label$(800)  'increase if needed '**************************
  [start]
    filedialog "Open Source File", "C:\JUST BASIC\*.bas", fileName$
    if fileName$="" then
       confirm "No file chosen!"+chr$(13)+"Re-open file dialog?";yn$
       if yn$="yes" then
          goto [start]
       else
          goto [quit.test]
       end if
    end if
 
  WindowWidth=800
  WindowHeight=575
    UpperLeftX=200 'INT((DisplayWidth-WindowWidth)/1)
    UpperLeftY=5 'INT((DisplayHeight-WindowHeight)/6)
   BUTTON #w.zoo, "", [zoo], UL, 40, 25 , 40, 20
   BUTTON #w.edi, "JB's editor", [JBeditor], UL, 10, 0 , 70, 20
   STATICTEXT #w.ab, "Font:", 10, 28 , 30, 20
   listbox #w.lb, label$(), [match], 5, 50, 330, 570
   texteditor #w.te, 340, 50, 440, 470
   STATICTEXT #w.rempa, "REMPLACE", 100, 3, 80, 20 '325
   STATICTEXT #w.rempb, "tous Les:", 100, 20, 100, 20
   STATICTEXT #w.nouva, "Par:", 330, 3, 40, 20
   BUTTON #w.goch, "Go", [goch], UL, 490, 5 , 45, 25
   BUTTON #w.new, "New", [new], UL, 550, 0 , 40, 20
   'BUTTON #w.pan, "Stop", [stop], UL, 530, 25 , 40, 20
  ' TEXTBOX #w.remp, 200, 0, 100, 25

   TEXTBOX #w.remp, 200, 0, 120, 25
   TEXTBOX #w.nouv, 380, 0, 100, 25
  open "Label Extractor  -  ";fileName$ for window as #w
    #w "trapclose [quit]"
    #w.te, "!autoresize"
    #w.lb "font Courier_New 9"
    #w.rempa, "!font Courier_New 11 bold": #w.rempb, "!font Courier_New 11 bold"
    #w.nouva, "!font Courier_New 11 bold"
    zoo=2:fonte=9
    #w.zoo, word$("8 9 10",zoo)
    path$ = GetPath$(fileName$)
    name$ = GetName$(fileName$)
    tknfile$ = left$(name$,len(name$)-3)+"tkn"
  [cont]
    #w.zoo, word$("8 9 10",zoo)
    open fileName$ for input as #me
    label$(1) = "- TOP -"
    n=2
    while eof(#me)=0
       line input #me, ln$
       if len(ln$) = 0 then
          blank = blank + 1
       else
          text = text + 1
       end if
       if left$(trim$(ln$), 1)="[" then gosub [getlabel]:n=n+1
       if lower$(word$(trim$(ln$), 1))="sub" then gosub [getsub]:n=n+1
       if lower$(word$(trim$(ln$), 1))="function" then gosub [getfunction]:n=n+1
       #w.te ln$
    wend
    label$(n) = "- BOTTOM -"
    close #me
    #w.lb, "reload"
      wait
  [getlabel]
    l$=word$(ln$, 1)
    label$(n)=l$
  return
  [getsub]
    l$=ln$
    label$(n)=l$
  return
  [getfunction]
    l$=ln$
    label$(n)=l$
  return
  [match]
    #w.lb "selection? label$"
    open fileName$ for input as #me
    i=0
    while eof(#me)=0
       i=i+1
       line input #me, ln$
       select case label$
         case word$(ln$, 1),ln$
         #w.te "!origin 1 ";i - 4
         exit while
         case "- TOP -"
         #w.te "!origin 1 ";1
         exit while
         case "- BOTTOM -"
         #w.te "!origin 1 ";text + blank - 34
         exit while
       end select
    wend
     close #me
  wait
  '[new]
    close #w
    blank = 0
    text = 0
    redim label$(500)
    goto [start]
  wait
  [JBeditor]
    run "D:\Conteneur J\Just BASIC v1.01\jbasic.exe "'
  wait
  [execute]
    run "D:\Conteneur J\Just BASIC v1.01\jbrun101.exe ";left$(fileName$,len(fileName$)-3);"tkn"
  wait
  [new]
  [goch]
    #w.remp, "!contents? orig$":lonor=len(orig$)
    if orig$="" then wait
    #w.nouv, "!contents? rempl$"  :lonREP=len(rempl$)
    #w.te, "!contents? a$": lon=len(a$) '§§§§§§§----- C'EST LA ! ---------§§§§§§§§
    i = 1: b$ = ""
    do
      if mid$(a$,i,lonor)=orig$ then
         b$ = b$ + rempl$
         i = i + lonor
      else
         b$ = b$ +mid$(a$,i,1)
         i=i+1
      end if
   if i>=lon then sortir=1
   loop until sortir
   #w.te, "!cls"
   #w.te, "!contents b$" '---§§§§§§§§§§§§§---- ET LA ----§§§§§§§§
    c$ = "Le changement a été fait en local," + chr$(13)
    c$ = c$ + "Copier le code modifié" + chr$(13)
    c$ = c$ + "Le coller dans un éditeur" + chr$(13)
   NOTICE,c$
  wait
  [zoo]
    zoo=zoo+1
    if zoo =4 then zoo=1
    #w.zoo, word$("8 9 10",zoo)
    if zoo =1 then fonte=8
    if zoo =2 then fonte=9
    if zoo =3 then fonte=10
       #w.te, "!contents? ctemp$"
       #w.te,"!cls"
       #w.te, "!font Comic sans MS ";" ";fonte: #w.te, "!contents ctemp$"
  wait
 ' [stop]
  '  sortir=1
 ' wait
  [nouv]
  wait
   '----------------------------- FONCTIONS ----------------------
  FUNCTION fileExists(path$, filename$)
    files path$, filename$, info$(  ' path$ = 'DefaultDir$' generally.
    fileExists = val(info$(0, 0))  'not zero if true
  END FUNCTION
  FUNCTION GetPath$(input$)
    bsPos = len(input$)
    while mid$(input$, bsPos, 1) <> "\" and bsPos > 0
        bsPos = bsPos - 1
    wend
    if bsPos <> 0 then
        GetPath$ = left$(input$,bsPos)
    else
        GetPath$ = ""
    end if
  END FUNCTION
  FUNCTION GetName$(input$)
    bsPos = len(input$)
    while mid$(input$, bsPos, 1) <> "\" and bsPos > 0
        bsPos = bsPos - 1
    wend
    if bsPos <> 0 then
        GetName$ = right$(input$,len(input$)-bsPos)
    else
        GetName$ = ""
    end if
  END FUNCTION
   ' fonctions optimisées
   'return just the directory path from a full file path
  FUNCTION GetPath22$(fullPath$)
    GetPath$ = fullPath$
    while right$(GetPath$, 1) <> "\" and GetPath$ <> ""
        GetPath$ = left$(GetPath$, len(GetPath$)-1)
    wend
  END FUNCTION
   'return just the filename from a full file path
  FUNCTION GetName22$(fullPath$)
    pathLength = len(GetPath$(fullPath$))
    GetName$ = right$(fullPath$, len(fullPath$)-pathLength)
  END FUNCTION
  [quit]
    close #w
  end
  [quit.test]
  end
  [huh]
    if Err = 9 then
       notice "Il faut augmenter La taille des tableaux en début de code"
       close #me
       goto [quit]
  end if
 
 
 
 
____________________
Roro

   
Projets open source » Recenser--Remplacer des handles et des chaînes  

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie