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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 17.10.2016, 18:37   #1
brownb
Форумчанин
 
Регистрация: 16.10.2016
Сообщений: 156
По умолчанию Добавить url

Пытаюсь спарсить все юрл со страницы
Код:
function Parse(const tag1, tag2, source: string): TStrings;
var
 p, p2, len: Integer;
begin
 Result := nil;
 p := Pos(tag1, source);
 len := Length(tag1);
 p2 := PosEx(tag2, source, p + len + 1);
 if (p = 0) or (p2 = 0) then
    Exit;
 Result := TStringList.Create;
 while (p > 0) and (p2 > 0) do
  begin
     if p2 > p then
       Result.Add(Copy(source, p + len, p2 - p - len));
     p := PosEx(tag1, source, p2);
     p2 := PosEx(tag2, source, p + len + 1);
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url: String;
  I: Integer;
begin
for I := 0 to Memo1.Lines.Count - 1 do
 begin
     try url := IdHTTP1.Get(Memo1.Lines[I]);
    EXCEPT on E: Exception do if e.Message<>'' then end;
 strings := Parse('<a href="', '"',url);
 if strings <> nil then
  begin
    Memo2.Lines.AddStrings(strings);
    strings.Free;
  end;
end;
end;
как все работает,но вот проблема,как добавить юрл сайта а потом уже спареснные юрл то есть
site.ru/registration.php
Memo2.Lines.AddStrings(strings+Pars e(url)); - пробую так ругается(
brownb вне форума Ответить с цитированием
Старый 19.10.2016, 11:50   #2
Igor[Игорь]
Пользователь
 
Аватар для Igor[Игорь]
 
Регистрация: 25.11.2011
Сообщений: 52
По умолчанию

Не совсем понятно, но вот.
Код:
form1.Memo1.Lines.Add('site.ru/registration.php');
form1.Memo1.Lines.AddStrings(strings);
e-mail: igor23dec@yandex.ru , ICQ: 2168364 , Telegram: @IgorVN
Delphi, PHP
Примеры http://igorvn.ucoz.ru/
Igor[Игорь] вне форума Ответить с цитированием
Старый 19.10.2016, 18:50   #3
brownb
Форумчанин
 
Регистрация: 16.10.2016
Сообщений: 156
По умолчанию

Смотрите ссылки парсит,только вот получается вот такой список
/index.php
/blog.php
/
/
index2.php

А надо чтоб добавлялось имя сайта в строку тоесть
site/index.php
site/blog.php
site/
site/
siteindex2.php
brownb вне форума Ответить с цитированием
Старый 19.10.2016, 19:24   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

так?

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url: String;
  i, j: Integer;
begin
for i := 0 to Memo1.Lines.Count - 1 do
 begin
     try url := IdHTTP1.Get(Memo1.Lines[i]);
    EXCEPT on E: Exception do if e.Message<>'' then end;
 strings := Parse('<a href="', '"',url);
 if strings <> nil then
  begin
    for j:=0 to strings.Count-1 do
       if pos('/',strings.strings[i])=1 then strings.strings[i] := 'site.ru'+strings.strings[i];
    Memo2.Lines.AddStrings(strings);
    strings.Free;
  end;
end;
Serge_Bliznykov вне форума Ответить с цитированием
Старый 19.10.2016, 19:57   #5
brownb
Форумчанин
 
Регистрация: 16.10.2016
Сообщений: 156
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
так?

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url: String;
  i, j: Integer;
begin
for i := 0 to Memo1.Lines.Count - 1 do
 begin
     try url := IdHTTP1.Get(Memo1.Lines[i]);
    EXCEPT on E: Exception do if e.Message<>'' then end;
 strings := Parse('<a href="', '"',url);
 if strings <> nil then
  begin
    for j:=0 to strings.Count-1 do
       if pos('/',strings.strings[i])=1 then strings.strings[i] := 'site.ru'+strings.strings[i];
    Memo2.Lines.AddStrings(strings);
    strings.Free;
  end;
end;
site.ru/
/
/login.php
/users/index.php?act=online
registration.php

А должно
site.ru/
site.ru/
site.ru/login.php
site.ru/users/index.php?act=online
site.ru/registration.php

site.ru - берется из Memo1.Lines[i]
brownb вне форума Ответить с цитированием
Старый 19.10.2016, 22:27   #6
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

ну опечатался я, вместо j случайно написал i

исправьте цикл на такой:
Код:
for j:=0 to strings.Count-1 do
       if pos('/',strings.strings[j])=1 then strings.strings[j] := Memo1.Lines[i]+strings.strings[j]
       else strings.strings[j] := Memo1.Lines[i]+'/'+strings.strings[j]
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.10.2016, 10:07   #7
brownb
Форумчанин
 
Регистрация: 16.10.2016
Сообщений: 156
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
ну опечатался я, вместо j случайно написал i

исправьте цикл на такой:
Код:
for j:=0 to strings.Count-1 do
       if pos('/',strings.strings[j])=1 then strings.strings[j] := Memo1.Lines[i]+strings.strings[j]
       else strings.strings[j] := Memo1.Lines[i]+'/'+strings.strings[j]
Огромное спасибо!Можно еще вопрос?
Все как бы работает только вот бывает что получается вот так
site.ru/login.php/login.php
site.ru/login.php/users/index.php?act=online
site.ru/login.php/registration.php

То есть изначально ссылка в мемо была такая site.ru/login.php.Как сначала убрать /login.php а потом уже "склеивать"
brownb вне форума Ответить с цитированием
Старый 20.10.2016, 10:29   #8
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

если правильно понял, попробуйте такой код:

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url, siteName: String;
  i, j: Integer;
begin
  for i := 0 to Memo1.Lines.Count - 1 do begin
    try 
      url := IdHTTP1.Get(Memo1.Lines[i]);
      EXCEPT on E: Exception do if e.Message<>'' then 
    end;
    strings := Parse('<a href="', '"',url);
    if strings <> nil then begin

       siteName := Memo1.Lines[i];
       if Pos('/', siteName )>1 then siteName := copy( siteName, 1, Pos('/', siteName )-1);

       for j:=0 to strings.Count-1 do
         if pos('/',strings.strings[j])=1 then strings.strings[j] := siteName+strings.strings[j]
         else strings.strings[j] := siteName+'/'+strings.strings[j]

       Memo2.Lines.AddStrings(strings);
       strings.Free;
    end;
  end;
end;
Serge_Bliznykov вне форума Ответить с цитированием
Старый 20.10.2016, 10:49   #9
brownb
Форумчанин
 
Регистрация: 16.10.2016
Сообщений: 156
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
если правильно понял, попробуйте такой код:

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url, siteName: String;
  i, j: Integer;
begin
  for i := 0 to Memo1.Lines.Count - 1 do begin
    try 
      url := IdHTTP1.Get(Memo1.Lines[i]);
      EXCEPT on E: Exception do if e.Message<>'' then 
    end;
    strings := Parse('<a href="', '"',url);
    if strings <> nil then begin

       siteName := Memo1.Lines[i];
       if Pos('/', siteName )>1 then siteName := copy( siteName, 1, Pos('/', siteName )-1);

       for j:=0 to strings.Count-1 do
         if pos('/',strings.strings[j])=1 then strings.strings[j] := siteName+strings.strings[j]
         else strings.strings[j] := siteName+'/'+strings.strings[j]

       Memo2.Lines.AddStrings(strings);
       strings.Free;
    end;
  end;
end;
http:/
http:/http://mobimeet.kz/login.php
http:/http://mobimeet.kz/registration.php
http:/http://mobimeet.kz/mobimeetkz.php
http:/http://mobimeet.kz/users/index.php?act=online
http:/registration.php
http:/users/skl.php?continue
http:/http://mobimeet.kz
http:/http://mobimeet.kz/users/index.php?act=online
http:/http://top.mail.ru/jump?from=2658849

Чтото я не понял ) что поизошло

