Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Вытащить URL из текста, Регулярные выражения 
:(
    Опции темы
Terikon
Дата 30.6.2009, 16:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет
Из текста нужно выдернуть url, получается вытащить только http://www.sait/

Нужно привести к виду:
http://www.sait/1906467326/texlive-module-...c-2008.tar.lzma
http://www.sait/1906467227/otp_doc_man_R13B01.tar.gz

-2.6.0.tar.gz","http://www.sait.com/del/
f5f9f3b0b1a4d658b58019c2fe01f9a0.html","1026186","2009-06-30 03:43:05","0000-00-00 00:00:00","0""texlive-module-amscls.doc-2008.tar.lzma","http://www.sait/1906467326/texlive-module-amscls.doc-2008.tar.lzma","http://www.sait.com/del/1b3b2132bd38807dc67b35a962e73eeb.html","1003129","2009-06-30 03:47:20","0000-00-00 00:00:00","0"
"otp_doc_man_R13B01.tar.gz","http://www.sait/1906467227/otp_doc_man_R13B01.tar.gz","http://www.sait.com/del/3f70b64dd1094ee8080c309a073b8c4d.html","968114","2009-06-30 03:43:05","0000-00-00 00:00:00","0"




Код

procedure TForm1.Button1Click(Sender: TObject);
var
   RegExp: TRegExpr;
  s: string;

begin
  
  s:=Memo1.Text;

  RegExp := TRegExpr.Create;

  try
 
    RegExp.Expression := 'http://www.sait/';
    
    if RegExp.Exec(s) then
    
    begin
      Memo2.Text:=RegExp.Match[0];

      repeat
    
        Memo2.Text:=RegExp.Match[0];
      
      until not RegExp.ExecNext;
    end
    else
   
      ShowMessage ('Error');
  finally
    RegExp.Free;
  end;

  end;

end.


Это сообщение отредактировал(а) Terikon - 30.6.2009, 16:17
PM MAIL   Вверх
Keeper89
Дата 30.6.2009, 17:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58
А если:
Код

RegExp.Expression := '"http://www.sait/.*"';

?

Это сообщение отредактировал(а) Keeper89 - 30.6.2009, 17:07


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Terikon
Дата 30.6.2009, 17:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет
пробывал уже так, некатит
PM MAIL   Вверх
Keeper89
Дата 30.6.2009, 17:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58
Вот так катит:
Код

RegExp.Expression := 'http://www.sait/[^\n"]*';


Это сообщение отредактировал(а) Keeper89 - 30.6.2009, 17:27


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Terikon
Дата 30.6.2009, 17:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет
Спасибо огромное теперькатит) только вот ещё вопрос, у меня в мемо2 добавляется только одна строка, хотя в тексте их оч много
PM MAIL   Вверх
Keeper89
Дата 30.6.2009, 17:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58
Я у себя когда пробовал исправил smile Почитай про свойства Text и Lines у Memo.
Код

procedure TForm1.Button1Click(Sender: TObject);
var
   RegExp: TRegExpr;
  s: string;
begin
  s := Memo1.Text;
  RegExp := TRegExpr.Create;
  try
    RegExp.Expression := 'http://www.sait/[^\n"]*';
    Memo2.Clear;
    if RegExp.Exec(s) then
    begin
      Memo2.Clear;
      repeat
        Memo2.Lines.Add(RegExp.Match[0]);
      until not RegExp.ExecNext;
    end
    else
      ShowMessage ('Error');
  finally
    RegExp.Free;
  end;
end;


Это сообщение отредактировал(а) Keeper89 - 30.6.2009, 17:36


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Terikon
Дата 30.6.2009, 17:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет
как можно  ещё отсееть http://www.sait.com/del/1b3b2132bd38807dc6...a962e73eeb.html
т.е. ссылки с расширением html
PM MAIL   Вверх
Keeper89
Дата 30.6.2009, 19:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58
Сделал с использованием второго регэкспа (возможно есть решение поэлегантнее):
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  RegExp, RegExp2: TRegExpr;
  s: AnsiString;
