05.10.2015, 12:32
|
#11
|
Новичок
Джуниор
Регистрация: 04.10.2015
Сообщений: 7
|
Почему счетчик находит все ссылки на странице а в мемо они не выводятся кроме той, которую задаешь?
В Лебеле отображается правильное количество найденных ссылок.(но опять же не на всех сайтах правильно)
Цитата:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, StdCtrls, RegExpr, XPMan;
type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
IdHTTP1: TIdHTTP;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
SaveDialog1: TSaveDialog;
Label2: TLabel;
Label3: TLabel;
procedure Linker(URL:String);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
Checked,Remain:TStringlist;
procedure TForm1.Linker(URL:String);
var
Cache,link: string;
n,i:integer;
reg: TRegExpr;
begin
Cache:=IdHttp1.Get(URL);
Checked.Add(url);
Memo1.Lines.Add(url);
reg:=TRegExpr.Create;
memo1.Clear;
n:=0;
try
reg.Expression:='<a[^>]+href=([^ >]+)';
if reg.Exec(Cache) then begin
repeat
link:=reg.Match[0];
if (ord(link[length(link)])=39) or (link[length(link)]='"')
or (link[length(link)]=' ') or (link[length(link)]='>') then
delete(link,length(link),1);
delete(link,1,pos('href=',link)+4);
if (ord(link[1])=39) or (link[1]='"')
or (link[1]=' ') or (link[1]='>') then
delete(link,1,1);
if (pos('http://',link)=0) and ((link[1]='\') or (link[1]='/')) then link:=Edit1.Text+link;
if (pos('http://',link)=0) and (link[1]<>'\') and (link[1]<>'/') and (Edit1.Text[length(edit1.text)]<>'/') then link:=Edit1.Text+'/'+link;
if (pos('mailto:',link)=0) and (pos(edit1.text,link)<>0) then
if (pos(link,checked.Text)=0) and (pos(link,remain.Text)=0) then
Remain.Add(link);
n:=n+1;
until not reg.ExecNext;
end else
Memo1.Lines.Add('не найдено');
finally
reg.Free;
end;
Label3.Caption:=IntToStr(n);
Cache:='';
if remain.Count<>0 then
for i:=0 to remain.Count-1 do
Memo1.Lines.Add(remain[i]);
//linker(remain[i]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
linker(edit1.text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Checked:=TStringList.create;
Remain:=TStringList.create;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Form1.Memo1.Lines.SaveToFile(Form1. SaveDialog1.FileName + '.');
end;
end.
|
|
|
|