Code:

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

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

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

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

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

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

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 = packedrecord

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:= 1To Length(strA) - lngLen + 1do

begin

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

PosStrB:= 1;

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

begin

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

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

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:= 1To 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 = 0Then

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 > 40then ShowMessage('IMHO похожи!');

//....

end;