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

📄 fm_ouptrss.~pas

📁 realworld source code
💻 ~PAS
字号:
unit FM_OuptRss;

interface

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

type
  TFMOuptRss = class(TForm)
    Button1: TButton;
    Button4: TButton;
    Button6: TButton;
    Button7: TButton;
    Label1: TLabel;
    XMLDoc2: TXMLDocument;
    RzTreeView1: TRzTreeView;
    RzTreeView2: TRzTreeView;
    ImageList1: TImageList;
    Button2: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure AddChannel(Node1:TTreeNode;Node2:TTreeNode;Node3:TTreeNode;s:string);
    procedure FormCreate(Sender: TObject);
    procedure TreeViewLoadXML(XMLNode: IXMLNode; TreeNode: TTreeNode;Tree:TRzTreeView);
    procedure TreeViewLoadXML1(XMLNode: IXMLNode; TreeNode: TTreeNode;Tree:TRzTreeView);
    procedure NodeAdd(N1,N2:IXMLNode;T2,T3:TTreeNode);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMOuptRss: TFMOuptRss;
  XMLFilePathName:String;
implementation
uses
 FM_ViewRss,FM_RSS;
{$R *.dfm}

procedure TFMOuptRss.AddChannel(Node1, Node2,Node3: TTreeNode;s:string);
begin
 while node1<>nil   do
    begin
      if node1.HasChildren then
        begin
          node1:=node1.getFirstChild;
          if node1.ImageIndex=0 then
           begin
            Node2:=RzTreeView2.Items.AddChild(Node2,node1.Text);
            Node3:=FMRSS.RzTreeView1.Items.AddChild(Node3,node1.Text);
            Node2.ImageIndex:=0;
            Node3.ImageIndex:=0;
            Node3.SelectedIndex:=0;
            Node2.SelectedIndex:=0;
           end ;
          if node1.ImageIndex=3 then
           begin
            Node2:=RzTreeView2.Items.AddChild(Node2,node1.Text);
            Node3:=FMRSS.RzTreeView1.Items.AddChild(Node3,node1.Text);
            Node2.ImageIndex:=3;
            Node3.ImageIndex:=3;
            Node3.SelectedIndex:=3;
            Node2.SelectedIndex:=3;
           end ;
          AddChannel(node1,Node2,Node3,s);
          node1:=node1.Parent;
          node2:=node2.Parent;
          node3:=node3.Parent;
        end;
      if (node1.getNextSibling<>nil)and(s<>node1.Parent.Text) then
       begin
        node1:=node1.getNextSibling  ;
        if node1.ImageIndex=0 then
         begin
          Node2:=RzTreeView2.Items.Add(Node2,Node1.Text);
          Node3:=FMRSS.RzTreeView1.Items.Add(Node3,Node1.Text);
          Node2.ImageIndex:=0;
          Node3.ImageIndex:=0;
          Node3.SelectedIndex:=0;
          Node2.SelectedIndex:=0;
         end;
        if node1.ImageIndex=3 then
         begin
          Node2:=RzTreeView2.Items.Add(Node2,Node1.Text);
          Node3:=FMRSS.RzTreeView1.Items.Add(Node3,Node1.Text);
          Node2.ImageIndex:=3;
          Node3.ImageIndex:=3;
          Node3.SelectedIndex:=3;
          Node2.SelectedIndex:=3;
         end;
       end
      else
        exit;
      end;
end;

procedure TFMOuptRss.Button1Click(Sender: TObject);
var
 items2,Items3,Items4,ItemsParent:TTreeNode;
 SList,S_List,AddList:TStringList;
 XMLNode,XMLNode1,XMLNode2:IXMLNode;
 i,j,k:integer;
 XMLDoc1,XMLDoc3:TXMLDocument;