begin
  s := Memo1.Text;
  showmessage(s);
  RegExp := TRegExpr.Create;
  RegExp2 := TRegExpr.Create;
  try
    RegExp.Expression := 'http://www.sait.com/[^"]*';
    RegExp2.Expression := '\S*\.(html|htm)$';
    Memo2.Clear;
    if RegExp.Exec(s) then
    begin
      Memo2.Clear;
      repeat
        if Not RegExp2.Exec(RegExp.Match[0]) then
          Memo2.Lines.Add(RegExp.Match[0]);
      until not RegExp.ExecNext;
    end
    else
      ShowMessage ('Not Found!');
  finally
    RegExp.Free;
    RegExp2.Free;
  end;
end;

Для текста
Цитата

f5f9f3b0b1a4d658b58019c2fe01f9a0.html","1026186","2009-06-30 03:43:05","0000-00-00 
00:00:00","0""texlive-module-amscls.doc-2008.tar.lzma",
"http://www.sait.com/1906467326/texlive-module-amscls.doc-2008.tar.lzma",
"http://www.sait.com/del/1b3b2132bd38807dc67b35a962e73eeb.html","1003129","2009-06-30 03:47:20",
"0000-00-00 00:00:00","0" 
"otp_doc_man_R13B01.tar.gz",
"http://www.sait.com/1906467227/otp_doc_man_R13B01.tar.gz",
"http://www.sait.com/del/3f70b64dd1094ee8080c309a073b8c4d.html","968114","2009-06-30 03:43:05","0000-00-00 00:00:00","0"

работает отлично.

Это сообщение отредактировал(а) Keeper89 - 30.6.2009, 19:24


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Terikon
Дата 30.6.2009, 19:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет
Благадарю, всё работает отлично!!
Прикрутил прогресс бар, вот хачу спросить,  получается так что полоса прогрес бара доходит до конца, а  строки всё ещё добавляются в Мемо2, или так и должно быть, раньше ево использовал при копировании файлов было всё синхронно.
Вот сюда ево ставлю

Код

if Not RegExp2.Exec(RegExp.Match[0]) then
        Memo2.Lines.Add(RegExp.Match[0]);
        ProgressBar1.Position:=ProgressBar1.Position+1;
              until not RegExp.ExecNext;
PM MAIL   Вверх
Keeper89
Дата 30.6.2009, 20:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58
Проблема в том, что неизвестно сколько выражений будет найдено, т.к. как в данном случае они ищутся в цикле repeat...until. Поэтому эмулировать это можно как-то так:
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  RegExp, RegExp2: TRegExpr;
  s: AnsiString;
begin
  s := Memo1.Text;
  RegExp := TRegExpr.Create;
  RegExp2 := TRegExpr.Create;
  ProgressBar1.Position := 0;
  try
    RegExp.Expression := 'http://www.sait.com/[^"]*';
    RegExp2.Expression := '\S*\.(html|htm)$';
    Memo2.Clear;
    if RegExp.Exec(s) then
    begin
      ProgressBar1.Max := 1;
      Memo2.Clear;
      repeat
        if Not RegExp2.Exec(RegExp.Match[0]) then
        begin
          Memo2.Lines.Add(RegExp.Match[0]);
          ProgressBar1.Max := ProgressBar1.Max + 1;
          ProgressBar1.Position := ProgressBar1.Position + 1;
        end;
      until not RegExp.ExecNext;
      ProgressBar1.Position := ProgressBar1.Max;
    end
    else
      ShowMessage ('Not Found!');
  finally
    RegExp.Free;
    RegExp2.Free;
  end;
end;


P.S. Прочитай справку по RegExp, там есть все ответы на поставленные вопросы.
P.S.2 1 тема - 1 вопрос.
P.S.3. Хотя бы старайся писать по-русски.


--------------------
Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image
PM MAIL WWW   Вверх
Akella
Дата 1.7.2009, 16:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329
Цитата(Terikon @  30.6.2009,  16:14 Найти цитируемый пост)
Из текста нужно выдернуть url

На том сайте есть готовый пример-экзешник.

Добавлено через 1 минуту и 37 секунд
Цитата(Terikon @  30.6.2009,  19:48 Найти цитируемый пост)
полоса прогрес бара доходит до конца, а  строки всё ещё добавляются 

Не ставь PB, покажи пользователю какую-нибудь анимацию.
PM MAIL   Вверх
Terikon
Дата 1.7.2009, 20:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет
Всем спасибо, очень выручили!!!
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0556 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.