unit Feed;

interface

Uses
	xmldom, XMLIntf, msxmldom, XMLDoc, ExtCtrls, Variants;

Type
	TItem = record
		Title,
		Link,
		Description,
		Category,
		pubDate,
		Author: String;
	end;
	TChannel = record
		FeedType,
		Title,
		Link,
		Description,
		Language,
		pubDate,
		Author: String;
	end;
	TFeedRec = record
		Channel: TChannel;
		Item: array of TItem;
	end;
	TOnError = Procedure(Sender: TObject; ErrorCode: Integer; ErrorDes: String) of object;
	TFeed = class(TObject)
	private
		Error: boolean;
		FOnError: TOnError;
    NumItems: Byte;
    fURL: String;
    UpTimer, ReTimer: TTimer;
		Procedure LoadRSS1(AnXMLNode: IXMLNode);   
		Procedure LoadRSS2(AnXMLNode: IXMLNode);
		Procedure LoadATOM(AnXMLNode: IXMLNode);
		Procedure LoadChannel(AnXMLNode: IXMLNode);
		Procedure LoadItem(AnXMLNode: IXMLNode; var Item: TItem);   
		Procedure LoadEntry(AnXMLNode: IXMLNode; var Item: TItem);
    Procedure ClearRec;          
		Procedure OnTimer(Sender: TObject); virtual;
    Procedure Retry(Sender: TObject); virtual;
		Procedure _OnError(Sender: TObject; ErrorCode: integer);
		procedure SetOnError(const Value: TOnError);
    procedure ReadFeed;
    function DownloadAndResolve: Boolean;
		function GETCOUNT: cardinal;
	public
		FeedRec: TFeedRec;     
		Constructor Create(Num: Byte; URL: String); Overload;
		Constructor Create(Num, Update: Byte; URL: String); Overload;
		Destructor Destroy; override;
		Property OnError: TOnError read FOnError write SetOnError;
		Property Count: cardinal read GETCOUNT;
	end;

implementation

Uses
	Forms, SysUtils, lplDownload;

{ TFeed }

Constructor TFeed.Create(Num: Byte; URL: String);
begin
	NumItems := Num;
  fURL := URL;

  ReadFeed;
end;

Constructor TFeed.Create(Num, Update: Byte; URL: String);
begin
	NumItems := Num;
  fURL := URL;

  UpTimer := TTimer.Create(nil);
  UpTimer.Interval := Update * 60000;
  UpTimer.OnTimer := OnTimer;
  
  if Not DownloadAndResolve then
  begin
		ReTimer := TTimer.Create(nil);
		ReTimer.Interval := 60 * 1000;
		ReTimer.OnTimer := Retry;
  end;
end;

procedure TFeed.OnTimer(Sender: TObject);
begin
  if Not DownloadAndResolve then
  begin
		ReTimer := TTimer.Create(nil);
		ReTimer.Interval := 60 * 1000;
		ReTimer.OnTimer := Retry;
  end;
end;

procedure TFeed.Retry(Sender: TObject);
begin
  FreeAndNil(ReTimer);

  DownloadAndResolve;
end;

function TFeed.DownloadAndResolve: Boolean;
var
	DL: TlplDownload;
begin
	Result := true;
	Error := false;
	DL := TlplDownload.Create(nil);
	DL.Agent := 'TFeed';
	DL.AllowRedirect := true;
	dl.Filename := 'feed.xml';
	dl.URL := fURL;
	dl.OnError := _OnError;
	dl.DownloadFile;
	If Error then
	begin
		Result := False;
		dl.Free;
		exit;
	end;
	If not FileExists('feed.xml') then
	begin
		Result := false;
		dl.Free;
		exit;
	end;

  fURL := 'feed.xml';
  ReadFeed;

	DL.Free;
	DeleteFile('feed.xml');
end;

Procedure TFeed.ReadFeed;
var
	Form: TForm;
	XML: TXMLDocument;
	i: Integer;