begin
if (RzTreeView1.Selected<>nil)and(RzTreeView2.Selected<>nil)and(RzTreeView2.Selected.ImageIndex<>1)then
 begin
  SList:=TStringList.Create;
  S_List:=TStringList.Create;
  AddList:=TStringList.Create;
  AddList.Clear;
  SList.Clear;
  S_List.Clear;
  Items2:=nil;
  Items3:=FMRSS.RzTreeView1.Items[0];
  XMLDoc1:=TXMLDocument.Create(self);
  XMLDoc1.FileName:=XMLFilePathName;
  XMLDoc1.Active:=True;
  XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
  for i:=0 to XMLDoc1.ChildNodes.Count-1 do
   if LowerCase(XMLDoc1.ChildNodes.Nodes[i].NodeName)='opml' then
    Break;
  XMLNode:=XMLDoc1.ChildNodes.Nodes[i];
  for j:=0 to XMLNode.ChildNodes.Count-1 do
   if LowerCase(XMLNode.ChildNodes.Nodes[j].NodeName)='body' then
    Break;
  XMLNode:=XMLNode.ChildNodes.Nodes[j];
  ItemsParent:=RzTreeView1.Selected.Parent;
  k:=RzTreeView1.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;
   XMLNode1:=XMLNode.ChildNodes.Nodes[k];
   XMLDoc2.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
   XMLDoc2.Active:=True;
   XMLNode:=XMLDoc2.Node.ChildNodes.Nodes[0];
   ItemsParent:=RzTreeView2.Selected;
   while ItemsParent<>nil do
    begin
     S_List.Add(inttostr(ItemsParent.index));
     AddList.Add(inttostr(ItemsParent.index));
     ItemsParent:=ItemsParent.Parent;
    end;
   S_List.Delete(S_List.Count-1);
   AddList.Delete(AddList.Count-1);
   while S_List.Text<>'' do
    begin
     XMLNode:=XMLNode.ChildNodes.Nodes[strtoint(S_List.Strings[S_List.Count-1])];
     S_List.Delete(S_List.Count-1);
    end;
   While AddList.Text<>'' do
    begin
      Items3:=Items3.Item[strtoint(AddList.Strings[AddList.Count-1])];
      Items3.Selected:=True;
      AddList.Delete(AddList.Count-1);
    end;
   if RzTreeView1.Selected.ImageIndex=0 then
    begin
     XMLNode:=XMLNode.AddChild('ChannelName');
     XMLNode.Attributes['Name']:=RzTreeView1.Selected.Text;
     Items3:=FMRSS.RzTreeView1.Items.AddChild(Items3,RzTreeView1.Selected.Text);
     Items2:=RzTreeView2.Items.AddChild(RzTreeView2.Selected,RzTreeView1.Selected.Text);
     Items2.Expanded:=True;
     Items3.Expanded:=True;
     NodeAdd(XMLNode1,XMLNode,Items2,Items3);
    end
   else
    begin
     XMLNode:=XMLNode.AddChild('Channel');
     XMLNode.Attributes['Name']:=RzTreeView1.Selected.Text;
     XMLNode.NodeValue:=XMLNode1.Attributes['xmlUrl'];
     Items3:=FMRSS.RzTreeView1.Items.AddChild(Items3,RzTreeView1.Selected.Text);
     Items2:=RzTreeView2.Items.AddChild(RzTreeView2.Selected,RzTreeView1.Selected.Text);
     Items3.ImageIndex:=3;
     Items3.SelectedIndex:=3;
     Items2.ImageIndex:=1;
     Items2.SelectedIndex:=1;
     Items2.Expanded:=True;
     Items3.Expanded:=True;
    end;
   XMLDoc2.SaveToFile(ExtractFilePath(Application.ExeName)+'RSSChannel.xml');
   XMLDoc1.Free;
 end
else
 Application.MessageBox('不可以在频道节点下添加项目或没有选择节点','错误',MB_OK or MB_ICONWARNING) ;
end;
procedure TFMOuptRss.Button2Click(Sender: TObject);
var
 XMLDoc1,XMLDoc3:TXMLDocument;
 XMLNode,XMLNode1:IXMLNode;
 i,j:integer;
 Item1,Item2,Item3:TTreeNode;
