Показать сообщение отдельно
  #3  
Старый 19.03.2013, 10:21
Pcrepair
 
Сообщения: n/a
По умолчанию

итого получилось следующее

Код:
function DelParagraph(const Str1,Str2:string; L:integer):string;
(*--------------------------------------------------*)
(*  17.03.13  Функция удаления символов <ggg>*)
function Del(const AData:string):string;
var
Pos1,Pos2:integer;
Buf:string;
begin
Buf:=AData;
  while Pos1 > 0 do
    begin
      Pos1:=PosEx('<',Buf,1);
      Pos2:=PosEx('>',Buf,Pos1);
      if (Pos1 = 0) or (Pos2 = 0) then Break;   (*защита*)
      Delete(Buf,Pos1,(Pos2-Pos1));
    end;
    Result:=Buf;
end;
(*--------------------------------------------------*)
var
J,I,Count,G:integer;
T1,T2:TStringList;
begin
Result:='';
Count:=0;
if Length(Str1) > 0 then
  begin
   T1:=TStringList.Create;
   T2:=TStringList.Create;
     try
       T2.Sorted := true;                             
       T2.Duplicates := dupIgnore;                
       T1.Text:=SpliteText(Del(Str1));        
       G:=(T1.Count);                              
       T2.Text:=SpliteText1(Str2);                 
       for I := 0 to T2.Count-1 do
        for J := 0 to T1.Count-1 do
         if CompareWords(T2[i],T1[J]) then
           Inc(Count);
         if (Count > 0) and (G > 0)   and ((Count*100 Div G) > L) then
         Result:=Str1;
     finally
        FreeAndNil(T1);
        FreeAndNil(T2);
     end;
  end else Exit;
end;

какие есть еще недоработки?
Ответить с цитированием