begin
	Form := TForm.Create(nil);
	XML := TXMLDocument.Create(form);
  XML.LoadFromFile(fURL);
	XML.Active := true;
  ClearRec;
	For i := 0 to XML.ChildNodes.Count - 1 do
	begin
		if xml.ChildNodes[i].NodeName = 'rdf:RDF' then
			LoadRSS1(xml.ChildNodes[i])
		else if (xml.ChildNodes[i].NodeName = 'rss') and (xml.ChildNodes[i].HasAttribute('version')) then
			LoadRSS2(xml.ChildNodes[i].ChildNodes.First)
		else if xml.ChildNodes[i].NodeName = 'feed' then
			LoadATOM(xml.ChildNodes[i]);
	end;
	XML.Active := false;
	XML.Free;
	Form.Free;
end;

destructor TFeed.Destroy;
begin
	inherited;
  if Assigned(UpTimer) then
    UpTimer.Free;
end;

procedure TFeed.LoadRSS1(AnXMLNode: IXMLNode);
var
  i, num: Integer;
begin
  FeedRec.Channel.FeedType := 'RSS1';
  LoadChannel(AnXMLNode.ChildNodes.First);
  num := 0;
	for i := 0 to AnXMLNode.ChildNodes.Count -1 do
	begin
		if AnXMLNode.ChildNodes[i].NodeName = 'item' then
    begin
      Inc(num);
      SetLength(FeedRec.Item, num);
			LoadItem(AnXMLNode.ChildNodes[i], FeedRec.Item[num -1]);
      if num = NumItems then
        break;
    end;
	end;
end;

procedure TFeed.LoadChannel(AnXMLNode: IXMLNode);
var
  i : integer;
begin
  try
    for i := 0 to AnXMLNode.ChildNodes.Count -1 do
    begin
      if AnXMLNode.ChildNodes[i].NodeName = 'title' then
        FeedRec.Channel.Title := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'link' then
        FeedRec.Channel.Link := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'description' then
        FeedRec.Channel.Description := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'language' then
        FeedRec.Channel.Language := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'pubDate' then
        FeedRec.Channel.pubDate := Trim(AnXMLNode.ChildNodes[i].NodeValue);
    end;
  except
    FeedRec.Channel.FeedType := 'Error Reading RSS1 Channel';
  end;
end;

procedure TFeed.LoadRSS2(AnXMLNode: IXMLNode);
Var
	i, num: Integer;
begin
  FeedRec.Channel.FeedType := 'RSS2';
  num := 0;
  try
    for i := 0 to AnXMLNode.ChildNodes.Count -1 do
    begin
      if AnXMLNode.ChildNodes[i].NodeName = 'item' then
      begin
        Inc(num);
        SetLength(FeedRec.Item, num);
        LoadItem(AnXMLNode.ChildNodes[i], FeedRec.Item[num -1]);
        if num = NumItems then
          break;
        Continue;
      end;
      if AnXMLNode.ChildNodes[i].NodeName = 'title' then
        FeedRec.Channel.Title := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'link' then
        FeedRec.Channel.Link := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'description' then 
        if VarType(AnXMLNode.ChildNodes[i].NodeValue) <> VarNull then
          FeedRec.Channel.Description := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'language' then
        FeedRec.Channel.Language := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if (AnXMLNode.ChildNodes[i].NodeName = 'pubDate') or (AnXMLNode.ChildNodes[i].NodeName = 'lastBuildDate') then
        FeedRec.Channel.pubDate := Trim(AnXMLNode.ChildNodes[i].NodeValue);
    end;
  except
    FeedRec.Channel.FeedType := 'Error Reading RSS2 Channel';
  end;
end;         

procedure TFeed.LoadItem(AnXMLNode: IXMLNode; var Item: TItem);
var
  i : integer;
