uopml.pas

自己写的一个 RSS 阅读器

{****************************************************************}
{                                                                }
{                        XML Data Binding                        }
{                                                                }
{         Generated on: 31.05.2004 18:44:45                      }
{       Generated from: C:\mydocs\Projects\Delphi\RSS\opml.xml   }
{   Settings stored in: C:\mydocs\Projects\Delphi\RSS\opml.xdb   }
{                                                                }
{****************************************************************}

unit uOpml;

interface

uses SysUtils,MSXML2_TLB,uW3CDTF,IniFiles,Dialogs,ComCtrls,Classes;

type
{ Forward Decls }

  TOpmlType = class;
  THeadType = class;
  TBodyType = class;
  TOutlineType = class;
  TOutlineTypeList = class;

{ TOutlineType }

  TOutlineType = class(TComponent)
  private
    fBodyNode,fNode:IXMLDOMNode;
    FTitle:string;
    fText:string;
    FType_:string;
    FXmlUrl:string;
    FDescription:string;
    FHtmlUrl:string;
    FFileName:string;
    FLastPurge:string;
    FRefreshInterval:string;
    FPurge:string;
    FItems:TOutlineTypeList;
    fHasChild:Boolean;
  protected
    { IOutlineType }
    function Get_Type_: WideString;
    function Get_Title: string;
    function Get_Text: string;
    function Get_XmlUrl: WideString;
    function Get_HtmlUrl: WideString;
    function Get_FileName: widestring;
    function Get_LastPurge: TDateTime;
    function Get_RefreshInterval: Integer;
    function Get_Purge: Integer;
    function Get_Description:WideString;
    procedure Set_Type_(Value: WideString);
    procedure Set_Title(Value: string);
    procedure Set_Text(Value: string);
    procedure Set_XmlUrl(Value: WideString);
    procedure Set_HtmlUrl(Value: WideString);
    procedure Set_FileName(Value: widestring);
    procedure Set_LastPurge(Value: TDateTime);
    procedure Set_RefreshInterval(Value: Integer);
    procedure Set_Purge(Value: Integer);
    procedure Set_Description(Value:WideString);
  public
    constructor Create(theBodyNode,theNode:IXMLDOMNode);
    property Type_: WideString read Get_Type_ write Set_Type_;
    property Title: string read Get_Title write Set_Title;
    property Text:string read Get_Text write Set_Text;
    property HtmlUrl: WideString read Get_HtmlUrl write Set_HtmlUrl;
    property XmlUrl: WideString read Get_XmlUrl write Set_XmlUrl;
    property Description: WideString read Get_Description write Set_Description;

    property FileName: widestring read Get_FileName write Set_FileName;
    property LastPurgeDate: TDateTime read Get_LastPurge write Set_LastPurge;
    property RefreshInterval: Integer read Get_RefreshInterval write Set_RefreshInterval;
    property Purge: Integer read Get_Purge write Set_Purge;
    property Items:TOutlineTypeList read FItems write FItems;
    property hasChild:Boolean read fHasChild;
    property Node:IXMLDOMNode read fNode write fNode;
    procedure MoveUp;
    procedure MoveDown;
    procedure MoveTo(AFolder:TOutlineType);
    procedure DeleteSelf;
  end;

  TOutlineTypeList = class(TComponent)
  private
    fItems : THashedStringList;
    fBodyNode,fNode:IXMLDOMNode;
  protected
    procedure Add(item : TObject);overload;

    function Get_Item(index : integer): TOutlineType;
    function Get_ItemByGuid(guid : string): TOutlineType;
    function Get_Count(): integer;
  public
    constructor Create(theBodyNode,theNode:IXMLDOMNode);
    property Item[Index: Integer]: TOutlineType read Get_Item;
    property Count : integer read Get_Count;
    function Add(aType:string):TOutlineType;overload;
    procedure Delete(Index:integer); overload;
    procedure Delete(outline:TOutlineType); overload;
    function IndexOfXmlUrl(aXmlUrl:WideString):integer;
    function IndexOfTitle(aTitle:String):integer;

  end;

{ TOpmlType }

  TOpmlType = class(TComponent)
  private
    fHead:THeadType;
    fBody:TBodyType;
    fVersion:string;
    fDoc:IXMLDOMDocument2;
  protected
    { IOpmlType }
    function Get_Head: THeadType;
    function Get_Body: TBodyType;
    function Get_version:string;
    procedure Set_version(Value:String);
  public
    property Head: THeadType read Get_Head;
    property Body: TBodyType read Get_Body;
    property Doc:IXMLDOMDocument2 read fDoc write fDoc;
    property Version:string read Get_version write Set_version;
    procedure Save(FileName : string = '');
    constructor Create(theDoc: IXMLDOMDocument2);
   
    
  end;

