fm_addchannel.pas

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

unit FM_ADDChannel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, xmldom, XMLIntf, msxmldom, XMLDoc,ShDocVw,
  ComCtrls, OleCtrls, ImgList,StrUtils;

type
  TFMADDChannel = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Image2: TImage;
    Bevel1: TBevel;
    Panel2: TPanel;
    Label3: TLabel;
    Bevel2: TBevel;
    Edit2: TEdit;
    Button3: TButton;
    Button5: TButton;
    ProgressBar1: TProgressBar;
    Label5: TLabel;
    WebBrowser1: TWebBrowser;
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure WProgressChange(Sender: TObject; Progress,
      ProgressMax: Integer);
    procedure WDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMADDChannel: TFMADDChannel;
implementation
uses
 FM_RSS;
{$R *.dfm}

procedure TFMADDChannel.Button5Click(Sender: TObject);
var
 k:integer;
 XMLDc1:TXMLDocument;
 SList:TStringList;
 XMLNode:IXMLNode;
 XMLNode2:IXMLNode;
 Items2,ItemsParent:TTreeNode;
begin
 if (Edit2.Text<>'')and (Edit1.Text<>'')then
  begin
    XMLDc1:=TXMLDocument.Create(Self);
    XMLDc1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
    XMLDc1.Active:=True;
    XMLNode:=XMLDc1.Node.ChildNodes.Nodes[0];
    SList:=TStringList.Create;
    SList.Clear;
    if FMRSS.TreeView1.Selected.Parent<>nil 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;
       XMLNode2:=XMLNode.ChildNodes.Nodes[k].AddChild('Channel');
       XMLNode2.Attributes['Name']:=Edit2.Text;
       XMLNode2.NodeValue:=Edit1.Text;
       Items2:=FMRSS.TreeView1.Items.AddChild(FMRSS.TreeView1.Selected,Edit2.Text);
       Items2.SelectedIndex:=3;
       Items2.ImageIndex:=3;
      end
     else
      begin
       XMLNode2:=XMLDc1.Node.ChildNodes.Nodes[0].AddChild('Channel'); 
       XMLNode2.Attributes['Name']:=Edit2.Text;
       XMLNode2.NodeValue:=Edit1.Text;
       Items2:=FMRSS.TreeView1.Items.AddChild(FMRSS.TreeView1.Selected,Edit2.Text);
       Items2.SelectedIndex:=3;
       Items2.ImageIndex:=3;
      end;
     XMLDC1.SaveToFile(ExtractFilePath(Application.ExeName)+'RSSChannel.xml');
     XMLDc1.Free;
     Close;
 end;
end;

procedure TFMADDChannel.Button1Click(Sender: TObject);
var
  XMLNode:IXMLNode;
  XMLDc1:TXMLDocument;
begin
 XMLDc1:=TXMLDocument.Create(self);
 try
  XMLDc1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
  XMLDc1.Active:=True;
  XMLNode:=XMLDc1.Node.ChildNodes.Nodes[0];
  Label5.Visible:=True;
  ProgressBar1.Visible:=True;
  WebBrowser1.Navigate(Edit1.Text);
 except

 end;
 XMLDc1.Free;
end;

procedure TFMADDChannel.Button3Click(Sender: TObject);
begin
 Panel2.Visible:=False;
end;

procedure TFMADDChannel.Button4Click(Sender: TObject);
begin
 Close;
end;

procedure TFMADDChannel.WProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
 ProgressBar1.Max :=ProgressMax;
 ProgressBar1.Position :=Progress;
end;
procedure TFMADDChannel.WDocumentComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
var
 i,j:integer;
 l:boolean;
 XMLDc1:TXMLDocument;
 Mark,XMLFileName:String;
 XMLNode11:Ixmlnode;
begin
 l:=true;
 XMLDc1:=TXMLDocument.Create(Self);
 while l do
  begin
   try
    XMLDc1.FileName:=Edit1.Text;
    XMLDc1.Active:=true;
    for i:=0 to XMLDc1.Node.ChildNodes.Count  do
     if XMLDc1.Node.ChildNodes.Nodes[i].NodeName='rss' then
      break;
    XMLNode11:=XMLDc1.Node.ChildNodes.Nodes[i].ChildNodes.Nodes[0];
    for j:=0 to XMLDc1.Node.ChildNodes.Nodes[i].ChildNodes.Nodes[0].ChildNodes.count do
     if XMLDc1.Node.ChildNodes.Nodes[i].ChildNodes.Nodes[0].ChildNodes.Nodes[j].NodeName='title' then
      break;
    if XMLDc1.Node.ChildNodes.Nodes[i].ChildNodes.Nodes[0].ChildNodes.Nodes[j].ChildNodes.Count<>0 then
     Edit2.Text:=XMLDc1.Node.ChildNodes.Nodes[i].ChildNodes.Nodes[0].ChildNodes.Nodes[j].ChildNodes.Nodes[0].NodeValue
    else
     Edit2.Text:=XMLDc1.Node.ChildNodes.Nodes[i].ChildNodes.Nodes[0].ChildNodes.Nodes[j].NodeValue;
    for i:=0 to XMLNode11.ChildNodes.Count-1  do
     if LowerCase(XMLNode11.ChildNodes.Nodes[i].NodeName)='item' then
      XMLNode11.ChildNodes.Nodes[i].AddChild('read').NodeValue:='N';
    for i:=1 to Length(Edit1.Text) do
     begin
      Mark:=MidStr(Edit1.Text,i,1);
      if (Mark<>'=')and(Mark<>'/')and(Mark<>'\')and(Mark<>':')and(Mark<>'?')and(Mark<>'*')and(Mark<>'&')and(Mark<>'%')  then
        XMLFileName:=XMLFileName+Mark;
     end;
    XMLDc1.SaveToFile(ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml');
    ChannelNamesList:=Edit1.Text;
    XMLtoHtml:=ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml';
    Panel2.Visible:=TRUE;
    Label5.Visible:=False;
    ProgressBar1.Visible:=False;
    l:=false;
   except
     if Application.MessageBox('不能正确链接XML地址,请稍候重试','错误',MB_RETRYCANCEL OR MB_ICONWARNING)=IDCANCEL then
       l:=false;
   end;
   XMLDc1.Free;
 end;
end;
end.