begin
 try
  XMLDoc1:=TXMLDocument.Create(self);
  XMLDoc1.FileName:=XMLFilePathName;
  XMLDoc1.Active:=True;
  XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
  for i:=0 to XMLDoc1.ChildNodes.Count-1 do
   if LowerCase(XMLDoc1.ChildNodes.Nodes[i].NodeName)='opml' then
    Break;
  XMLNode:=XMLDoc1.ChildNodes.Nodes[i];
  for j:=0 to XMLNode.ChildNodes.Count-1 do
   if LowerCase(XMLNode.ChildNodes.Nodes[j].NodeName)='body' then
    Break;
  XMLNode:=XMLNode.ChildNodes.Nodes[j];
  XMLDoc3:=TXMLDocument.Create(self);
  XMLDoc3.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
  XMLDoc3.Active:=True;
  XMLNode1:=XMLDoc3.Node.ChildNodes.Nodes[0];
  for i:=0 to XMLNode1.ChildNodes.Count-1 do
   XMLNode1.ChildNodes.Delete(XMLNode1.ChildNodes.Count-1);
  RzTreeView2.Items[0].DeleteChildren;
  FMRSS.RzTreeView1.Items[0].DeleteChildren;
  Item1:=RzTreeView2.Items[0];
  Item2:=FMRSS.RzTreeView1.Items[0];
  NodeAdd(XMLNode,XMLNode1,Item1,Item2);
  Item1.Expanded:=True;
  Item2.Expanded:=True;
  XMLDoc3.SaveToFile(ExtractFilePath(Application.ExeName)+'RSSChannel.xml');
  XMLDoc3.Free;
 except
  Application.MessageBox('没有频道列表请先加载','错误',MB_OK OR MB_ICONWARNING); 
 end;
end;
procedure TFMOuptRss.NodeAdd(N1, N2: IXMLNode;T2,T3:TTreeNode);
var
 i:integer;
 N3:IXMLNode;
 Item3,Item2:TTreeNode;
begin
 for i:=0 to N1.ChildNodes.Count-1 do
  begin
   if N1.ChildNodes.Nodes[i].AttributeNodes.Count>1 then
    begin
     N3:=N2.AddChild('Channel');
     N3.Attributes['Name']:=N1.ChildNodes.Nodes[i].Attributes['title'];
     N3.NodeValue:=N1.ChildNodes.Nodes[i].Attributes['xmlUrl'];
     Item3:=FMRSS.RzTreeView1.Items.AddChild(T3,N1.ChildNodes.Nodes[i].Attributes['title']);
     Item3.ImageIndex:=3;
     Item3.SelectedIndex:=3;
     Item2:=RzTreeView2.Items.AddChild(T2,N1.ChildNodes.Nodes[i].Attributes['title']);
     Item2.ImageIndex:=1;
     Item2.SelectedIndex:=1;
     Item2.Expanded:=True;
     Item3.Expanded:=True;
    end
  else
    begin
     N3:=N2.AddChild('ChannelName');
     N3.Attributes['Name']:=N1.ChildNodes.Nodes[i].Attributes['title'];
     N3.NodeValue:=N1.ChildNodes.Nodes[i].Attributes['xmlUrl'];
     Item3:=FMRSS.RzTreeView1.Items.AddChild(T3,N1.ChildNodes.Nodes[i].Attributes['title']);
     Item3.ImageIndex:=0;
     Item3.SelectedIndex:=0;
     Item2:=RzTreeView2.Items.AddChild(T2,N1.ChildNodes.Nodes[i].Attributes['title']);
     Item2.ImageIndex:=0;
     Item2.SelectedIndex:=0;
     Item2.Expanded:=True;
     Item3.Expanded:=True;
     NodeAdd(N1.ChildNodes.Nodes[i],N3,Item2,Item3);
    end;
  end;
end;
procedure TFMOuptRss.FormCreate(Sender: TObject);
var
 XMLNode:IXMLNode;
 XMLDoc1:TXMLDocument;
begin
 XMLDoc1:=TXMLDocument.Create(self);
 XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'rsschannel.xml';
 XMLDoc1.Active:=True;
 RzTreeView2.Items.Clear;
 XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
 RzTreeView2.Items.Add(nil,'聚合新闻(RSS)阅读器');
 try
  TreeViewLoadXML1(XMLNode,RzTreeView2.Items[0],RzTreeView2);
 except
 end;
 RzTreeView2.Items[0].Expanded:=True;
 XMLDoc1.XML.Clear;
 XMLDoc1.Active:=False;
 XMLDoc1.Free;
end;
procedure TFMOuptRss.TreeViewLoadXML1(XMLNode: IXMLNode;
  TreeNode: TTreeNode; Tree: TRzTreeView);
var
 Item:TTreeNode;
 i:integer;
begin
  for i:=0 to XMLNode.ChildNodes.Count-1 do
  begin
    if XMLNode.ChildNodes.Nodes[i].NodeName='ChannelName' then
     begin
      Item:=Tree.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['Name']);
      Item.SelectedIndex:=0;
      Item.ImageIndex:=0;
      TreeViewLoadXML1(XMLNode.ChildNodes.Nodes[i],Item,Tree);
     end;
    if XMLNode.ChildNodes.Nodes[i].NodeName='Channel' then
     begin
      Item:=Tree.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['Name']);
      Item.SelectedIndex:=1;
      Item.ImageIndex:=1;
     end;
   end;

