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;

type
{ Forward Decls }

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

{ TOutlineType }

  TOutlineType = class(TObject)
  private
    fOutlineNode:IXMLDOMNode;
    fDoc:IXMLDOMDocument2;
    FTitle:string;
    FType_:string;
    FXmlUrl:string;
    FDescription:string;
    FHtmlUrl:string;
    FFileName:string;
    FLastPurge:string;
    FRefreshInterval:string;
    FPurge:string;
  protected
    { IOutlineType }
    function Get_Type_: WideString;
    function Get_Title: 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_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(theDoc: IXMLDOMDocument2;theNode:IXMLDOMNode);
    property Type_: WideString read Get_Type_ write Set_Type_;
    property Title: string read Get_Title write Set_Title;
    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;
  end;

  TOutlineTypeList = class(TObject)
  private
    fItems : THashedStringList;
    fDoc:IXMLDOMDocument2;
  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(theDoc:IXMLDOMDocument2);
    property Item[Index: Integer]: TOutlineType read Get_Item;
    property Count : integer read Get_Count;
    function Add:TOutlineType;overload;
    procedure Delete(Index:integer);
    function IndexOfXmlUrl(aXmlUrl:WideString):integer;
    function IndexOfTitle(aTitle:String):integer;

  end;

{ TOpmlType }

  TOpmlType = class(TObject)
  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 Version:string read Get_version write Set_version;
    procedure Save(FileName : string = '');
    constructor Create(theDoc: IXMLDOMDocument2);
  end;

{ THeadType }

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

{ TBodyType }

  TBodyType = class(TObject)
  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;
  end;

{ Global Functions }

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

const
  TargetNamespace = '';

