
03.05.2011, 11:00
|
 |
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;
__________________
Пишу программы за еду.
__________________
|