Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Вытащить URL из текста

Автор: Terikon 30.6.2009, 16:14

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

Нужно привести к виду:
http://www.sait/1906467326/texlive-module-amscls.doc-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.

Автор: Keeper89 30.6.2009, 17:06

А если:

Код


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

Автор: Terikon 30.6.2009, 17:19

пробывал уже так, некатит

Автор: Keeper89 30.6.2009, 17:26

Вот так катит:

Код


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

Автор: Terikon 30.6.2009, 17:32

Спасибо огромное теперькатит) только вот ещё вопрос, у меня в мемо2 добавляется только одна строка, хотя в тексте их оч много

Автор: Keeper89 30.6.2009, 17:35

Я у себя когда пробовал исправил 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;

Автор: Terikon 30.6.2009, 17:43

как можно ещё отсееть http://www.sait.com/del/1b3b2132bd38807dc67b35a962e73eeb.html
т.е. ссылки с расширением html

Автор: Keeper89 30.6.2009, 19:22

Сделал с использованием второго регэкспа (возможно есть решение поэлегантнее):

Код


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"

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

Автор: Terikon 30.6.2009, 19:48

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

Код


if Not RegExp2.Exec(RegExp.Match[0]) then
        Memo2.Lines.Add(RegExp.Match[0]);
        ProgressBar1.Position:=ProgressBar1.Position+1;
              until not RegExp.ExecNext;

Автор: Keeper89 30.6.2009, 20:16

Проблема в том, что неизвестно сколько выражений будет найдено, т.к. как в данном случае они ищутся в цикле 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. Хотя бы старайся писать по-русски.

Автор: Akella 1.7.2009, 16:53

Цитата(Terikon @ 30.6.2009, 16:14

)

Из текста нужно выдернуть url

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

Добавлено через 1 минуту и 37 секунд

Цитата(Terikon @ 30.6.2009, 19:48

)

полоса прогрес бара доходит до конца, а строки всё ещё добавляются

Не ставь PB, покажи пользователю какую-нибудь анимацию.

Автор: Terikon 1.7.2009, 20:57

Всем спасибо, очень выручили!!!