Discussion :

[joce21]

Bonjour!

J'ai un programme qui cherche à l'intérieur de dossier, comme la recherche de Windows.

J'utilise les méthodes FindFirst et FindNext pour ma recherche. Cependant, lorsque je cherche par exemple un fichier contenant "Établissement" dans son nom et que je tape "etablissement" dans mon programme, il ne trouvera pas le fichier.

Y-a-t-il solution pour qu'il ne prenne pas en considération les accents? Donc que e = é,è... a = à,â, etc...

Merci d'avance.

[Paul TOTH]

Bonjour!

J'ai un programme qui cherche à l'intérieur de dossier, comme la recherche de Windows.

J'utilise les méthodes FindFirst et FindNext pour ma recherche. Cependant, lorsque je cherche par exemple un fichier contenant "Établissement" dans son nom et que je tape "etablissement" dans mon programme, il ne trouvera pas le fichier.

Y-a-t-il solution pour qu'il ne prenne pas en considération les accents? Donc que e = é,è... a = à,â, etc...

Merci d'avance.

pas que je sache...reste la solution de prendre *.* et de filtrer les résultats après coup.

[GoustiFruit]

Peut-être avec un soundex ?

[ShaiLeTroll]

La Méthode de Paul Toth, est assez simple, comparer a posteriori sans accents le nom de fichier récupéré et le nom voulu
Un sujet utile : Y-a-t-il plus rapide pour enlever les accents ?

Tu pourrais utiliser le caractère ?
Je n'ai jamais testé mais cela permet d'avoir qu'une seule lettre substitué

remplace tous les accents par ?
etablissement devrait s'écrire établissement donc ?tablissement
Si c'est une recherche libre, il te faudrait un dictionnaire, cela semble peu pratique !
Sinon il faudrait limiter la recherche à une liste de mot prédéfini !

[Andnotor]

FoldString est la fonction à utiliser

MAP_COMPOSITE va "exploser" les caractères accentués. Idem pour les ligatures avec MAP_EXPAND_LIGATURES.
Une boucle de suppression des accents et le tour est joué

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
function PrepareString(aValue: string): string;
const
  MAP_EXPAND_LIGATURES = $00002000;
var
  i :integer;
  //
  function DoFoldString(aMapFlags :cardinal; aText :string) :string;
  var
    Len :integer;
  begin
    Len := FoldString(aMapFlags, PChar(aText), Length(aText), nil, 0);
    SetLength(Result, Len);
    FoldString(aMapFlags, PChar(aText), Length(aText), PChar(Result), Len);
  end;
  //
begin
  //Supprime les ligatures
  Result := DoFoldString(MAP_EXPAND_LIGATURES, aValue);
 
  //Explose la chaîne en caractères et accents
  Result := DoFoldString(MAP_COMPOSITE, Result);
 
  //Supprime les accents
  for i := Length(Result) downto 1 do
    if not IsCharAlpha(Result[i]) then
      Delete(Result, i, 1);
end;

L'avantage ? Ça fonctionne quelque soit la langue, y compris sur des chaînes unicodes

Edit: Depuis XE, on pourrait encore affiner la boucle de suppression en utilisant les fonctions de l'unité Character.

[ShaiLeTroll]

FoldString ! Fallait la connaître et avoir l'idée de nettoyer les accents après ! Joli !
En plus, j'ai fait une fonction en Delphi 3 qui transformait œ en oe
Si j'avais su ça en 2004 !

Faudrait voir les performances de FoldString rapport au meilleur code du sujet Y-a-t-il plus rapide pour enlever les accents ?


AndNotOr

[Andnotor]

