Simple Lector de Noticias RSS en Delphi

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xmldom, XMLIntf, ComCtrls, msxmldom, XMLDoc, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    XMLDocument1: TXMLDocument;
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
 DateTimeConversion;

{$R *.dfm}

//Reemplaza todas las Entidades HTML por su equivalente
//Funcion Original en LibXmlParser por Stefan Heymann
//www.destructor.de | stefan@destructor.de
PROCEDURE ReplaceCharacterEntities (VAR Str : STRING);
VAR
  Start  : INTEGER;
  PAmp   : PChar;
  PSemi  : PChar;
  PosAmp : INTEGER;
  Len    : INTEGER;
BEGIN
  IF Str = '' THEN EXIT;
  Start := 1;
  Str := StringReplace(Str,#$A,'',[rfReplaceAll, rfIgnoreCase]);
  Str := StringReplace(Str,#9,'',[rfReplaceAll, rfIgnoreCase]);
  REPEAT
    PAmp := StrPos (PChar (Str) + Start-1, '&#');
    IF PAmp = NIL THEN BREAK;
    PSemi := StrScan (PAmp+2, ';');
    IF PSemi = NIL THEN BREAK;
    PosAmp := PAmp - PChar (Str) + 1;
    Len    := PSemi-PAmp+1;
    IF CompareText (Str [PosAmp+2], 'x') = 0
      THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0))
      ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32));
    Delete (Str, PosAmp+1, Len-1);
    Start := PosAmp + 1;
  UNTIL FALSE;
END;

//Extrae unicamente el Texto del HTML si es que lo tiene
FUNCTION TextFromHTML(s: string):string;
var
  IsText: Boolean;
  i: Integer;
begin
  result := '';
  IsText := true;

  for i := 1 to Length(s) do begin
    if s[i] = '<' then IsText := false;
    if IsText then result := result + s[i];
    if s[i] = '>' then IsText := true;
  end;

  Result := StringReplace(Result, '&quot;', '"',  [rfReplaceAll]);
  Result := StringReplace(Result, '&apos;', '''', [rfReplaceAll]);
  Result := StringReplace(Result, '&gt;',   '>',  [rfReplaceAll]);
  Result := StringReplace(Result, '&lt;',   '<',  [rfReplaceAll]);
  Result := StringReplace(Result, '&amp;',  '&',  [rfReplaceAll]);
  Result := StringReplace(Result, '&nbsp;',  ' ',  [rfReplaceAll]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   StartItemNode : IXMLNode;
   NodoXML : IXMLNode;
   sPost, sFecha, sDescripcion: String;
begin

ListView1.Clear;
XMLDocument1.FileName := Edit1.Text;

try
  XMLDocument1.Active := True;
  NodoXML := XMLDocument1.DocumentElement.ChildNodes.FindNode('channel');
  Form1.Caption := 'Simple lector RSS - Viendo a '+NodoXML.ChildNodes['title'].Text;
  StartItemNode := XMLDocument1.DocumentElement.ChildNodes.First.ChildNodes.FindNode('item');
  NodoXML := StartItemNode;
  repeat
  sPost := NodoXML.ChildNodes['title'].Text;
  sFecha := NodoXML.ChildNodes['pubDate'].Text;
  sFecha := DateTimeToStr(RFC822toDateTime(sFecha));
  sDescripcion := NodoXML.ChildNodes['description'].Text;

  with ListView1.Items.Add do
  Begin
  Caption := sPost;
  ReplaceCharacterEntities(sDescripcion);
  SubItems.Add(sFecha);
  SubItems.Add(TextFromHTML(sDescripcion));
  End;
  NodoXML := NodoXML.NextSibling;
  until NodoXML = nil;

except
    on E: EDOMParseError do
    ShowMessage('Ocurrio un Error al Leer RSS');
    on E: Exception do
    ShowMessage('Error!');
end;


end;
end.