Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 01.05.2011, 19:49
hatsub hatsub вне форума
Прохожий
 
Регистрация: 12.03.2011
Сообщения: 18
Репутация: 10
По умолчанию Приверить существует ли xml-документ по url-адресу

Добрый день жители форума.
Хотелось бы сделать проверку на то, существует ли xml-лента по URL-адресу(переменная host), до того как программа выпадет в ошибку.
Помогите с реализацией. Код ниже работает, но проверки нет.
Код:
var

host:string;
XMLHTTP: Variant;
xmldomdocument: IXMLDOMDocument;
xmldomnodelist: IXMLDOMNodeList;

code:

XMLHTTP:=CreateOleObject('Microsoft .XMLHTTP');
XMLHTTP.open('GET',host, False);
XMLHTTP.send('');

if XMLHTTP.status=200 then
begin
xmldomdocument:=(IUnknown(XMLHTTP.r esponseXML) as IXMLDOMDocument);
xmldomnodelist:=xmldomdocument.getE lementsByTagName('title');
for i:=0 to 11 do
if xmldomnodelist[i].parentNode.nodeName='item'
then Listbox2.Items.Add(xmldomnodelist.i tem[i].text);
end;
Админ: Пользуемся тегами для оформления кода!

Последний раз редактировалось Admin, 02.05.2011 в 19:36.
Ответить с цитированием
  #2  
Старый 02.05.2011, 09:39
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

IXMLHTTPRequest все-равно что загружать.
Цитата:
responseXML Property

Remarks

The property is read-only. For security reasons, the parser validation features are always turned off to prevent Microsoft® XML Core Services (MSXML) from attempting to download a document type definition (DTD) or XML-Data definition. If the response entity body is not valid XML, this property returns DOMDocument that was parsed so that you can access the error. This property does not return IXMLDOMParseError itself, but it is accessible from DOMDocument.

http://msdn.microsoft.com/en-us/libr...(v=VS.85).aspx

а почему асинхронный режим не используешь?

Код:
procedure TFormMain.Get;
begin
  try
    XMLHTTP.open('GET', 'http://www.delphisources.ru/forum/external_mod.php?type=RSS2', True);
    XMLHTTP.send('');
  except
  end;
  Timer.Enabled:=True;
end;

procedure TFormMain.TimerTimer(Sender: TObject);
begin
  if XMLHTTP.readyState=4 then
  begin
    Timer.Enabled:=False;
    if XMLHTTP.status=200 then
    begin



http://data.cod.ru/99571
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 02.05.2011, 20:18
hatsub hatsub вне форума
Прохожий
 
Регистрация: 12.03.2011
Сообщения: 18
Репутация: 10
По умолчанию Так и не понял как сделать проверку

Пишу:

PHP код:
try
    
XMLHTTP:=CreateOleObject('Microsoft.XMLHTTP');
    
XMLHTTP.open('GET',hosttrue);
    
XMLHTTP.send('');
  
except
    showmessage
('Error');
  
end;

  if 
XMLHTTP.readyState=4 then
  begin
   
if XMLHTTP.status=200 then
   begin
     xmldomdocument
:=(IUnknown(XMLHTTP.responseXML) as IXMLDOMDocument);
     
xmldomnodelist:=xmldomdocument.getElementsByTagName('title');
     for 
i:=0 to xmldomnodelist.length-do
      if 
xmldomnodelist[i].parentNode.nodeName='item' then Listbox2.Items.Add(xmldomnodelist.item[i].text);
   
end
   
else showmessage('Error');
  
end

Не срабатывает, в чем проблема и каким образом все-таки реализовать проверку.
Ответить с цитированием
  #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;
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #5  
Старый 04.05.2011, 06:16
hatsub hatsub вне форума
Прохожий
 
Регистрация: 12.03.2011
Сообщения: 18
Репутация: 10
По умолчанию

Огромное спасибо
Ответить с цитированием
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 08:48.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter