Переписать функцию

[brownb]

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,RegExpr,Urlmon, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    function duble(const line: string):boolean;
    procedure pars(url:string);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  host:string; q:integer;
implementation

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var str:string;
begin
str:=edit1.text;
if str[length(str)]='/' then
setlength(str,length(str)-1);
host:=str;
pars(edit1.text);
end;

function TForm1.duble(const line: string):boolean;
var i:integer;
begin
for i:=0 to memo1.Lines.Count-1 do
  if memo1.Lines[i]= line then begin
  result:=true; break; end else result:=false;
end;

procedure TForm1.pars(url: string);
var list:Tstringlist;
reg:TRegExpr;
begin
inc(q);
URLDownloadToFile(nil,Pchar(url),pchar('index'+inttostr(q)+'.html'),0,nil);
list:=Tstringlist.Create;
reg:=TRegExpr.Create;
if FileExists('index'+inttostr(q)+'.html') then
list.LoadFromFile('index'+inttostr(q)+'.html') else exit;

reg.Expression:='[a][\s]{1,}(href=")([^"]+)';
if reg.Exec(list.Text) then
Repeat
  if (reg.Match[2]<>'#')and(not duble(reg.Match[2])) then begin
  memo1.Lines.Add(reg.Match[2]);
  Application.ProcessMessages;
  label1.Caption:=inttostr(memo1.Lines.Count+1);
      if reg.Match[2][1]='/' then
          pars(host+reg.Match[2])
      else if copy(reg.Match[2],1,4)='http' then
          pars(reg.Match[2])
      else
          pars(host+'/'+reg.Match[2]);
      end;
 Until not reg.ExecNext else ShowMessage('Г*ГҐГ*');

//DeleteFile('index'+inttostr(q)+'.html');
list.Free;
reg.Free;

end;
initialization
q:=0;
end.

Все работает,только вот допустим собираю ссылки с одного сайта(собрал),потом пишу другой он собирает и с первого и со второго сайта.Т.е напишу третий будет собирать и с первого и со второго и третьего.В чем проблема?

[kropotkina-alice]

А чистить Мемо перед заданием следующего сайта Пушкин будет?

[brownb]

Сообщение от kropotkina-alice

А чистить Мемо перед заданием следующего сайта Пушкин будет?

Можно еще вопрос?)))Как сделать чтоб она ссылки из "вне" не парсила? а то там и маил ру начинает сканить и тд

[kropotkina-alice]

Определите критерий отбора ссылок.
Если вы хотите собирать только "родные" ссылки, то производите сравнение полученной ссылки с адресом сайта и берите только те, которые начинаются с заданного вами домена...

[brownb]

Сообщение от kropotkina-alice

Определите критерий отбора ссылок.
Если вы хотите собирать только "родные" ссылки, то производите сравнение полученной ссылки с адресом сайта и берите только те, которые начинаются с заданного вами домена...

А можно кодом?)

[kropotkina-alice]

Ну, вообще-то у вас и так анализируются хосты, в обязательном порядке включающие вашу переменную host.
Так что я что-то не понимаю, как у вас могут попадать в результаты такие адреса, как mail.ru...
Хотя... если только вот тут:

else if copy(reg.Match[2],1,4)='http' then
          pars(reg.Match[2])

Тогда измените на что-то вроде:

else if ((copy(reg.Match[2],1,4)='http') and (Pos(host, reg.Match[2])>0)) then
          pars(reg.Match[2])

[brownb]

Сообщение от kropotkina-alice

Ну, вообще-то у вас и так анализируются хосты, в обязательном порядке включающие вашу переменную host.
Так что я что-то не понимаю, как у вас могут попадать в результаты такие адреса, как mail.ru...
Хотя... если только вот тут:

else if copy(reg.Match[2],1,4)='http' then
          pars(reg.Match[2])

Тогда измените на что-то вроде:

else if ((copy(reg.Match[2],1,4)='http') and (Pos(host, reg.Match[2])>0)) then
          pars(reg.Match[2])

[dcc32 Error] Unit1.pas(68): E2251 Ambiguous overloaded call to 'Pos'
System.pas(30215): Related method: function Pos(const WideString; const WideString; Integer): Integer;
System.pas(30055): Related method: function Pos(const string; const string; Integer): Integer;

[brownb]

помогите плз

[Kotofff]

Какую версию Delphi используете ?
Просто эта ваша ошибка компиляции возникла из-за этого ...

[Аватар]

В pos еще 3-ий параметр есть в современном делфи