⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uatomfeed.pas

📁 自己写的一个 RSS 阅读器
💻 PAS
字号:
unit uAtomFeed;

interface

uses Classes,uW3CDTF, FastStringFuncs,
	uRssBase, MSXML2_TLB, uConstants;

type

TAtomFeed = class(TInterfacedObject, IRSSBase)
private
  FDoc:IXMLDOMDocument2;
  FItems : IRSSItemBaseList;
  Fimage : IRSSImageBase;
  FTitle, FDescription : string;
  FVersion, FLink, FCreator : WideString;
protected
    function Get_Version : WideString;
    function Get_Title : string;
    function Get_Link: WideString;
    function Get_Description: string;
    function Get_Creator: WideString;
    function Get_Items: IRSSItemBaseList;
    function Get_Image: IRSSImageBase;
public
	constructor Create(theDoc : IXMLDOMDocument2);
  procedure SaveXml(Destination: OleVariant);
  property Items:IRSSItemBaseList read fItems write fItems;
  property Image:IRSSImageBase read FImage write FImage;
  property Version: WideString read Get_Version;
  property Title: string read Get_Title;
  property Link: Widestring read Get_Link;
  property Description: string read Get_Description;
  property Creator: WideString read Get_Creator;
end;

TAtomItems = class(TInterfacedObject, IRSSItemBaseList)
private
    fItems : TList;
    fNode:IXMLDOMNode;
protected
    procedure Add(item : TInterfacedObject);overload;
    function Add:IRSSItemBase;overload;
    procedure Delete(Index:integer);
    function Get_Item(Index: Integer): IRSSItemBase;
    function Get_ItemByGuid(guid: string): IRSSItemBase;
    function Get_Count(): integer;
    function IndexOfLink(ALink:WideString):integer;
    function IndexOfTitle(ATitle:String):integer;
public
	constructor Create(theNode:IXMLDOMNode);
end;

TAtomItem = class(TInterfacedObject, IRSSItemBase)
  private
    fNode:IXMLDOMNode;
    FAuthor: string;
    FTitle: string;
    FPubDate: TW3CDTF;
    FGuid: WideString;
    FLink: WideString;
    FDescription: string;

    FReaded:Boolean;
  protected
    function Get_Author: string;
    function Get_Title: string;
    function Get_PubDate: TW3CDTF;
    function Get_Guid: WideString;
    function Get_Link: WideString;
    function Get_Category: string;
    function Get_Creator: WideString;
    function Get_CommentCount: integer;
    function Get_CommentRss: WideString;
    function Get_CommentURL: WideString;
    function Get_Comment: WideString;
    function Get_Description: string;

    procedure Set_PubDate(Value:TW3CDTF);
    procedure Set_Title(Value:string);
    procedure Set_Link(Value:WideString);
    procedure Set_Guid(Value:Widestring);
    procedure Set_Description(Value:string);
    procedure Set_Author(Value:string);
    procedure Set_Category(Value:string);
    procedure Set_Creator(Value:Widestring);
    procedure Set_Comment(Value:Widestring);
    procedure Set_CommentCount(Value:Integer);
    procedure Set_CommentURL(Value:Widestring);
    procedure Set_CommentRSS(Value:Widestring);

    function Get_Readed:Boolean;
    procedure Set_Readed(Value:Boolean);
  public
		constructor Create(theNode : IXmlDOMNode);
  end;

  function GetAtomFeed(Doc: IXMLDomDocument2): IRSSBase;

implementation

uses SysUtils;

function GetAtomFeed(Doc: IXMLDOMDocument2): IRSSBase;
begin
  Result := TAtomFeed.Create(Doc) as IRSSBase;
end;

{ TAtomFeed }

constructor TAtomFeed.Create(theDoc: IXMLDOMDocument2);
var
	i : integer;
  channelNodes : IXMLDomNodeList;
  tmpNode, node : IXmlDomNode;
begin
  FDoc:=theDoc;
	node := FDoc.documentElement;
  fItems := TAtomItems.Create(node);
  channelNodes := node.selectNodes('entry');
  Fimage := TRSSImageBase.Create(node.selectSingleNode('image'));
  FVersion := ''; FTitle := ''; FLink := ''; FDescription := ''; FCreator := '';
  if assigned(node) then begin
  	FCreator := getNodeVal(node, 'generator');
    tmpNode := node.selectSingleNode('info');
    if Assigned(tmpNode) then FDescription := tmpNode.XML;
 		FTitle := ExtractNonHTML(getNodeVal(node, 'title'));
		FVersion := 'ATOM ' + getNodeVal(node, '@version');
    FLink := getNodeVal(node, 'link[@rel="alternate"]/@href');
  end;
  for i := 0 to channelNodes.length-1 do
    fitems.Add( TAtomItem.Create(channelNodes.item[i]) )
end;
procedure TAtomFeed.SaveXml(Destination: OleVariant);
begin
  FDoc.save(Destination);
end;

function TAtomFeed.Get_Creator: WideString; begin Result := FCreator; end;
function TAtomFeed.Get_Description: string; begin Result := FDescription; end;
function TAtomFeed.Get_Image: IRSSImageBase; begin Result := FImage; end;
function TAtomFeed.Get_Items: IRSSItemBaseList; begin Result := fItems; end;
function TAtomFeed.Get_Link: WideString; begin Result := FLink; end;
function TAtomFeed.Get_Title: string; begin Result := FTitle; end;
function TAtomFeed.Get_Version: WideString; begin Result := FVersion; end;

{ TAtomItems }

constructor TAtomItems.Create(theNode:IXMLDOMNode);
begin
  fItems := TList.Create();
  fNode:=theNode;