{ THeadType }

  THeadType = class(TComponent)
  private
    fHeadNode:IXMLDOMNode;
    fDoc:IXMLDOMDocument2;
    fTitle:string;
  protected
    { IHeadType }
    function Get_Title: string;
    procedure Set_Title(Value: string);
  public
    constructor Create(theDoc: IXMLDOMDocument2);
    property Title:string read Get_Title write Set_Title; 
  end;

  TBodyType = class(TComponent)
  private
      fBodyNode:IXMLDOMNode;
  
    fDoc:IXMLDOMDocument2;
    fItems : TOutlineTypeList;
  protected
    { IBodyType }
    function Get_Items: TOutlineTypeList;
  public
    constructor Create(theDoc: IXMLDOMDocument2);
    property Items:TOutlineTypeList read fItems write fItems;
    function AddRootFolder:TOutlineType;
  end;

{ Global Functions }

function Getopml(Doc: IXMLDOMDocument2): TOpmlType;
function Loadopml(const FileName: WideString): TOpmlType;
function Newopml: TOpmlType;

const
  TargetNamespace = '';

implementation
uses  uConstants, Forms,ActiveX,FastStrings;
{ Global Functions }

function Getopml(Doc: IXMLDOMDocument2): TOpmlType;
begin
  Result := TOpmlType.Create(Doc);
end;

function Loadopml(const FileName: WideString): TOpmlType;
var doc:IXMLDOMDocument2;
begin
  doc:=CoDOMDocument.Create;
  doc.load(FileName);
  Result := TOpmlType.Create(Doc);
end;

function Newopml: TOpmlType;
var
  Doc:IXMLDOMDocument2;
  E_opml,E_head,E_title,E_body:IXMLDOMElement;
  resStream:TResourceStream;
  istm:IStream;
  stm:TStream;
begin
  Doc:=CoDOMDocument.Create;
  stm:=TStream.Create;
  resStream:=TResourceStream.Create(HInstance, 'OPMLXML', 'XML');
  try
    resStream.SaveToStream(stm);
  finally
    resStream.Free;
  end;
  istm := TStreamAdapter.Create(stm);
  Doc.load(iStm);
  Result := TOpmlType.Create(Doc);
  stm.Free;
end;

{ TOpmlType }
constructor TOpmlType.Create(theDoc: IXMLDOMDocument2);
var i:Integer;
  node:IXMLDOMNode;
begin
  fDoc:=theDoc;
  node:=fDoc.documentElement;
  fHead:=THeadType.Create(fDoc);
  fBody:=TBodyType.Create(fDoc);
end;

function TOpmlType.Get_Head: THeadType;
begin
  Result := fHead;
end;

function TOpmlType.Get_Body: TBodyType;
begin
  Result := fBody;
end;

function TOpmlType.Get_version:string;
begin
  Result := fVersion;
end;

procedure TOpmlType.Set_version(Value:String);
begin
  fVersion:=Value;
  fDoc.documentElement.setAttribute('version',Value);
end;

procedure TOpmlType.Save(FileName: string);
begin
	fDoc.save(FileName);
end;

{ THeadType }
constructor THeadType.Create(theDoc: IXMLDOMDocument2);
var
	node : IXmlDOMNode;
begin
	try
    FTitle := '';
    node := theDoc.documentElement.selectSingleNode('head');
    fDoc:=theDoc;
  	if Assigned(node) then begin
		  FTitle := GetNodeVal(node,'title');
      fHeadNode:=node;
		end;
  except
//    Result := '';
  end;
end;

function THeadType.Get_Title: string;
begin
  Result := fTitle;
end;

procedure THeadType.Set_Title(Value: string);
begin
  fTitle:=Value;
  SetNodeVal(fHeadNode,'title',Value);
end;

{ TBodyType }

constructor TBodyType.Create(theDoc:IXMLDOMDocument2);
var
	node : IXmlDOMNode;
  i:Integer;
  BodyNode:IXMLDOMNodeList;
begin
	try
    node := theDoc.documentElement.selectSingleNode('body');
    fBodyNode := node;
    fDoc:=theDoc;
    fItems := TOutlineTypeList.Create(fBodyNode,node);
    for  i:= 0 to node.childNodes.length-1 do // Iterate
    begin
      fItems.Add(TOutlineType.Create(fBodyNode,node.childNodes.item[i]));
    end;    // for}
  except
//    Result := '';
  end;
end;

function TBodyType.AddRootFolder:TOutlineType;
var newNode:IXMLDOMNode;