Нестрогое сравнение строк

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Нестрогое сравнение строк

 

Зависимости: SysUtils

Автор:       Dimich, dvmospan@pisem.net, ICQ:236286143, Bryansk

Copyright:   Владимир Кива

Дата:        11 октября 2004 г.

********************************************** }

 

unit FindCompare;

 

interface

 

//------------------------------------------------------------------------------

//Функция нечеткого сравнения строк БЕЗ УЧЕТА РЕГИСТРА

//------------------------------------------------------------------------------

//MaxMatching - максимальная длина подстроки (достаточно 3-4)

//strInputMatching - сравниваемая строка

//strInputStandart - строка-образец

 

// Сравнивание без учета регистра

// if IndistinctMatching(4, "поисковая строка", "оригинальная строка - эталон") > 40 then ...

 

function IndistinctMatching(MaxMatching : Integer;

                           strInputMatching: WideString;

                           strInputStandart: WideString): Integer;

implementation

 

Uses SysUtils;

 

Type

    TRetCount = packed record

                lngSubRows : Word;

                lngCountLike : Word;

               end;

 

//--------------------------------------------

function Matching(StrInputA: WideString;

                 StrInputB: WideString;

                 lngLen: Integer) : TRetCount;

Var

   TempRet : TRetCount;

   PosStrB : Integer;

   PosStrA : Integer;

   StrA : WideString;

   StrB : WideString;

   StrTempA : WideString;

   StrTempB : WideString;

begin

   StrA := String(StrInputA);

   StrB := String(StrInputB);

   For PosStrA:= 1 To Length(strA) - lngLen + 1 do

   begin

      StrTempA:= System.Copy(strA, PosStrA, lngLen);

      PosStrB:= 1;

      For PosStrB:= 1 To Length(strB) - lngLen + 1 do

      begin

        StrTempB:= System.Copy(strB, PosStrB, lngLen);

        If SysUtils.AnsiCompareText(StrTempA,StrTempB) = 0 Then

        begin

          Inc(TempRet.lngCountLike);

          break;

        end;

      end;

      Inc(TempRet.lngSubRows);

   end; // PosStrA

   Matching.lngCountLike:= TempRet.lngCountLike;

   Matching.lngSubRows := TempRet.lngSubRows;

end; { function }

 

//-----------------------------------------------------

function IndistinctMatching(MaxMatching : Integer;

                           strInputMatching: WideString;

                           strInputStandart: WideString): Integer;

Var

   gret : TRetCount;

   tret : TRetCount;

   lngCurLen: Integer ; //текущая длина подстроки

begin

   //если не передан какой-либо параметр, то выход

   If (MaxMatching = 0) Or (Length(strInputMatching) = 0) Or

      (Length(strInputStandart) = 0) Then

   begin

     IndistinctMatching:= 0;

     exit;

   end;

   gret.lngCountLike:= 0;

   gret.lngSubRows := 0;

   // Цикл прохода по длине сравниваемой фразы

   For lngCurLen:= 1 To MaxMatching do

   begin

     //Сравниваем строку A со строкой B

     tret:= Matching(strInputMatching, strInputStandart, lngCurLen);

     gret.lngCountLike := gret.lngCountLike + tret.lngCountLike;

     gret.lngSubRows := gret.lngSubRows + tret.lngSubRows;

     //Сравниваем строку B со строкой A

     tret:= Matching(strInputStandart, strInputMatching, lngCurLen);

     gret.lngCountLike := gret.lngCountLike + tret.lngCountLike;

     gret.lngSubRows := gret.lngSubRows + tret.lngSubRows;

   end;

   If gret.lngSubRows = 0 Then

   begin

     IndistinctMatching:= 0;

     exit;

   end;

   IndistinctMatching:= Trunc((gret.lngCountLike / gret.lngSubRows) * 100);

end;

 

end.

 

 

 

 

Пример использования:

Code:

begin

Relevant := FindCompare.IndistinctMatching (3, edFind.Text, edOriginal.Text);

if Relevant > 40 then ShowMessage('IMHO похожи!');

//....

end;

 

 

 

©Drkb::00175