Forum Liberty Basic France

Débutant » Appropriate close command ! La bête est rétive
Le 11/03/2013 à 18h04

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Cassiope ! Au secours !
J'ai repris le code de Mark Parkinson.
Celui qui quand tu le lance, il te sort tout le contenu du disque ! :|
Je l'ai mis en interface. ça marche bien, mais... :s
A la fin de l'auscultation: "Appropriate close command !" :( :@
Et le débuggeur ne m'est d'aucun secours.
D'après toi, qu'est-ce qui se passe ? :miam
Et merci d'avance d'aider le peuple en détresse. :)

Code VB :
 
 
' Mark Parkinson
' 08/10/02

' This program will list all the files in the whole directory structure
' which match the given file spec. A process called recursion is used.

' Feel free to use and adapt the program eg to sum the filespace used or
' delete files or rename files or move them.
' It is also easy to adapt the program to delete empty subdirectories.
    WindowWidth=240
    WindowHeight=375
    UpperLeftX=90'INT((DisplayWidth-WindowWidth)/2)
    UpperLeftY=100'INT((DisplayHeight-WindowHeight)/2)

    dim info$(10, 10)  'Ready for the files command.

    'STATICTEXT #w.ouv, "OUVERT", 420, 80, 60, 20
    BUTTON #w.go, "YES", [start], UL, 80, 40, 40, 20
    TEXTBOX #w.res, 10 , 135, 200, 25
    TEXTBOX #w.ex, 175 , 250, 40, 20
    BUTTON #w.ok, "Ok ?", [ok], UL, 110, 290, 40, 20
    BUTTON #w.go, "Go", [go], UL, 160, 290, 40, 20
    GRAPHICBOX #w.g, 5, 5, 220, 330
 
    open "Folder Analyser" FOR WINDOW AS #w
     print #w, "trapclose [quit]"  ' Le print est facultatif
     #w.g, "down"
     #w.g, "fill black"
      #w.go,"!disable":#w.ok,"!disable"
      #w.ex,"":exo$=""
      #w.g, "color yellow; backcolor black"
      #w.g, "font courier_new 14 bold"
      #w.g, "place 0 20":#w.g, "\ CHOISIR UN DOSSIER "
      #w.g, "font courier_new 12 bold"
      #w.g, "place 130 50":#w.g, "\ Puis: "
      #w.g, "place 0 70":#w.g, "\ Ouvrir un fichier "
      #w.g, "place 10 90":#w.g, "\ Dans le dossier "
      #w.g, "place 10 110":#w.g, "\   choisis. "
      #w.g, "flush"
  wait
 
  [start]
    filedialog "Open text file", "*.*", fileName$
    print "File chosen is ";fileName$
    #w.res,fileName$
    #w.g, "color green; backcolor black"
    #w.g, "place 10 170":#w.g, "\ Dans le textbox:"
    #w.g, "place 10 190":#w.g, "\Supprimer la partie "
    #w.g, "place 10 210":#w.g, "\droite Jusqu'au... "
    #w.g, "place 10 230":#w.g, "\Dossier à Analyser."
 
    #w.g, "color yellow; backcolor black"
    #w.g, "place 5 260":#w.g, "\Extension .???->"
 
    #w.g, "place 20 300":#w.g, "\PUIS:-->"
  #w.g, "flush"
    #w.ok,"!enable"
  wait
  [ok]
    #w.go,"!enable"
    #w.res, "!contents? var$"
    #w.ex, "!contents? exo$"
    if exo$="" then
       exo$="*.*"
    end if
  wait
  [go]
  '---------------------------------- CORPS DU PROG -------------------------------
'Note no backslash - added later on.
placetohunt$= var$ 'chemin
thingtohuntfor$= ".*"+ exo$ ' extension

print "now listing all files in ";placetohunt$;" which match ";thingtohuntfor$
print
 
call recurse placetohunt$, thingtohuntfor$
print
print "finished"
 
end
 
