Форум АНТИЧАТ

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   С/С++, C#, Delphi, .NET, Asm (https://forum.antichat.xyz/forumdisplay.php?f=24)
-   -   текст страницы (https://forum.antichat.xyz/showthread.php?t=179023)

Seravin 15.02.2010 15:40

текст страницы
 
Сейчас передо мной стоит такая задача: надо определить ~"равны" ли две html'евские страницы. Пытался найти какие-нибудь сорцы, но то что я находил и хоть как-то под себя подстраивал работали >1 сек. Ну и я решил писать свою функцию
Код:

function TMainForm.ComparePages(page1,page2:string):boolean;
var s,s1,s2:string;i,j:integer; space,t:boolean;
begin
s:=page1;
while pos('<script',s)<>0 do
s:=copy(s,1,pos('<script',s)-1)+copy(s,pos('</script>',s)+9,length(s));
while pos('&nbsp;',s)<>0 do
s:=copy(s,1,pos('&nbsp;',s)-1)+copy(s,pos('&nbsp;',s)+6,length(s));
s1:='';
t:=true;
space:=false;
for i:=1 to length(s) do
if not(s[i] in [#$D,#$A,#9]) then
  if ((s[i]=' ')and(s[i+1]<>' '))or (s[i]<>' ') then
  if (s[i]='<') then t:=false else
    if (s[i]='>') then
      begin
      t:=true;
      space:=true;
      end else
        if t then
        if (s[i]=' ')or(space) then begin
          if (length(s1)<>0) then begin
          if (s1[length(s1)]<>' ') then begin
            if (space)and(s[i]<>' ') then
            s1:=s1+' '+s[i]
            else
            s1:=s1+s[i];
          end else if (s[i]<>' ') then s1:=s1+s[i];
          space:=false;
          end else begin
            s1:=s1+s[i];
            space:=false;
          end;
        end else
          s1:=s1+s[i];

s2:=s1;

s:=page2;
while pos('<script',s)<>0 do
s:=copy(s,1,pos('<script',s)-1)+copy(s,pos('</script>',s)+9,length(s));
while pos('&nbsp;',s)<>0 do
s:=copy(s,1,pos('&nbsp;',s)-1)+copy(s,pos('&nbsp;',s)+6,length(s));
s1:='';
t:=true;
space:=false;
for i:=1 to length(s) do
if not(s[i] in [#$D,#$A,#9]) then
  if ((s[i]=' ')and(s[i+1]<>' '))or (s[i]<>' ') then
  if (s[i]='<') then t:=false else
    if (s[i]='>') then
      begin
      t:=true;
      space:=true;
      end else
        if t then
        if (s[i]=' ')or(space) then begin
          if (length(s1)<>0) then begin
          if (s1[length(s1)]<>' ') then begin
            if (space)and(s[i]<>' ') then
            s1:=s1+' '+s[i]
            else
            s1:=s1+s[i];
          end else if (s[i]<>' ') then s1:=s1+s[i];
          space:=false;
          end else begin
            s1:=s1+s[i];
            space:=false;
          end;
        end else
          s1:=s1+s[i];


j:=length(s2);
while pos(' ',s1)<>0 do begin
  if pos(copy(s1,1,pos(' ',s1)-1),s2)<>0 then begin
  delete(s2,pos(copy(s1,1,pos(' ',s1)-1),s2),length(copy(s1,1,pos(' ',s1)-1)));
  s2:=trim(s2);
  end;
  delete(s1,1,pos(' ',s1));
  s1:=trim(s1);
end;
showmessage(floattostr(length(s2)/j));
end;

Огромная куча ифов, но это самый быстрый и рациональный способ который я придумал. Единственный недочёт, который я вижу, так это с тегом script. Потому что его надо удалять с внутренностями. Если кто-нибудь допишет, буду признателен


Время: 09:24