Soyez le premier à donner votre avis sur cette source.
Snippet vu 13 335 fois - Téléchargée 33 fois
// ---------------------------------------------------------------------------------------- Function ComparerChaines(s1,s2:String):Integer; { Fonction comparaison chaînes de texte: Entrée: S1 = première chaîne a comparer, taille limitée a 2048 caractères S2 = deuxième chaîne a comparer, taille limitée a 2048 caractères Sortie: INTEGER, de 0 a 100, % de ressemblance entre les 2 chaînes } Var identiques, // Nombre de caractères identiques p1,p2, // Indicateurs de position l1,l2, // Longueurs des chaînes pt, // Compteur de boucle diff : Integer; // Facteur d égalisation hstr : String; // Variable temporaire d échange des chaînes test : Array [1..2048] Of Boolean; // Tableau d indicateur pour suivre les positions déjà testées Begin // Tester les longueurs et échanger si S1 est plus courte, on teste toujours par rapport a la chaîne la plus longue If Length(s1)<Length(s2) Then Begin hstr := s2; s2 := s1; s1 := hstr; End; // Stocker les longueurs des chaînes l1 := Length(s1); l2 := Length(s2); // Une chaîne a vide ? alors la comparaison est de 0% If (l1=0) Or (l2=0) Then Result := 0 Else Begin p1 := 1; p2 := 1; identiques := 0; // Calculer le facteur d égalisation dépendant de la longueur de la chaîne, en général c est 1/3 de la longueur maximale diff := Max(l1,l2) Div 3 + Abs(l1-l2); // Initialiser le tableau de suivi For pt := 1 To l1 Do test[pt] := False; // Parcours de la chaîne Repeat // Position testée ? If Not test[p1] Then Begin // Caractère identique ? If (s1[p1]=s2[p2]) And (Abs(p1-p2)<=diff) Then Begin test[p1] := True; // Augmenter le compteur de caractères identiques Inc(identiques); // Positions suivantes Inc(p1); Inc(p2); // Boucler If p1>l1 Then p1:=1; End Else Begin Test[p1] := False; Inc(p1); // Boucler a la prochaine position de test si on arrive a la fin de la chaîne If p1>l1 Then Begin While (p1>1) And Not (test[p1]) Do Dec(p1); Inc(p2) End; End; End Else Begin Inc(p1); // Boucler a la prochaine position de test si on arrive a la fin de la chaîne If p1>l1 Then Begin Repeat Dec(p1); Until (p1=1) Or test[p1]; Inc(p2); End; End; Until p2>Length(s2); // Calculer la valeur en pourcentage Result := 100 * identiques Div l1; End; End;
11 nov. 2007 à 20:01
21 août 2006 à 02:28
19 août 2006 à 12:11
Il va surment m'être utile pour la recherche dans les fichiers d'aide
Bonne continuation ;)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.