ANTICHAT — форум по информационной безопасности, OSINT и технологиям
ANTICHAT — русскоязычное сообщество по безопасности, OSINT и программированию.
Форум ранее работал на доменах antichat.ru, antichat.com и antichat.club,
и теперь снова доступен на новом адресе —
forum.antichat.xyz.
Форум восстановлен и продолжает развитие: доступны архивные темы, добавляются новые обсуждения и материалы.
⚠️ Старые аккаунты восстановить невозможно — необходимо зарегистрироваться заново.

15.02.2010, 15:40
|
|
Участник форума
Регистрация: 25.11.2009
Сообщений: 201
Провел на форуме: 866555
Репутация:
226
|
|
текст страницы
Сейчас передо мной стоит такая задача: надо определить ~"равны" ли две 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(' ',s)<>0 do
s:=copy(s,1,pos(' ',s)-1)+copy(s,pos(' ',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(' ',s)<>0 do
s:=copy(s,1,pos(' ',s)-1)+copy(s,pos(' ',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. Потому что его надо удалять с внутренностями. Если кто-нибудь допишет, буду признателен
|
|
|
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|