sub recurse pathspec$,mask$
    'Put in the backslash separator.
    pathspec$=pathspec$+"\"
    files pathspec$, mask$, info$(
 
    filecount=val(info$(0, 0))
    subdircount=val(info$(0, 1))
 
for i=1 to filecount
    filename$= pathspec$+info$(i, 0)
    filesize$= info$(i, 1)
    datestamp$=info$(i, 2)
    print filename$;"     ";filesize$
next i
 
'Arrays cannot be local to subs so the subdirs
'are all put in a string separated by *'s which
'can't occur in filenames.
list$=""
for i=1 to subdircount
    list$=list$+pathspec$+info$(f + i, 1)+"*"
next i
 
'The subdirs are now pulled out of the (local)
'string one at a time and the sub is called again.
'This process where a sub calls itself
'is called recursion.
while list$<>""
    p=instr(list$,"*")
    p$=left$(list$,p-1)
    call recurse p$,mask$ 
    list$=mid$(list$,p+1)
wend
end sub
 
  wait
  [quit]
    CLOSE #w
    END
 
 




Edité par Roland Le 15/03/2013 à 01h59
____________________
Roro

   
Le 15/03/2013 à 14h33

Administrateur

Groupe: Administrateur

Inscrit le: 24/09/2010
Messages: 238
Il manque un close #w, voilà la partie corrigée =)

Code VB :
 
'Note no backslash - added later on.
placetohunt$= var$ 'chemin
thingtohuntfor$= ".*"+ exo$ ' extension

print "now listing all files in ";placetohunt$;" which match ";thingtohuntfor$
print
 
call recurse placetohunt$, thingtohuntfor$
print
print "finished"
 
CLOSE #w
 
end
 
 
____________________

MSN Yahoo Web    
Le 15/03/2013 à 15h07

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Eh bé grand merci Nephtys. :top
Il fallait aller voir dans les entrailles du code de Mark.
Ce que je me suis bien gardé de faire.
____________________
Roro

   
Le 17/03/2013 à 09h35

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Ou bien enlève le dernier 'wait' de ton code et met le à la place du premier 'end'.
2 'end' dans un code n'est pas souvant utile !!!

Que voulais-tu faire exactement Roland ?
Car tel quel ça n'a pas l'air de fonctionner ou je n'ai pas compris son utilisation !?

Sinon j'aurai ça sous la main :
- ATTENTION il faut faire un DoubleClick sur la lettre du lecteur choisi etc...

Code VB :
' Mark Parkinson
' 08/10/02

' This program will list all the files in the whole directory structure
' which match the given file spec. A process called recursion is used.

' Feel free to use and adapt the program eg to sum the filespace used or
' delete files or rename files or move them.
' It is also easy to adapt the program to delete empty subdirectories.

' http://justbasic.wikispaces.com/Folder+Dialog
'Folderdialog by UncleBen

 
global nfiles
dim info$(1,1)  'Ready for the files command.
dim FolderDlg$(10)
 
placetohunt$ = JBFolderDialog$() '"C:\JUST BASIC"
thingtohuntfor$ = "*.bas"
if placetohunt$ = "" then placetohunt$ = "c:\"
mess$ = "now listing all files in  ";placetohunt$;chr$(13);" which match ";thingtohuntfor$
confirm mess$;answer$
If answer$ = "no" then end
 
print "All files in ";placetohunt$;" which match ";thingtohuntfor$
print
print "Search..."
call recurse placetohunt$, thingtohuntfor$
print
print "finished.  (";nfiles;" files)"
 
 
sub recurse pathspec$,mask$
    'Put in the backslash separator.
    if right$(pathspec$,1)<>"\" then pathspec$=pathspec$+"\"
    files pathspec$, mask$, info$(
 
    filecount=val(info$(0, 0))
    subdircount=val(info$(0, 1))
 
    for i=1 to filecount
        filename$= pathspec$+info$(i, 0)
        filesize$= info$(i, 1)
        datestamp$=info$(i, 2)
        print filename$,,,filesize$,,,datestamp$
        nfiles = nfiles + 1
    next i
 
'Arrays cannot be local to subs so the subdirs
'are all put in a string separated by *'s which
'can't occur in filenames.
    list$=""
    for i=1 to subdircount
        list$=list$+pathspec$+info$(f + i, 1)+"*"
    next i
'The subdirs are now pulled out of the (local)
'string one at a time and the sub is called again.
'This process where a sub calls itself
'is called recursion.
    while list$<>""
        p=instr(list$,"*")
        p$=left$(list$,p-1)
        call recurse p$,mask$ 
        list$=mid$(list$,p+1)
    wend
end sub
 
function JBFolderDialog$()
    level = 1
    path$ = ""
    folder$ = ""
    doubleClick = 0
    call ReadDrives
 
    WindowWidth = 272
    WindowHeight = 295
    UpperLeftX = Int((DisplayWidth - WindowWidth) / 4)
    UpperLeftY = Int((DisplayHeight - WindowHeight) / 4)
    button #folderdlg.default, "OK", [FolderOk], UL, 30, 216, 96, 25
    button #folderdlg, "Cancel", [FolderCancel], UL, 134, 216, 96, 25
    listbox #folderdlg.lb, FolderDlg$(, [SelectFolder], 22, 11, 216, 160
    textbox #folderdlg.tb, 22, 186, 216, 25
    open "Choose Folder" for dialog_modal as #folderdlg
    #folderdlg, "trapclose [FolderCancel]"
    #folderdlg.lb, "singleclickselect"
    wait
 
    [SelectFolder]
    #folderdlg.lb, "selection? a$"
    if a$ = "" then wait
    select case
    case a$ = "<-"
        level = level-1
        folder$ = word$(path$, level, "\")
        path$ = left$(path$, len(path$)-len(folder$)-1)
        folder$ = folder$; "\"
        doubleClick = 1
        if level = 1 then
            call ReadDrives
            #folderdlg.lb, "reload"
        else
            call ListFolders path$
        end if
        #folderdlg.lb, "select "; left$(folder$, len(folder$)-1)
 
    case doubleClick = 0
        doubleClick = 1
        folder$ = a$; "\"
 
    case doubleClick = 1
        doubleClick = 0
        if folder$ = a$+ "\" then
            level = level+1
            path$ = path$; folder$
            folder$ = ""
            call ListFolders path$
        else
            doubleClick = 1
            folder$ = a$; "\"
        end if
 
    end select
    #folderdlg.tb, path$; folder$
    wait
 
    [FolderOk]
    #folderdlg.tb, "!contents? JBFolderDialog$"
    close #folderdlg
    exit function
 
    [FolderCancel]
    close #folderdlg
    end
end function
 
sub ReadDrives
    while word$(Drives$, c+1) <> ""
        c = c+1
    wend
    redim FolderDlg$(c)
    for i = 1 to c
        FolderDlg$(i) = word$(Drives$, i)
    next i
end sub
 
sub ListFolders path$
    files path$, "*.*", info$(
    n = val(info$(0,0))
    q = val(info$(0,1))
    redim FolderDlg$(q+1)
    FolderDlg$(1) = "<-"
    for i = 1 to q
        FolderDlg$(i+1) = info$(n+i, 1)
    next i
    #folderdlg.lb, "reload"
end sub
 




Edité par cassiope01 Le 17/03/2013 à 09h57
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 17/03/2013 à 11h21

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Bonjour Cassiope,
ça marche très bien, il faut suivre les instructions qui s'affichent au fur et à mesure qu'on clique.
J'hésite pour l'extension, entre faire entrer le point ou non.
Je regarde comment tu vois la chose. ......à+.
PS: Au fait, je suis en train de bidouiller un code pour un gars qui fait de la recherche en musique.
Il s'agit d'analyser des séquences de notes et de tirer toutes les combinaisons d'accord.
C'est une gamme spéciale, à laquelle il manque deux notes.
Je reçois les infos au fur et à mesure, et je connais à mon tour, ce que tu a connus quand je te décrivais le cahier des charges de "Babylone".
Mais bon, il suffit d'être patient, on finit pas comprendre ce que veut le ""client"".
J'ai mis le code au topic de l'aide traduite dans "suggestion pour le wiki",
Sous le nom: Combi Mus.zip. (on ne comprend pas trop le but quand on a pas le nez dans le solfège...)
Si tu veux le voir...C'est la-bas....



Edité par Roland Le 17/03/2013 à 11h31
____________________
Roro

   
Le 17/03/2013 à 11h52

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Ah Ouais! Pas mal ! :top
je vais essayer d'y mettre le choix de l'extension.
Et un peu de couleurs.... Tu nous a fait du brut de décoffrage ! !
Mais si tu l'y mettais TOI , Tu aurais la reconnaissance du peuple !
PS: Je sais bien que tu t'en tamponne de la reconnaissance du peuple,
mais qui sait si ça ne compte pas pour l'au-delà.
Je vais de ce pas voir si il y a quelque chose à ce sujet sur le site du Vatican. ....à+.
____________________
Roro

   
Le 17/03/2013 à 12h00

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Oh punaise ! Tu a mis tout le bazar dans une fonction ! ! ! ! ! :| :| :|
Mais tu recule vraiment devant rien toi. :top
Et comment je vais faire moi ? :heink Pour y mettre le choix de l'extension :s
____________________
Roro

   
Le 17/03/2013 à 13h22

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
voilà.

Code VB :
' Mark Parkinson
' 08/10/02

' This program will list all the files in the whole directory structure
' which match the given file spec. A process called recursion is used.

' Feel free to use and adapt the program eg to sum the filespace used or
' delete files or rename files or move them.
' It is also easy to adapt the program to delete empty subdirectories.

' http://justbasic.wikispaces.com/Folder+Dialog
'Folderdialog by UncleBen

 
global nfiles, thingtohuntfor$
dim info$(1,1)  'Ready for the files command.
dim FolderDlg$(10)
 
placetohunt$ = JBFolderDialog$() '"C:\JUST BASIC"
'thingtohuntfor$ = "*.bas"
if placetohunt$ = "" then placetohunt$ = "c:\"
mess$ = "now listing all files in  ";placetohunt$;"..   which match ";thingtohuntfor$
confirm mess$;answer$
If answer$ = "no" then end
 
print "All files in ";placetohunt$;" which match ";thingtohuntfor$
print
print "Search..."
call recurse placetohunt$, thingtohuntfor$
print
print "finished.  (";nfiles;" files)"
 
 
sub recurse pathspec$,mask$
    'Put in the backslash separator.
    if right$(pathspec$,1)<>"\" then pathspec$=pathspec$+"\"
    files pathspec$, mask$, info$(
 
    filecount=val(info$(0, 0))
    subdircount=val(info$(0, 1))
 
    for i=1 to filecount
        filename$= pathspec$+info$(i, 0)
        filesize$= info$(i, 1)
        datestamp$=info$(i, 2)
        print filename$,,,filesize$,,,datestamp$
        nfiles = nfiles + 1
    next i
 
'Arrays cannot be local to subs so the subdirs
'are all put in a string separated by *'s which
'can't occur in filenames.
    list$=""
    for i=1 to subdircount
        list$=list$+pathspec$+info$(f + i, 1)+"*"
    next i
'The subdirs are now pulled out of the (local)
'string one at a time and the sub is called again.
'This process where a sub calls itself
'is called recursion.
    while list$<>""
        p=instr(list$,"*")
        p$=left$(list$,p-1)
        call recurse p$,mask$ 
        list$=mid$(list$,p+1)
    wend
end sub
 
function JBFolderDialog$()
    level = 1
    path$ = ""
    folder$ = ""
    doubleClick = 0
    call ReadDrives
 
    WindowWidth = 272
    WindowHeight = 295
    UpperLeftX = Int((DisplayWidth - WindowWidth) / 4)
    UpperLeftY = Int((DisplayHeight - WindowHeight) / 4)
    button #folderdlg.default, "OK", [FolderOk], UL, 30, 216, 96, 25
    button #folderdlg, "Cancel", [FolderCancel], UL, 134, 216, 96, 25
    listbox #folderdlg.lb, FolderDlg$(, [SelectFolder], 22, 11, 216, 160
    textbox #folderdlg.tb, 22, 186, 170,25
    textbox #folderdlg.ex, 210, 186, 40,25
    open "Choose Folder" for dialog_modal as #folderdlg
    #folderdlg, "trapclose [FolderCancel]"
    #folderdlg.lb, "singleclickselect"
    #folderdlg.ex, "!setfocus"
    wait
 
    [SelectFolder]
    #folderdlg.lb, "selection? a$"
    if a$ = "" then wait
    select case
    case a$ = "<-"
        level = level-1
        folder$ = word$(path$, level, "\")
        path$ = left$(path$, len(path$)-len(folder$)-1)
        folder$ = folder$; "\"
        doubleClick = 1
        if level = 1 then
            call ReadDrives
            #folderdlg.lb, "reload"
        else
            call ListFolders path$
        end if
        #folderdlg.lb, "select "; left$(folder$, len(folder$)-1)
 
    case doubleClick = 0
        doubleClick = 1
        folder$ = a$; "\"
 
    case doubleClick = 1
        doubleClick = 0
        if folder$ = a$+ "\" then
            level = level+1
            path$ = path$; folder$
            folder$ = ""
            call ListFolders path$
        else
            doubleClick = 1
            folder$ = a$; "\"
        end if
 
    end select
    #folderdlg.tb, path$; folder$
    wait
 
    [FolderOk]
    #folderdlg.tb, "!contents? JBFolderDialog$"
    #folderdlg.ex, "!contents? thingtohuntfor$"
    thingtohuntfor$ = "*.";right$(thingtohuntfor$,3)  ' seulement les 3 derniers caractères nécessaire sont utilisés...
    if thingtohuntfor$ = "" then thingtohuntfor$ = "*.bas"
 
    close #folderdlg
    exit function
 
    [FolderCancel]
    close #folderdlg
    end
end function
 
sub ReadDrives
    while word$(Drives$, c+1) <> ""
        c = c+1
    wend
    redim FolderDlg$(c)
    for i = 1 to c
        FolderDlg$(i) = word$(Drives$, i)
    next i
end sub
 
sub ListFolders path$
    files path$, "*.*", info$(
    n = val(info$(0,0))
    q = val(info$(0,1))
    redim FolderDlg$(q+1)
    FolderDlg$(1) = "<-"
    for i = 1 to q
        FolderDlg$(i+1) = info$(n+i, 1)
    next i
    #folderdlg.lb, "reload"
end sub
 
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 17/03/2013 à 14h49

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Y'a pas à dire...C'est beau le "savoir faire". :top :top
Ce code, je m'y étais déjà pas mal usé le neurône.
Mais là c'est reparti pour un mois.
Oui, je sais, c'est très simple....Quelques variables...Juste quelques variables....Et...
Une p....n de FONCTION DE DERRIERE LES FAGOTS.
En tous cas, je te remercie. Je vais colorier,
en essayant de pas tout prendre sur la tronche.

PS: J'ai fini par acquérir une "Arduino", et télécharger "ArduBlock".
Maintenant, il ne reste plus qu'à trouver ce que je pourrais bien automatiser.
Je n'ai pas trouvée l'interface qui va bien pour les chats.
____________________
Roro

   
Le 17/03/2013 à 16h51

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Ce qui serait pas mal comme outil, ce serait un truc qui charge un code et qui liste les handles.
Ce qui éviterai de chercher les handles disponibles (quand il y en a déjà beaucoup.)
je verrai bien ça sur le même principe que le prog qui liste les labels.
Je vais le tenter.

____________________
Roro

   
Le 17/03/2013 à 18h11

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
C'est bon, j'ai récupérés les handles, en éliminant les doublons.
Je vais aussi me faire les noms de chaînes.
Mais avant, il faut que je vire tout le superflu (texteditor...ext)
Va falloir couper "fin".
____________________
Roro

   
Le 17/03/2013 à 19h11

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Roland:
Y'a pas à dire...C'est beau le "savoir faire". :top :top
Ce code, je m'y étais déjà pas mal usé le neurône.
Mais là c'est reparti pour un mois.
Oui, je sais, c'est très simple....Quelques variables...Juste quelques variables....Et...
Une p....n de FONCTION DE DERRIERE LES FAGOTS.
En tous cas, je te remercie. Je vais colorier,
en essayant de pas tout prendre sur la tronche.

Il n'est pas de moi ce code !
J'ai pas eu grand chose à faire pour l'adapter à ce que tu voulais.
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."

Web    
Le 17/03/2013 à 20h35

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Je sais bien que le code n'est pas de toi. Mais la modif que tu a faite, il n'y a pas grand monde qui en soit capable.
Et ce qui fait la valeur des choses comme des gens, c'est leur rareté.
La valeur intrinsèque n'a pas en soit grand sens. Comment comparer la valeur intrinsèque d'un prof de faculté et d'un archer du douzième siècle, si on les sort de leur époque. ( Booou! Faut que j'arrête la moquette moi.)
Tu est tout simplement un incorrigible modeste. Ou peut-être bien que tu crains qu'une horde de débutants ne te tombe dessus, te tirant par le bas de la veste, quémandant la sainte vérité.
J'hésite....



Edité par Roland Le 18/03/2013 à 12h22
____________________
Roro

   
Le 18/03/2013 à 12h21

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Bonjour Cassiope,
Et bien, si pour les handles, cela a été facile;
les chaînes sont déchaînées.
L'extraction du nom marche bien, jusqu'au textbox espion et son wait
Mais si j'enlève le wait, il overflow le tableau (même avec un petit code).
Il y a un bouton "Stop" en bas comme "Arrêt d'urgence".
Je sèche comme un vulgaire hareng saur...

Code VB :
 
 
  nomainwin
   'on error goto [huh]
   dim info$(1,1)
   dim label$(500)  'increase if needed '**************************
   dim chain$(500)
 
  [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=450
  WindowHeight=750
    UpperLeftX=INT((DisplayWidth-WindowWidth)/1)
    UpperLeftY=INT((DisplayHeight-WindowHeight)/6)
 
   menu #w, "File", "Open", [nouv]
   listbox #w.lb, label$(), [match], 10, 10, 120, 570
   listbox #w.ch, chain$(), [matchain], 140, 10, 120, 570
   texteditor #w.te, 270, 10, 120, 570
 
   BUTTON #w.edi, "JB's editor", [JBeditor], UL, 95, 610 , 70, 20
   BUTTON #w.zoo, "8", [zoo], UL, 120, 585 , 40, 20
   BUTTON #w.sto, "stop", [sto], UL, 10, 585 , 40, 20
 
   TEXTBOX #w.a, 10, 640,150, 20
 
  open "Label Extractor  -  ";fileName$ for window as #w
   #w "trapclose [quit]"
   #w.lb "font Courier_New 8"
   zoo=2
   path$ = GetPath$(fileName$)
   name$ = GetName$(fileName$)
   tknfile$ = left$(name$,len(name$)-3)+"tkn"
 
   [cont]
   #w.zoo, word$("10 8",zoo)
   '------------------------------- IMPORTATION CODE POUR LES HANDLES---------------------
  open fileName$ for input as #me
   label$(1) = "- TOP -"
   n=2: nn=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
  wend
   label$(n) = "- BOTTOM -"
  close #me
  '------------------
   #w.lb, "reload"
 
   goto [chaines] '-------> VERS CHAINES ---->
  wait
  [getlabel]
    for x=1 to 20
       aa$=left$(ln$,x)
       if aa$="," or aa$=" " then exit for
    next x
    a$=word$(ln$, 1)
    for xx=1 to n
      if a$=label$(xx) then exit for
    next xx
    if a$=label$(xx) then goto [passa]
    label$(n)=a$
    [passa]
  return
  '---------------------------------- FIN HANDLES -----------------

  '------------------------- IMPORTATION CODE POUR LES CHAINES -----------------
  [chaines]
  nn=1
  open fileName$ for input as #me ' je mets le code dans un texteditor ligne par ligne
       [loop]                     'ne sait pas mettre directement le fichier en chaîne
       if eof(#me) <> 0 then [sortir]
       line input #me, item$
       #w.te, item$
       goto [loop]
       [sortir]
  close #me
 
    #w.te, "!contents? code$" ' le texteditor dans une chaîne--> code$
    xx=1
    for x=xx+1 to len(code$) 'xx=index mobile
       scan
       if sto=1 then wait ' pour arreter la machine infernale
       if mid$(code$,x,1)="$" then 'trouve "$"
          xx=x                     'mémorise l'endroit(index mobile)
          for y=xx to xx-10 step -1 'cherche debut du nom en partant de"$" et en remontant
             if mid$(code$,y,1)=" " or a$=";" or a$="(" or a$="+" or a$="-" or a$="=" then 'trouve le début
                yy=y               'mémorise l'endroit
                   for z=yy to xx
                      b$=b$+ mid$(code$,z,1) 'reconstitue le nom (b$)
                   next z
        #w.a,b$ '***** ESPION
        wait '  -------------- jusque là ça marche Mais si j'enlève le wait non
                   for t=1 to nn
                      if b$ <> word$(chain$,t) then ' si n'est pas doublon
                         chain$(nn)=b$:nn=nn+1 'stocke dans chain$ (de listbox #w.ch)
                      end if
                   next t
             end if
          next y
       end if
    next x
    #w.ch, "reload"
  wait
  '--------------------------- FIN DES CHAINES -----------------------------
  [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
  [zoo]
    zoo=zoo+1
    if zoo =3 then zoo=1
    if zoo =1 then
       #w.lb "font Courier_New 10"
       #w.ch "font Courier_New 10"
    end if
    if zoo =2 then
       #w.lb "font Courier_New 8"
       #w.ch "font Courier_New 8"
    end if
    goto [cont]
  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
 
  [sto]
  sto=1
  wait
 
  [quit]
    close #w
  end
 
  [quit.test]
  end
 
  [huh]
    if Err = 9 then
       notice "Augmenter dim label$()and chain$()"
       close #me
       goto [quit]
  end if
 
 




Edité par Roland Le 18/03/2013 à 12h22
____________________
Roro

   
Le 02/04/2013 à 18h33

Administrateur

Groupe: Administrateur

Inscrit le: 04/03/2012
Messages: 2083
Allez ...té...Je poste mon usine à gaz, avec tri de noms, élimination de doublons...ext
ATTENTION: à tester avec un code pas trop gros. Sinon ça overflow les tableaux.

Code VB :
 
 
 ' nomainwin
   'on error goto [huh]
   dim info$(1,1)
   dim hand$(800)
   dim chain$(800)
   dim label$(800)  'increase if needed '**************************
   dim temp$(800)
 
  [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=450
  WindowHeight=750
    UpperLeftX=INT((DisplayWidth-WindowWidth)/1)
    UpperLeftY=INT((DisplayHeight-WindowHeight)/6)
 
   menu #w, "File", "Open", [nouv]
   listbox #w.ha, hand$(), [matchhand], 5, 10, 80, 570
   listbox #w.ch, chain$(), [matchain], 90, 10, 80, 570
   listbox #w.lb, label$(), [match], 175, 10, 120, 570
   texteditor #w.te, 270, 10, 120, 570
 
   BUTTON #w.edi, "JB's editor", [JBeditor], UL, 95, 610 , 70, 20
   BUTTON #w.zoo, "8", [zoo], UL, 120, 585 , 40, 20
   BUTTON #w.sto, "stop", [sto], UL, 10, 585 , 40, 20
 
   TEXTBOX #w.a, 10, 640,150, 20
 
  open "Label Extractor  -  ";fileName$ for window as #w
   #w "trapclose [quit]"
   #w.te, "!autoresize"
   #w.lb "font Courier_New 8"
   zoo=2
   path$ = GetPath$(fileName$)
   name$ = GetName$(fileName$)
   tknfile$ = left$(name$,len(name$)-3)+"tkn"
 
   [cont]
   #w.zoo, word$("10 8",zoo)
 
 
  '------------------------------- IMPORTATION CODE  -----------------
  nn=1
  open fileName$ for input as #me ' je mets le code dans un texteditor ligne par ligne
       [loop]
       if eof(#me) <> 0 then [sortir]
       line input #me, item$
       #w.te, item$
       goto [loop]
       [sortir]
  close #me
   '---------------------------------- HANDLES---------------------
    #w.te, "!contents? code$" ' le texteditor dans une chaîne--> code$
       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+10
             a$= mid$(code$,y,1)
             if a$="," or a$=" " or a$=chr$(34) then
                yy=y
                b$=""
                for u=xx to yy -2 'reconstruit handle
                   b$=b$+mid$(code$,u,1)
                next u
             end if
          next y
          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
   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$(800):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-10 step -1 '----cherche debut
             a$= mid$(code$,y,1)
             if a$=chr$(34) or a$="?" or a$="  " or a$=" " or a$=";" or a$="(" or a$="+" or a$="-" or 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
    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
   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 -----------------------------
  [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
  [zoo]
    zoo=zoo+1
    if zoo =3 then zoo=1
    if zoo =1 then
       #w.lb "font Courier_New 10"
       #w.ch "font Courier_New 10"
    end if
    if zoo =2 then
       #w.lb "font Courier_New 8"
       #w.ch "font Courier_New 8"
    end if
    goto [cont]
  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
 
  [sto]
  sto=1
  wait
 
  [quit]
    close #w
  end
 
  [quit.test]
  end
 
  [huh]
    if Err = 9 then
       notice "Augmenter dim label$()and chain$()"
       close #me
       goto [quit]
  end if
 
 


____________________
Roro

   
Débutant » Appropriate close command ! La bête est rétive  

 |  |

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