Recherche d'une chaîne de caractères dans une arborescence

' recherche_string.bas

label find, oups, reprise

dim s$, f$, dir$, old$, ext$, rec$

height 0,600

open_dialog 1
                                                  :
edit 10 : top 10,10 : left 10,10 : width 10,300
combo 11 : top 11,40 : left 11,10
  item_add 11,".bas"
  item_add 11,".pas"
  item_add 11,".dpr"
  item_add 11,".txt"
  text 11,item_read$(11,1)
button 20 : top 20,40 : left 20,320 : caption 20,"Rechercher"
  on_click 20,find
 
memo 30 : top 30,70 : left 30,10 : width 30,300 : height 30,370
  bar_both 30

alpha 40 : top 40,470 : left 40,10
 
dlist 31

end

find:
  s$ = trim$(text$(10))
  if len(s$)=0
    message "Rien à chercher"
    return
  end_if
  f$ = file_name$(1)
  if f$="_" then return
  old$ = dir_current$
  dir$ = file_extract_path$(f$)
 
  clear 30
  clear 31
  chercher(dir$)
  while count(31)>0
    dir$ = item_read$(31,1)
    item_delete 31,1
    if right$(dir$,1)<>"\" then dir$ = dir$ + "\"
    chercher(dir$)
  end_while
  item_add 30,"---fini---"
  dir_change old$
  return

sub chercher(dir$)
  item_add 30,"--- "+dir$
  on_error_goto oups
  dir_change dir$
  off_error_goto
  f$ = file_find_first$
  while f$<>"_"
    ext$ = file_extract_extension$(f$)
    if ext$=text$(11)
      file_open_read 1,f$
      caption 40,"Recherche dans "+f$+" ..."
      while file_eof(1)=0
        file_readln 1,rec$
        if instr(rec$,s$)>0
          item_add 30,f$
          exit_while
        end_if
      end_while
      file_close 1
      caption 40,""
    end_if
    if ext$="" then item_add 31,dir$+f$
    f$ = file_find_next$
  end_while
  file_find_close
reprise:
end_sub

oups:
  item_add 30,"+++ Erreur sur "+dir$
  off_error_goto
  goto reprise