end;
procedure TFMOuptRss.TreeViewLoadXML(XMLNode: IXMLNode;  TreeNode: TTreeNode;Tree:TRzTreeview);
var
 Item:TTreeNode;
 i:integer;
begin
  for i:=0 to XMLNode.ChildNodes.Count-1 do
  begin
   if XMLNode.ChildNodes.Nodes[i].NodeName='outline' then
     begin
      if XMLNode.ChildNodes.Nodes[i].AttributeNodes.Count>1 then
       begin
        Item:=Tree.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['title']);
        Item.SelectedIndex:=1;
        Item.ImageIndex:=1;
       end
      else
       begin
        Item:=Tree.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['title']);
        Item.SelectedIndex:=0;
        Item.ImageIndex:=0;
       end;
      TreeViewLoadXML(XMLNode.ChildNodes.Nodes[i],Item,Tree);
     end;
   end;
end;
procedure TFMOuptRss.Button4Click(Sender: TObject);
Var
 FMViewRss:TFMViewRSS;
 xmlnode:ixmlnode;
 XMLDoc1:TXMLDocument;
 i,j,k:Integer;
begin
 FMViewRss:=TFMViewRss.Create(self);
 FMViewRSS.ShowModal;
 XMLDoc1:=TXMLDocument.Create(self);
 try
  XMLDoc1.FileName:=XMLFilePathName;
  xmldoc1.Active:=True;
  XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
  for i:=0 to XMLDoc1.ChildNodes.Count-1 do
   if LowerCase(XMLDoc1.ChildNodes.Nodes[i].NodeName)='opml' then
    Break;
  XMLNode:=XMLDoc1.ChildNodes.Nodes[i];
  for j:=0 to XMLNode.ChildNodes.Count-1 do
   if LowerCase(XMLNode.ChildNodes.Nodes[j].NodeName)='body' then
    Break;
  XMLNode:=XMLNode.ChildNodes.Nodes[j];
  RzTreeView1.Items.Clear;
  RzTreeView1.Items.Add(nil,'聚合新闻(RSS)阅读器');
  TreeViewLoadXML(XMLNode,RzTreeView1.Items[0],RzTreeView1);
  RZTreeView1.iTEMS[0].Expanded:=True;
 except
  Application.MessageBox('不能打开频道请确保地址的正确性或文件的正确','错误',MB_OK OR MB_ICONERROR);
 end;
 XMLDoc1.Free;
end;

procedure TFMOuptRss.Button7Click(Sender: TObject);
begin
// ShellExecute(handle,'open',PChar('http://freehost03.websamba.com/cyqlinux/rss/info.htm'),nil,nil,sw_show);
end;

procedure TFMOuptRss.Button6Click(Sender: TObject);
begin
 close;
end;






{ while N1<>nil do
  begin
   if N1.HasChildNodes then
    begin
     N1:=N1.ChildNodes.First;
     if N1.AttributeNodes.Count>1 then
      begin
      showmessage(N1.Attributes['title']);
       N2:=N2.AddChild('Channel');
       N2.Attributes['Name']:=N1.Attributes['title'];
       N2.NodeValue:=N1.Attributes['xmlUrl'];
      end
     else
      begin
       N2:=N2.AddChild('ChannelName');
       N2.Attributes['Name']:=N1.Attributes['title'];
       showmessage(N2.Attributes['Name']);
      end;
     NodeAdd(N1,N2);
     N1:=N1.ParentNode;
     N2:=N2.ParentNode;
   end;
   if N1.NextSibling<>nil then
     begin
     N1:=N1.NextSibling;
     if N1.AttributeNodes.Count>1 then
      begin
       N2:=N2.AddChild('Channel');
       N2.Attributes['Name']:=N1.Attributes['title'];
       N2.NodeValue:=N1.Attributes['xmlUrl'];
      end
     else
      begin
      // showmessage(N1.Attributes['title']);
       N2:=N2.AddChild('ChannelName');
       N2.Attributes['Name']:=N1.Attributes['title'];
      end;
     end
   else
      exit;
 end;}


end.

⌨️ 快捷键说明

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