Показать сообщение отдельно
  #4  
Старый 03.05.2011, 11:00
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

процедура GetRSSLinks возвращает в AStrings все ленты для URL:
Код:
uses
  msxml,
  ComObj,

procedure GetRSSLinks(URL: String; AStrings: TStrings);
var
  XMLHTTP: IXMLHttpRequest;
  response: String;
  i: Integer;
  s: String;
begin
  AStrings.Clear;
  XMLHTTP:=CreateOleObject('Microsoft.XMLHTTP') as IXMLHttpRequest;
  try
    XMLHTTP.open('GET', URL, False, '', '');
    XMLHTTP.send('');
    if XMLHTTP.status=200 then
    begin
      response:=XMLHTTP.responseText;
      i:=Pos('<link', response);
      while i>0 do
      begin
        s:=Copy(response, i, Length(response));
        response:=Copy(response, i+5, Length(response));
        i:=Pos('>', s);
        if i>0 then
        begin
          s:=Copy(s, 1, i);
          if Pos('application/rss+xml', s)>0 then
          begin
            i:=Pos('href="', s);
            if i>0 then
            begin
              s:=Copy(s, i+6, Length(s));
              i:=Pos('"', s);
              if i>0 then AStrings.Add(Copy(s, 1, i-1));
            end;
          end;
        end;
        i:=Pos('<link', response);
      end;
    end;
  finally
    XMLHTTP:=nil;
  end;
end;

использование:

Код:
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetRSSLinks('http://www.delphisources.ru/forum/', Memo1.Lines);
//  GetRSSLinks('http://www.nwcod.com/', Memo1.Lines);
end;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием