Вот уже 3 дня долбусь об стену с натписю UTF8
. Брал готовые функции , работаю в тексте програмы из firebird результат неверный.
Решил сам написать по алгоритму, что бы разобратца как работает и в чем проблема, функция есть а результата нет.
Код: Выделить всё
function MyCompareStr(Search, Etalon: PChar): integer;
var
j: integer;
SubStr: PChar;
Count: integer =0;
SubStrLen: integer;
SubStrCountS: integer;
SubStrCountE: integer;
CountLike: integer = 0;
MaxSubStrLen: integer = 4;
begin
Result:=0;
if (Length(Search)=0) or (Length(Etalon)=0) then exit;
if min(Length(Search),Length(Etalon))<MaxSubStrLen then
MaxSubStrLen:=min(Length(Search),Length(Etalon));
Search:=PChar(UpperCase(Search));
Etalon:=PChar(UpperCase(Etalon));
for SubStrLen:=1 to MaxSubStrLen do begin
SubStrCountS:=Length(Search)-SubStrLen+1;
for j:=1 to SubStrCountS do begin
SubStr:=PChar(Copy(Search,j,SubStrLen));
if pos(SubStr,Etalon)<>0 then
inc(CountLike);
inc(Count);
end;
SubStrCountE:=Length(Etalon)-SubStrLen+1;
for j:=1 to SubStrCountE do begin
SubStr:=PChar(Copy(Etalon,j,SubStrLen));
if pos(SubStr,Search)<>0 then
inc(CountLike);
inc(Count);
end;
end;
Result:=trunc((CountLike/Count)*100);
end;
Может не идеал но моих небольших расчетов подходит. В тексте програмы все работает, через firebird полная ерунда получается.
Подскажите как заставить ее работать.