Код:
function Parse(const tag1, tag2, source: string): TStrings;
var
 p, p2, len: Integer;
begin
 Result := nil;
 p := Pos(tag1, source);
 len := Length(tag1);
 p2 := PosEx(tag2, source, p + len + 1);
 if (p = 0) or (p2 = 0) then
    Exit;
 Result := TStringList.Create;
 while (p > 0) and (p2 > 0) do
  begin
     if p2 > p then
       Result.Add(Copy(source, p + len, p2 - p - len));
     p := PosEx(tag1, source, p2);
     p2 := PosEx(tag2, source, p + len + 1);
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url, siteName: String;
  I: Integer;
  j: Integer;
begin
for I := 0 to Memo1.Lines.Count - 1 do
 begin
     try url := IdHTTP1.Get(Memo1.Lines[I]);
    EXCEPT on E: Exception do if e.Message<>'' then end;
 strings := Parse('<a href="', '"',url);
 if strings <> nil then
  begin
 siteName := Memo1.Lines[i];
       if Pos('/', siteName )>1 then siteName := copy( siteName, 1, Pos('/', siteName )-1);

       for j:=0 to strings.Count-1 do
         if pos('/',strings.strings[j])=1 then strings.strings[j] := siteName+strings.strings[j]
         else strings.strings[j] := siteName+'/'+strings.strings[j];

       Memo2.Lines.AddStrings(strings);
       strings.Free;
  end;
end;
end;
brownb вне форума Ответить с цитированием
Старый 20.10.2016, 11:25   #10
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Чтото я не понял ) что поизошло
ничего страшного.
Вы "забыли" упомянуть, что у вас в начале название протокола Http://
я понадеялся, что у Вас в названии в начале нет //
поэтому код работает неверно (впрочем, он работает так, как ему приказано - он отрезает всё, что после первой / )


пробуйте такую модификацию:
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  strings: TStrings;
  url, siteName: String;
  i, j, k: Integer;
begin
  for i := 0 to Memo1.Lines.Count - 1 do begin
    try 
      url := IdHTTP1.Get(Memo1.Lines[i]);
      EXCEPT on E: Exception do if e.Message<>'' then 
    end;
    strings := Parse('<a href="', '"',url);
    if strings <> nil then begin

       siteName := Memo1.Lines[i];
       if Pos('/', siteName )>1 then begin
          j:=Pos('://', siteName);
          if j=0 then siteName := copy( siteName, 1, Pos('/', siteName )-1)
          else begin
              k := Pos('/', Copy(siteName, j+3, Length(siteName) ));
              if k>0 then siteName := copy( siteName, 1, k+j+1)
          end;
       end;

       for j:=0 to strings.Count-1 do
         if pos('/',strings.strings[j])=1 then strings.strings[j] := siteName+strings.strings[j]
         else strings.strings[j] := siteName+'/'+strings.strings[j]

       Memo2.Lines.AddStrings(strings);
       strings.Free;
    end;
  end;
end;

и поймите, чем тщательнее вы будете скрывать, что у Вас в исходных строках, тем больше шансов получить не то, что Вы ожидаете!

Последний раз редактировалось Serge_Bliznykov; 20.10.2016 в 11:41.
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
в Windows 7 добавить по умолчанию размирение .url в Opera 10??? lamak Помощь студентам 2 02.11.2009 21:46