fm_inputrss.pas

ReadWorld RSS 聚合新闻 阅读器 XML 欢迎使用ReadWorldRSS阅读器 1 这个程序更改了我上回发布的《聚合新闻（RSS）阅读器》的一些错误。 2 新增了频道列表的拖放

unit FM_InPutRss;

interface

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

type
  TFMInPutRss = class(TForm)
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    RadioButton3: TRadioButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure ViewXML(XMLNode,XMLNode2:IXMLNode);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMInPutRss: TFMInPutRss;

implementation
uses
 FM_RSS;
{$R *.dfm}

procedure TFMInPutRss.Button1Click(Sender: TObject);
var
 XMLDoc1,XMLDoc2:TXMLDocument;
 XMLNode,XMLNode1,XMLNode2:IXMLNode;
 SList,Title,XMLUrl:TStringList;
 k:integer;
 ItemsParent:TTreeNode;
begin
 XMLDoc1:=TXMLDocument.Create(Self);
 XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
 XMLDoc1.Active:=True;
 XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
 XMLNode1:=XMLDoc1.Node.ChildNodes.Nodes[0];
 SList:=TStringList.Create;
 SList.Clear;
 Title:=TStringList.Create;
 Title.Clear;
 XMLUrl:=TStringList.Create;
 XMLUrl.Clear;
 if RadioButton1.Checked then
  if SaveDialog1.Execute then
   if SaveDialog1.FileName<>'' then
    XMLDoc1.SaveToFile(SaveDialog1.FileName+'.xml');
 if RadioButton2.Checked then
   if (FMRSS.TreeView1.Selected<>nil)and(FMRSS.TreeView1.Selected.Parent<>nil) then
     if SaveDialog1.Execute then
      if SaveDialog1.FileName<>'' then
        begin
         ItemsParent:=FMRSS.TreeView1.Selected.Parent;
         k:=FMRSS.TreeView1.Selected.Index;
         while ItemsParent<>nil do
          begin
           SList.Add(inttostr(ItemsParent.index));
           ItemsParent:=ItemsParent.Parent;
          end;
         SList.Delete(SList.Count-1);
         while SList.Text <>'' do
          begin
           XMLNode:=XMLNode.ChildNodes.Nodes[strtoint(SList.Strings[SList.Count-1])];
           SList.Delete(SList.Count-1);
          end;
         XMLNode:=XMLNode.ChildNodes.Nodes[k];
         while XMLNode1.ChildNodes.Count<>0 do
         begin
           XMLNode1.ChildNodes.Delete(0);
         end;
         XMLNode1.ChildNodes.Add(XMLNode);
         XMLDoc1.SaveToFile(SaveDialog1.FileName+'.xml');
        end;        
 if RadioButton3.Checked then
   if (FMRSS.TreeView1.Selected<>nil)and(FMRSS.TreeView1.Selected.Parent<>nil) then
    begin
     SaveDialog1.Filter:='*.opml|*.opml';
     if SaveDialog1.Execute then
       if SaveDialog1.FileName<>'' then
         begin
         ItemsParent:=FMRSS.TreeView1.Selected.Parent;
         k:=FMRSS.TreeView1.Selected.Index;
         while ItemsParent<>nil do
          begin
           SList.Add(inttostr(ItemsParent.index));
           ItemsParent:=ItemsParent.Parent;
          end;
         SList.Delete(SList.Count-1);
         while SList.Text <>'' do
          begin
           XMLNode:=XMLNode.ChildNodes.Nodes[strtoint(SList.Strings[SList.Count-1])];
           SList.Delete(SList.Count-1);
          end;
         XMLNode:=XMLNode.ChildNodes.Nodes[k];
         XMLDoc2:=TXMLDocument.Create(Self);
         XMLDoc2.FileName:=ExtractFilePath(Application.ExeName)+'ChannelList.opml';
         XMLDoc2.Active:=True;
         XMLNode2:=XMLDoc2.Node.ChildNodes.Nodes[0].ChildNodes.Nodes[1];
         ViewXML(XMLNode,XMLNode2);
         XMLDoc2.SaveToFile(SaveDialog1.FileName+'.opml');
         XMLDoc2.Free;
         end;
   end;
 XMLDoc1.Free;
 Close;
end;

procedure TFMInPutRss.ViewXML(XMLNode,XMLNode2:IXMLNode);
begin
 while XMLNode<>nil do
    begin
      if XMLNode.HasChildNodes then
        begin
          XMLNode:=XMLNode.ChildNodes.First;
          if XMLNode.NodeName='ChannelName' then
           begin
            XMLNode2:=XMLNode2.AddChild('outline');
            XMLNode2.Attributes['title']:=XMLNode.Attributes['Name'];
           end;
          if XMLNode.NodeName='Channel' then
           begin
            XMLNode2:=XMLNode2.AddChild('outline');
            XMLNode2.Attributes['title']:=XMLNode.Attributes['Name'];
            XMLNode2.Attributes['text']:=XMLNode.Attributes['Name'];
            XMLNode2.Attributes['type']:='rss';
            XMLNode2.Attributes['xmlUrl']:=XMLNode.NodeValue;
           end;
           ViewXML(XMLNode,XMLNode2);
           XMLNode:=XMLNode.ParentNode;
           XMLNode2:=XMLNode2.ParentNode;
        end;
       if XMLNode.NextSibling<>nil then
         begin
          XMLNode:=XMLNode.NextSibling;
          if XMLNode.NodeName='ChannelName' then
           begin
            XMLNode2:=XMLNode2.ParentNode.AddChild('outline');
            XMLNode2.Attributes['title']:=XMLNode.Attributes['Name'];
           end;
          if XMLNode.NodeName='Channel' then
           begin
            XMLNode2:=XMLNode2.AddChild('outline');
            XMLNode2.Attributes['title']:=XMLNode.Attributes['Name'];
            XMLNode2.Attributes['text']:=XMLNode.Attributes['Name'];
            XMLNode2.Attributes['type']:='rss';
            XMLNode2.Attributes['xmlUrl']:=XMLNode.NodeValue;
           end;
         end
       else
        exit;
   end;
end;
procedure TFMInPutRss.Button2Click(Sender: TObject);
begin
 Close;
end;

end.