begin
  try
    for i := 0 to AnXMLNode.ChildNodes.Count -1 do
    begin
      if AnXMLNode.ChildNodes[i].NodeName = 'title' then
        Item.Title := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'link' then
        Item.Link := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'description' then
        if VarType(AnXMLNode.ChildNodes[i].NodeValue) <> VarNull then
          Item.Description := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'category' then
        Item.Category := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if (AnXMLNode.ChildNodes[i].NodeName = 'pubDate') or (AnXMLNode.ChildNodes[i].NodeName = 'dc:date') then
        Item.pubDate := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if (AnXMLNode.ChildNodes[i].NodeName = 'dc:creator') or (AnXMLNode.ChildNodes[i].NodeName = 'author') then
        if VarType(AnXMLNode.ChildNodes[i].NodeValue) <> VarNull then
          Item.Author := Trim(AnXMLNode.ChildNodes[i].NodeValue);
    end;
  except
    FeedRec.Channel.FeedType := 'Error Reading RSS Items';
  end;
end;

procedure TFeed.LoadATOM(AnXMLNode: IXMLNode);
var
	i, num: integer;
begin
  FeedRec.Channel.FeedType := 'Atom';
  num := 0;
  try
    for i := 0 to AnXMLNode.ChildNodes.Count -1 do
    begin
      if AnXMLNode.ChildNodes[i].NodeName = 'entry' then
      begin
        Inc(num);
        SetLength(FeedRec.Item, num);
        LoadEntry(AnXMLNode.ChildNodes[i], FeedRec.Item[num -1]);
        if num = NumItems then
          break;
      end;
      if  AnXMLNode.ChildNodes[i].NodeName = 'title' then
        FeedRec.Channel.Title :=  Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if  AnXMLNode.ChildNodes[i].NodeName = 'link' then
        FeedRec.Channel.Link :=  Trim(AnXMLNode.ChildNodes[i].Attributes['href'])
      else if  AnXMLNode.ChildNodes[i].NodeName = 'div' then
        FeedRec.Channel.Description :=  Trim(AnXMLNode.ChildNodes[i].XML)
      else if AnXMLNode.ChildNodes[i].NodeName = 'updated' then
        FeedRec.Channel.pubDate :=  Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'author' then
        FeedRec.Channel.Author := Trim(AnXMLNode.ChildNodes[i].ChildValues['name']);
    end;        
  except
    FeedRec.Channel.FeedType := 'Error Reading ATOM Channel';
  end;
end;

procedure TFeed.LoadEntry(AnXMLNode: IXMLNode; var Item: TItem);
var
  i : integer;
begin
  try
    for i := 0 to AnXMLNode.ChildNodes.Count -1 do
    begin
      if AnXMLNode.ChildNodes[i].NodeName = 'title' then
        Item.Title := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'link' then
        Item.Link := Trim(AnXMLNode.ChildNodes[i].Attributes['href'])
      else if (AnXMLNode.ChildNodes[i].NodeName = 'summary') or (AnXMLNode.ChildNodes[i].NodeName = 'content') then
        Item.Description := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'category' then
        Item.Category := Trim(AnXMLNode.ChildNodes[i].Attributes['term'])
      else if AnXMLNode.ChildNodes[i].NodeName = 'updated' then
        Item.pubDate := Trim(AnXMLNode.ChildNodes[i].NodeValue)
      else if AnXMLNode.ChildNodes[i].NodeName = 'author' then
        Item.Author := Trim(AnXMLNode.ChildNodes[i].ChildValues['name']);
    end;    
  except
    FeedRec.Channel.FeedType := 'Error Reading ATOM Entry';
  end;
end;

procedure TFeed.ClearRec;
begin
  FeedRec.Channel.FeedType := '';
  FeedRec.Channel.Title := '';
  FeedRec.Channel.Link := '';
  FeedRec.Channel.Description := '';
  FeedRec.Channel.Language := '';
  FeedRec.Channel.pubDate := '';
  FeedRec.Channel.Author := '';
  SetLength(FeedRec.Item, 0);
end;

procedure TFeed._OnError(Sender: TObject; ErrorCode: integer);
begin
	If assigned(OnError) then
	begin
		OnError(Self, ErrorCode, (sender as TlplDownload).GetErrorCodeDes(ErrorCode));
	end;
	Error := true;
end;

procedure TFeed.SetOnError(const Value: TOnError);
begin
	FOnError := Value;
end;  

function TFeed.GETCOUNT: cardinal;
begin
	result := Length(FeedRec.Item);
end;

end.