end;
procedure TAtomItems.Add(item: TInterfacedObject); begin fItems.Add(item); end;
function TAtomItems.Add:IRSSItemBase;
var Item:TAtomItem;
begin
  item:=TAtomItem.Create(fNode.appendChild(fNode.ownerDocument.createElement('entry')));
  fItems.Add(item);
  Result:=item;
end;
procedure TAtomItems.Delete(Index:integer);
begin
  fNode.removeChild(TAtomItem(fItems[Index]).FNode);
  fItems.Delete(Index);
end;
function TAtomItems.Get_Count: integer; begin Result := fItems.Count; end;
function TAtomItems.Get_Item(Index: Integer): IRSSItemBase; begin Result := TAtomItem(fItems.Items[index]); end;

function TAtomItems.Get_ItemByGuid(guid: string): IRSSItemBase;
begin
	//TODO implement TAtomItems.Get_ItemByGuid
  Result := nil;
end;
function TAtomItems.IndexOfLink(ALink:WideString):integer;
var i:Integer;
begin
  Result:=-1;
  for  i:= 0 to fItems.Count - 1 do
  if TAtomItem(fItems[i]).FLink=ALink then
    begin
      Result:=i;
      Exit;
    end;
end;
function TAtomItems.IndexOfTitle(ATitle:String):integer;
var i:Integer;
begin
  Result:=-1;
  for  i:= 0 to fItems.Count - 1 do
  if TAtomItem(fItems[i]).FTitle=ATitle then
    begin
      Result:=i;
      Exit;
    end;
end;

{ TAtomItem }

constructor TAtomItem.Create(theNode: IXmlDOMNode);
var
	val : widestring;
  tmpNode : IXMLDomNode;
begin
  FAuthor:='';
  FTitle:='';
  FGuid:='';
  FLink:='';
  FDescription:='';
  if assigned(theNode) then begin
    fNode:=theNode;
    if getNodeVal(thenode, 'readed')='true' then
      FReaded:=True;
	 	FAuthor := getNodeVal(thenode,'author/name');
    FGuid := getNodeVal(theNode, 'id');
    FTitle := ExtractNonHTML(getNodeVal(thenode, 'title'));
    FLink := getNodeVal(thenode, 'link[@rel="alternate"]/@href');
    if FGuid = '' then FGuid := FLink;
    if FGuid = '' then FGuid := FTitle;
    try
      val := getNodeVal(thenode, 'modified');
      if val = '' then val := getNodeVal(thenode, 'created');
      FPubDate := TW3CDTF.Create( val );
    except
      FPubDate := TW3CDTF.CreateDatetime(0);
    end;
    tmpNode := theNode.selectSingleNode('content');
    if Assigned(tmpNode) then
	    FDescription := tmpNode.text
    else
      FDescription := GetNodeVal(theNode,'summary');
  end else
  	FPubDate := TW3CDTF.CreateDatetime(0);
end;

function TAtomItem.Get_Author: string; begin Result := FAuthor; end;
function TAtomItem.Get_Category: string; begin Result := ''; end;
function TAtomItem.Get_Comment: WideString; begin Result := ''; end;
function TAtomItem.Get_CommentRss: WideString;  begin Result := ''; end;
function TAtomItem.Get_CommentCount: integer; begin Result := 0; end;
function TAtomItem.Get_Creator: WideString; begin Result := Get_Author(); end;
function TAtomItem.Get_Description: string; begin Result := FDescription; end;
function TAtomItem.Get_Guid: WideString; begin Result := FGuid; end;
function TAtomItem.Get_PubDate: TW3CDTF; begin Result := FPubDate; end;
function TAtomItem.Get_Title: string; begin Result := FTitle; end;
function TAtomItem.Get_Link: WideString; begin Result := FLink; end;
function TAtomItem.Get_CommentURL: WideString; begin Result := ''; end;
procedure TAtomItem.Set_PubDate(Value:TW3CDTF);
begin
  FPubDate:=Value;
  SetNodeVal(FNode,'pubDate',Value.ToRFC822String);
end;
procedure TAtomItem.Set_Title(Value:string);
begin
  FTitle:=Value;
  SetNodeVal(FNode,'title',Value);
end;
procedure TAtomItem.Set_Link(Value:WideString);
begin
  FLink:=Value;
  SetNodeVal(FNode,'link','');
  SetNodeAttrVal(fNode.selectSingleNode('link'),'href',Value);
end;
procedure TAtomItem.Set_Guid(Value:Widestring);
begin
  FGuid:=Value;
  SetNodeVal(FNode,'guid',Value);
end;
procedure TAtomItem.Set_Description(Value:string);
begin
  FDescription:=Value;
  SetNodeVal(FNode,'description',Value);
end;
procedure TAtomItem.Set_Author(Value:string);
begin
  FAuthor:=Value;
  SetNodeVal(FNode,'author','');
  SetNodeVal(FNode.selectSingleNode('author'),'name',Value);
end;
procedure TAtomItem.Set_Category(Value:string);
begin
  //FCategory:=Value;
end;
procedure TAtomItem.Set_Creator(Value:Widestring);
begin
  Set_Author(Value);
end;
procedure TAtomItem.Set_Comment(Value:Widestring);
begin

end;
procedure TAtomItem.Set_CommentCount(Value:Integer);
begin

end;
procedure TAtomItem.Set_CommentURL(Value:Widestring);
begin

end;
procedure TAtomItem.Set_CommentRSS(Value:Widestring);
begin

end;

function TAtomItem.Get_Readed:Boolean;begin Result:=FReaded;end;
procedure TAtomItem.Set_Readed(Value:Boolean);
begin
  FReaded:=Value;
  if Value then
     SetNodeVal(FNode,'readed','true')
  else
     SetNodeVal(FNode,'readed','false')
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -