Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.10.2015, 12:32   #11
sasha0808
Новичок
Джуниор
 
Регистрация: 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.
sasha0808 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сканирование по сетке Viwwna Windows 0 03.03.2015 11:41
сканирование памяти neeble Общие вопросы Delphi 15 01.11.2011 09:47
Сканирование портов -Flasher- Работа с сетью в Delphi 5 03.08.2010 10:47
Сканирование экрана pecson Общие вопросы Delphi 5 13.12.2008 07:25