implementation
uses  uConstants, Forms,Classes,ActiveX,MProperties;
{ 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(theDoc);
  fBody:=TBodyType.Create(theDoc);
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');
    fDoc:=theDoc;
    fItems := TOutlineTypeList.Create(theDoc);
    BodyNode:=Node.selectNodes('outline');
    for  i:= 0 to bodyNode.length-1 do // Iterate
    begin
      fItems.Add(TOutlineType.Create(theDoc,bodyNode.item[i]));
    end;    // for}
  except
//    Result := '';
  end;
end;

function TBodyType.Get_Items: TOutlineTypeList;
begin
  Result := fItems;
end;

{ TOutlineType }

function TOutlineType.Get_Type_: WideString;
begin
  Result := FType_;
end;

procedure TOutlineType.Set_Type_(Value: WideString);
begin
  FType_:=Value;
  SetNodeAttrVal(fOutlineNode,'type',Value);
end;

function TOutlineType.Get_Title: string;
begin
  Result := FTitle;
end;

procedure TOutlineType.Set_Title(Value: string);
begin
  FTitle:=Value;
  SetNodeAttrVal(fOutlineNode,'title',Value);
end;

function TOutlineType.Get_XmlUrl: WideString;
begin
  Result := FXmlUrl;
end;

procedure TOutlineType.Set_XmlUrl(Value: WideString);
begin
  FXmlUrl:=Value;
  SetNodeAttrVal(fOutlineNode,'xmlUrl',Value);
end;

function TOutlineType.Get_Description:WideString;
begin
  Result := FDescription;
end;

procedure TOutlineType.Set_Description(Value:WideString);
begin
  FDescription:=Value;
  SetNodeAttrVal(fOutlineNode,'description',Value);
end;

function TOutlineType.Get_FileName: widestring;
begin
  Result := FFileName;
end;

procedure TOutlineType.Set_FileName(Value: widestring);
begin
  FFileName:=Value;
  SetNodeAttrVal(fOutlineNode,'fileName',Value);
end;

function TOutlineType.Get_LastPurge: TDateTime;
begin
  Result := StrToDate(FLastPurge);
end;

procedure TOutlineType.Set_LastPurge(Value: TDateTime);
var
  t : TW3CDTF;
begin
  t := TW3CDTF.CreateDateTime(Value);
  try
    FLastPurge:=t.ToRFC822String;
    SetNodeAttrVal(fOutlineNode,'lastPurge',t.ToRFC822String);
  finally
    t.Free;
  end;
end;

function TOutlineType.Get_RefreshInterval: Integer;
begin
  Result:=StrToInt(FRefreshInterval);
end;

procedure TOutlineType.Set_RefreshInterval(Value: Integer);
begin
  FRefreshInterval:=IntToStr(Value);
  SetNodeAttrVal(fOutlineNode,'refreshInterval',Value);
end;

function TOutlineType.Get_Purge: Integer;
begin
  Result := StrToInt(FPurge);
end;

procedure TOutlineType.Set_Purge(Value: Integer);
begin
  FPurge:=IntToStr(Value);
  SetNodeAttrVal(fOutlineNode,'purge',Value);
end;


function TOutlineType.Get_HtmlUrl: WideString;
begin
  Result := fOutlineNode.attributes.getNamedItem('htmlUrl').Text;
  if Result = '' then
  	Result := fOutlineNode.attributes.getNamedItem('url').Text;
end;

procedure TOutlineType.Set_HtmlUrl(Value: WideString);
begin
  FHtmlUrl:=Value;
  SetNodeAttrVal(fOutlineNode,'htmlUrl',Value);
end;

constructor TOutlineType.Create(theDoc: IXMLDOMDocument2;theNode:IXMLDOMNode);
var node:IXMLDOMNode;
begin
  node:=theNode;
  fOutlineNode:=theNode;
  fDoc:=theDoc;
  FTitle           := GetNodeAttrVal(node, 'title');
  FType_           := GetNodeAttrVal(node, 'type');
  FXmlUrl          := GetNodeAttrVal(node, 'xmlUrl');
  FHtmlUrl         := GetNodeAttrVal(node, 'htmlUrl');
  FDescription     := GetNodeAttrVal(node, 'description');
  FFileName        := GetNodeAttrVal(node, 'fileName');
  FLastPurge       := GetNodeAttrVal(node, 'lastPurge');
  FRefreshInterval := GetNodeAttrVal(node, 'refreshInterval');
  if FRefreshInterval = '' then
     RefreshInterval := 0;
  FPurge           := GetNodeAttrVal(node, 'purge');
end;

{TOutlineTypeList}
constructor TOutlineTypeList.Create(theDoc:IXMLDOMDocument2);
begin
  fDoc:=theDoc;
	fItems := THashedStringList.Create;
end;
function TOutlineTypeList.IndexOfXmlUrl(aXmlUrl:WideString):integer;
var i:Integer;
begin
  Result:=-1;
  for  i:= 0 to fItems.Count- 1 do
  if TOutlineType(fItems.Objects[i]).FXmlUrl=aXmlUrl then
    begin
      Result:=i;
      Exit;
    end;
end;
function TOutlineTypeList.IndexOfTitle(aTitle:String):integer;
var i:Integer;
begin
  Result:=-1;
  for  i:= 0 to fItems.Count- 1 do
  if TOutlineType(fItems.Objects[i]).FTitle=aTitle then
    begin
      Result:=i;
      Exit;
    end;
end;
procedure TOutlineTypeList.Add(item: TObject);
begin
	fItems.AddObject((item as TOutlineType).FTitle, item);
end;

procedure TOutlineTypeList.Delete(Index:integer);
var BodyNode:IXMLDOMNode;
begin
  BodyNode:=fDoc.documentElement.selectSingleNode('body');
  BodyNode.removeChild(TOutlineType(fItems.Objects[Index]).fOutlineNode);
  fItems.Delete(Index);
end;

function TOutlineTypeList.Add:TOutlineType;
var
  item:TOutlineType;
  bodyNode,newOutlineNode:IXMLDOMNode;
begin
  bodyNode:= fDoc.documentElement.selectSingleNode('body');
  newOutlineNode:=bodyNode.appendChild(fDoc.createElement('outline'));
  item:=TOutlineType.Create(fDoc,newOutlineNode);
  fItems.AddObject('',item);
  Result:=item;
end;

function TOutlineTypeList.Get_Count: integer;
begin
  Result := fItems.Count;
end;

function TOutlineTypeList.Get_Item(Index: Integer): TOutlineType;
begin
	Result := TOutlineType(fItems.Objects[index]);
end;

function TOutlineTypeList.Get_ItemByGuid(guid: string): TOutlineType;
begin
	Result := TOutlineType(fItems.Objects[fItems.IndexOf(guid)]);
end;


end.