On pourrait bien sûr utiliser cette même fonction pour convertir la table ansi (enfin en dessus de 128). Mais il faudrait le faire à chaque changement de langue. (j'aime pas les constantes)

Le problème est que même en français la table ansi ne contient pas toutes les possibilités. Ex. œ n'y figure pas (u335). Autant traiter la chaîne au moment voulu (en unicode si possible)

[ShaiLeTroll]

Tout à fait, œ est une spécificité du Windows-1252 par rapport au Latin1 de base !
D'ailleurs, le MS Sans Serif (ancienne police par défaut de windows) ne propose pas le œ, il fallait utiliser l'Arial, avec un XP et l'utilisation par défaut de Tahoma, c'est des choses à lesquelles l'on ne fait plus attention !

Lors du passage de 2007 en XE2, on a eu la surprise de voir que notre fenêtre de Login\Pass était resté en MS Sans Serif au lieu de Tahoma, du coup les petits étoiles du TEdit en mode Password n'était pas supporté car le caractère Unicode était substitué par le carré noir désignant un caractère inconnu


@joce21, désolé, on a dévié !

[joce21]

Merci beaucoup ! Je vais essayer vos idées et voir laquelle je préfère!

Pour l'instant, je crois que le plus simple serait de prendre la chaîne que l'utilisateur entre dans le TEdit de recherche et de remplacer tout les lettres susceptible d'avoir des accents par ? comme ShaiLeTroll l'a proposer.

Merci encore!

[ShaiLeTroll]

Le plus simple, c'est la méthode "a posteriori" avec *.* proposé par Paul Toth

Remplacer les caractères "pouvant" avoir des accents, c'est loin d'être simple, la seule méthode sûre serait d'avoir un dictionnaire des mots accentués (ouch !)

Car en français, oui, avec une vision simpliste, il suffirait de remplacer en gros toutes les voyelles par des ? mais cela amène des effet de bord, l'utilisateur cherche "voiture" ce qui donnerait v??t?r?, je te laisse imaginer tout ce que l'on peut récupérer comme vantard
Donc il te faudra tout de même procédé à un filtre manuel !

[joce21]

Le plus simple, c'est la méthode "a posteriori" avec *.* proposé par Paul Toth

Remplacer les caractères "pouvant" avoir des accents, c'est loin d'être simple, la seule méthode sûre serait d'avoir un dictionnaire des mots accentués (ouch !)

Car en français, oui, avec une vision simpliste, il suffirait de remplacer en gros toutes les voyelles par des ? mais cela amène des effet de bord, l'utilisateur cherche "voiture" ce qui donnerait v??t?r?, je te laisse imaginer tout ce que l'on peut récupérer comme vantard
Donc il te faudra tout de même procédé à un filtre manuel !

En effet, j'ai pas pensé assez loin.

Voici, ma solution:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
var
	sTest: string;
   sMask: string;
   tabTest: TStringList;
   i: integer;
begin
  	inherited;
   sMask := '*';
   tabTest := TStringList.Create;
  	tabTest.Add('tele');
  	tabTest.Add('télé');
  	tabTest.Add('télèeas');
  	tabTest.Add('télà');
  	sTest := 'tele';
 
  	for i := 1 to Length(sTest) do
  	begin
   	case sTest[i] of
      			'a'		: sMask := sMask + '[aà-å]';
               'e'		: sMask := sMask + '[eè-ë]';
               'i'		: sMask := sMask + '[iì-ï]';
               'o'		: sMask := sMask + '[oò-ö]';
               'u'		: sMask := sMask + '[uù-ü]';
               'y'		: sMask := sMask + '[yý-ÿ]';
               else sMask := sMask + sTest[i];
      end;
  	end;
   sMask := sMask + '*';
 
   for i := 0 to tabTest.Count - 1 do
   begin
   	if (MatchesMask(tabTest[i], sMask)) then
      	ShowMessage(tabTest[i]);
   end;

En gros, je prend "sTest" qui sera en l’occurrence la chaîne avec laquelle je dois trouver les fichiers. Je parcours cette chaîne en remplaçant tous les voyelles par le "range" dans le Case. Donc à la fin de ce test, sMask sera égale à : '*t[eè-ë]l[eè-ë]*'. J'appelle donc MatchesMask pour filtrer ma liste de string. Il me sort donc : tele, télé et téléeas.

Dites-moi ce que vous en pensez!

[Andnotor]

Et ç ?
Et s'il prend l'envie au gars de taper téle ?
Et pourquoi diable se limiter au français ?

[joce21]

Et ç ?
Et s'il prend l'envie au gars de taper téle ?
Et pourquoi diable se limiter au français ?

Ce n'est qu'un test. J'ai rajouter les autres caractères dans mon vrai code du genre: ç, ñ, Ð, etc...

Et s'il tape "téle" cela fonctionne quand même, car il remplace le "e" par "[eè-ë]" donc il cherche soit un "e" ou bien un caractère entre "è" et "ë".

Pourquoi seulement en français? C'est un programme interne d'une PME qui ne parle que français/anglais. Donc je ne vois pas l'utilité d'inclure le Mandarin .

Edit: J'ai terminé d'implémenter cette technique et elle fonctionne à merveille!

[ShaiLeTroll]

Tu répètes plusieurs appels de FindFirst avec différente forme du mot ?
Attention, plus le mot est complexe pour la recherche sera lente !
Ou est-ce que tu recherche avec ? du mot avec un seul FindFirst puis tu effectues un second filtre manuel ?

Faudrait comparer les performances avec la méthode de remplacement des caractères et celle du filtre en *.*
Il est évident que plusieurs appels à FindFirst, ça sera plus lent, mais par contre, entre "masque avec une version avec ? puis second filtre manuel" et un "masque *.* puis tout gérer en manuel"

J'avais procédé plus ou moins de la même façon dans une application que j'ai maintenu pour justement un moteur de recherche.
A la fin de l'import des données textes issus de CCAM, une codification médicale, je finissais avec 800 000 mots
Justement le dictionnaire de mot gérait les versions avec accents avec les variations possibles comme évènement ou événement, Événement ... mais seulement celles présentes dans le fichier et les associaient tous à une forme nettoyée EVENEMENT
A la fin, cela servait pour un moteur de recherche pour trouver un code CCAM en fonction mot clé, je peux te dire que cœur et exérèse était mes mots préférés !
Évidemment des CheckBox était là pour que l'utilisateur choisisse une recherche stricte (donc rapide), une recherche partielle (LIKE) et\ou une recherche étendu (accents, lettre composée)

[joce21]

Ce que je fais c'est que je lis tous les fichiers (*.*) dans les dossiers désirés à l'aide de FindFirst et FindNext. Je garde leur nom dans une stringlist et par la suite je parcours cette liste pour vérifier les nom de fichier qui correspondent au mask et je les sauvegarde dans une autre liste que j'affiche par la suite.

Au plus il va trouver 1500 fichiers, donc la recherche est quand même assez rapide.

Je ne sais pas s'il existe un moyen plus rapide d'obtenir tous les noms de fichier d'un dossier sans passer par FindFirst et FindNext.

[ShaiLeTroll]

Oui, c'est le mieux a mon avis !
Tu pourrais par contre, vérifier le nom AVANT l'insertion dans la TStringList, inutile d'allouer des milliers de chaine pour en virer ensuite 99% !

FindFirst, FindNext, perso, c'est la seule méthode que j'utilise, je me suis fait une fonction générique, en voici une version modifié pour gérer ton cas de façon optimale !
Et cela restera ré-utilisable

Perso, j'ai utilise FindFirst, FindNext pour de la migration de GED, on comptait les fichiers par centaines de milliers et en centaine de Go !
La première phase c'était calcul de la taille nécessaire à la copie des fichiers pouvaient prendre quelques minutes (une quinzaine), en gros le même temps que le "clic droit propriété" dans l'explorateur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
  TGetListFileBeforeAddCallback = function(const PathFile: string; SearchRec: TSearchRec; UserData: Pointer): boolean;
 
  procedure GetListFile(const PathFile: string; ResultList: TStrings; Recurse: Boolean = False; BeforeAddCallback: TGetListFileBeforeAddCallback = nil; UserData: Pointer = nil);
  var
    SearchRec: TSearchRec;
  begin
    ResultList.BeginUpdate();
    try
      if not Recurse then
        ResultList.Clear();
 
      // '*' ou '*.*' Renvoie '.' et '..'
      if SysUtils.FindFirst(PathFile + '*', faAnyFile, SearchRec) = 0 then
      begin
        try
          repeat
            if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
            begin
              if Recurse then
              begin
                if (SearchRec.Attr and faDirectory) <> 0 then // Dossier
                  GetListFile(IncludeTrailingPathDelimiter(PathFile + SearchRec.Name), ResultList, True) // C'est un Dossier, on cherche les fichiers qu'il contient !
                else
                  if not BeforeAddCallback or BeforeAddCallback(PathFile, SearchRec, UserData) then 
                    ResultList.Add(PathFile + SearchRec.Name) // Fournie Racine + Nom du Fichier
              end
              else
                if (SearchRec.Attr and faDirectory) = 0 then // Fichier
                  if not BeforeAddCallback or BeforeAddCallback(PathFile, SearchRec, UserData) then
                    ResultList.Add(SearchRec.Name); // Fourni juste le nom du Fichier
            end;
 
          until SysUtils.FindNext(SearchRec) <> 0;
        finally
          SysUtils.FindClose(SearchRec);
        end;
      end;
    finally
      ResultList.EndUpdate();
    end;
  end;

Tu implémentes la CallBack avec le Mask !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Self.Mask := '*t[eè-ë]l[eè-ë]*'; // Mask propriété string public de TForm1
  GetListFile('C:\', ListBox1.Items, true, toto, Self);
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
function toto(const PathFile: string; SearchRec: TSearchRec; UserData: Pointer): boolean;
begin
  Result := false;
  if Assigned(UserData) and TObject(UserData) is TForm1 then
    Result := MatchesMask(SearchRec.Name, TForm1(UserData).Mask); 
end;

[joce21]

Haha en effet, je ne sais pas pourquoi j'ai pas pensé à ça avant. Je vérifie le mask avant de l'ajouter dans la liste tout simplement!

Merci encore pour votre aide!