fm_rss.pas

来自「ReadWorld RSS 聚合新闻 阅读器 XML 欢迎使用ReadWorl」· PAS 代码 · 共 1,106 行 · 第 1/3 页

     else
        k:=k+1;
   Item.SubItems.Strings[0]:='已读';
   FMRSS.Caption:='聚合新闻(RSS)阅读器－－－－－－'+ListView1.Selected.Caption;
   dxBarStatic1.Caption:='频道：'+ChannelNames+'  总共有：'+inttostr(ListView1.Items.Count)+'条新闻'+'  其中：'+inttostr(j)+'条已读  '+inttostr(k)+'条未读';
   WebBrowser1.Navigate(Item.SubItems.Strings[2]);
  end;
end;
procedure TFMRSS.TreeView1DblClick(Sender: TObject);
var
  ItemsParent:TTreeNode;
  XMLNode,XMLNode1:IXMLNode;
  i,j:integer;
  SList:TStringList;
  Mark,XMLFileName:String;
  XMLSearch:TSearchRec;
  TORF,TOrf1:Boolean;
begin
 if (TreeView1.Selected.Text<>'')and(TreeView1.Selected.ImageIndex=3) then
   begin
    TORF:=True;
    TORF1:=True;
    XMLFileName:='';
    Mark:='';
    SList:=TStringList.Create;
    SList.Clear;
    ItemsParent:=TreeView1.Selected.Parent;
    j:=TreeView1.Selected.Index;
    while ItemsParent<>nil do
     begin
      SList.Add(inttostr(ItemsParent.index));
      ItemsParent:=ItemsParent.Parent;
     end;
    SList.Delete(SList.Count-1);
    XML1:=TXMLDocument.Create(Self);
    XML1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
    XML1.Active:=True;
    XMLNode:=XML1.ChildNodes.Nodes[0];
    SearchXML(XMLNode,SList,j);
    SList.Free;
    for i:=1 to Length(ChannelNamesList) do
     begin
      Mark:=MidStr(ChannelNamesList,i,1);
      if (Mark<>'=')and(Mark<>'/')and(Mark<>'\')and(Mark<>':')and(Mark<>'?')and(Mark<>'*')and(Mark<>'&')and(Mark<>'%')  then
        XMLFileName:=XMLFileName+Mark;
     end;
     if FindFirst(ExtractFilePath(Application.ExeName)+'Feed\'+'*.*',faanyfile,XMLSearch) = 0 then
       begin
        repeat
         if(XMLSearch.Name[1]<>'.')and(XMLSearch.Name=XMLFileName+'.xml') then
           begin
              XML1.Active:=False;
              XML1.FileName:=ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml';
              XMLtoHTML:=ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml';
              XML1.Active:=True;
              ListView1.Items.Clear;
              for j:=0 to XML1.Node.ChildNodes.Count do
              if LowerCase(XML1.Node.ChildNodes.Nodes[j].NodeName)='rss' then
                Break;
              XMLNode:=XML1.Node.ChildNodes.Nodes[j].ChildNodes.Nodes[0];
              ListViewLoadXML(XMLNode);
              XML1.SaveToFile(ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml');
              TORF:=false;
           end;
        until FindNext(XMLSearch) <> 0;
        FindClose(XMLSearch);
        if Torf=True then
         if Application.MessageBox('没有该频道的缓存文件是否更新','错误',MB_YESNO OR MB_ICONINFORMATION)=IDYes then
          begin
           While TORF1 do
            begin
             try
              XML2.Active:=False;
              XML2.FileName:=ChannelNamesList;
              XML2.Active:=True;
              for j:=0 to XML2.Node.ChildNodes.Count-1 do
               if LowerCase(XML2.Node.ChildNodes.Nodes[j].NodeName)='rss' then
                  Break;
              XMLNode1:=XML2.Node.ChildNodes.Nodes[j].ChildNodes.Nodes[0];
              for i:=0 to XMLNode1.ChildNodes.Count-1  do
               if LowerCase(XMLNode1.ChildNodes.Nodes[i].NodeName)='item' then
                   XMLNode1.ChildNodes.Nodes[i].AddChild('read').NodeValue:='N';
              TORF1:=false;
              XMLtoHTML:=ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml';
              ListView1.Items.Clear;
              ListViewLoadXML(XMLNode1);
              XML2.SaveToFile(ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml');
             except
              if Application.MessageBox('数据读取错误','错误',MB_RETRYCANCEL  OR MB_ICONWARNING)=IDCANCEL then
                 Torf1:=false;
             end;
            end;
          end;
       end;
   end;
end;
procedure TFMRSS.SearchXML(XMLNode: IXMLNode; SList1: TStringList;ij:integer);
begin
 while SList1.Text <>'' do
  begin
   XMLNode:=XMLNode.ChildNodes.Nodes[strtoint(SList1.Strings[SList1.Count-1])];
   SList1.Delete(SList1.Count-1);
  end;
  ChannelNames:=xmlnode.ChildNodes.Nodes[ij].Attributes['Name'];
  ChannelNamesList:=xmlnode.ChildNodes.Nodes[ij].NodeValue;
  ChannelNodeItem:=xmlnode.ChildNodes.Nodes[ij];
end;
procedure TFMRSS.dxBarButton33Click(Sender: TObject);
var
  ItemsParent:TTreeNode;
  XMLNode:IXMLNode;
  j:integer;
  SList:TStringList;
  FM_Channel:TFMChanP;
  XMLDoc1:TXMLDocument;
begin
 if (TreeView1.Selected.Text<>'')and(TreeView1.Selected.ImageIndex=3) then
   begin
    SList:=TStringList.Create;
    SList.Clear;
    ItemsParent:=TreeView1.Selected.Parent;
    j:=TreeView1.Selected.Index;
    while ItemsParent<>nil do
     begin
      SList.Add(inttostr(ItemsParent.index));
      ItemsParent:=ItemsParent.Parent;
     end;
    SList.Delete(SList.Count-1);
    XMLDoc1:=TXMLDocument.Create(Self); 
    XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
    XMLDoc1.Active:=True;
    XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
    SearchXML(XMLNode,SList,j);
    SList.Free;
    FM_Channel:=TFMChanP.Create(Self);
    FM_Channel.ShowModal;
    XMLDoc1.SaveToFile(ExtractFilePath(Application.ExeName)+'RSSChannel.xml');
    XMLDoc1.Free;
   end;
end;
procedure TFMRSS.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  TargetNode, SourceNode,ItemsParent: TTreeNode;
  SList:TStringList;
  S_List:TStringList;
  XMLNode,XMLNode1:IXMLNode;
  i,j,k:integer;
  XMLDoc1:TXMLDocument;
begin
  i:=0;
  XMLDoc1:=TXMLDocument.Create(Self); 
  XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
  XMLDoc1.Active:=True;
  XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
  TargetNode := TreeView1.GetNodeAt (X, Y);
  if (TargetNode <> nil) and (TargetNode.ImageIndex<>3) then
   begin
     SList:=TStringList.Create;
     SList.Clear;
     S_List:=TStringList.Create;
     S_List.Clear;
     SourceNode:=TreeView1.Selected;
     ItemsParent:=TreeView1.Selected.Parent;
     k:=TreeView1.Selected.Index;
     while ItemsParent<>nil do
      begin
       SList.Add(inttostr(ItemsParent.index));
       ItemsParent:=ItemsParent.Parent;
       i:=i+1;
      end;
     SList.Delete(SList.Count-1);
     SourceNode.MoveTo (TargetNode, naAddChild);
     TargetNode.Expand (False);
     TreeView1.Selected := TargetNode;
     i:=0;
     ItemsParent:=TreeView1.Selected;
     j:=TreeView1.Selected.Index;
     while ItemsParent<>nil do
      begin
       S_List.Add(inttostr(ItemsParent.index));
       ItemsParent:=ItemsParent.Parent;
      end;
     S_List.Delete(S_List.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];
      XMLNode.ChildNodes.Delete(k);
      XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
     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;
      XMLNode.ChildNodes.Add(XMLNode1);
      XMLDoc1.SaveToFile(ExtractFilePath(Application.ExeName)+'RSSChannel.xml');
      XMLDoc1.Free;
  end;
end;

procedure TFMRSS.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  TargetNode, SourceNode: TTreeNode;
begin
  TargetNode := TreeView1.GetNodeAt (X, Y);
  if (Source = Sender) and (TargetNode <> nil) then
  begin
    Accept := True;
    SourceNode := TreeView1.Selected;
    while (TargetNode.Parent <> nil) and (TargetNode <> SourceNode) do
          TargetNode := TargetNode.Parent;
    if TargetNode = SourceNode then
        Accept := False;
    end
  else
    Accept := False;   
end;

procedure TFMRSS.ListView1Click(Sender: TObject);
var
 Item:TListItem;
 i,j,k:integer;
 XMLFileName,Mark:string;
 XMLNODE:IXMLNode;
 XMLDoc1:TXMLDocument;
begin
try
 j:=0;
 k:=0;
 if ListView1.ItemIndex<>-1 then
  begin
   ListView1.Selected.ImageIndex:=1;
   Item:=ListView1.Selected;
   for i:=1 to Length(ChannelNamesList) do
     begin
      Mark:=MidStr(ChannelNamesList,i,1);
      if (Mark<>'=')and(Mark<>'/')and(Mark<>'\')and(Mark<>':')and(Mark<>'?')and(Mark<>'*')and(Mark<>'&')and(Mark<>'%')  then
        XMLFileName:=XMLFileName+Mark;
     end;
     XMLDoc1:=TXMLDocument.Create(Self); 
     XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml';
     XMLDoc1.Active:=true;
     for j:=0 to XMLDoc1.Node.ChildNodes.Count do
       if LowerCase(XMLDoc1.Node.ChildNodes.Nodes[j].NodeName)='rss' then
         Break;
    XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[j].ChildNodes.Nodes[0];
    for i:=0 to XMLNode.ChildNodes.Count-1  do
     if LowerCase(XMLNode.ChildNodes.Nodes[i].NodeName)='item' then
      break;
   XMLNode:=XMLNode.ChildNodes.Nodes[i+ListView1.Selected.Index];
   for i:=0 to XMLnode.ChildNodes.Count-1 do
    if XMLNode.ChildNodes.Nodes[i].NodeName='read' then
      XMLNode.ChildNodes.Nodes[i].NodeValue:='Y';
   XMLDoc1.SaveToFile(ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml');
   j:=0;
   for i:=0 to ListView1.Items.Count-1 do
     if ListView1.Items.Item[i].ImageIndex=1 then
        j:=j+1
     else
        k:=k+1;
   Item.SubItems.Strings[0]:='已读';
   FMRSS.Caption:='聚合新闻(RSS)阅读器－－－－－－'+ListView1.Selected.Caption;
   TempHTML(XMLtoHTML,Item.Caption,XMLDoc1);
   XMLDoc1.Free;
   dxBarStatic1.Caption:='频道：'+ChannelNames+'  总共有：'+inttostr(ListView1.Items.Count)+'条新闻'+'  其中：'+inttostr(j)+'条已读  '+inttostr(k)+'条未读';
  end;
 except
  //
 end;
end;

procedure TFMRSS.TempHTML(XMLFile: string;Title:string;XMLDoc1:TXMLDocument);
VAR
 i,j,k:integer;
 XMLNode:IXMLNode;
begin
  k:=0;
  TitleName1:=TStringList.Create;
  TitleName2:=TStringList.Create;
  TitleName3:=TStringList.Create;
  TitleName4:=TStringList.Create;
  TitleName1.Clear;
  TitleName2.Clear;
  TitleName3.Clear;
  TitleName4.Clear;
 for j:=0 to XMLDoc1.Node.ChildNodes.Count-1 do
  if lowercase(XMLDoc1.Node.ChildNodes.Nodes[j].NodeName)='rss' then
   break;
 XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[j].ChildNodes.Nodes[0];
 for i:=0 to XMLNode.ChildNodes.Count-1  do
   begin
    if lowercase(XMLNode.ChildNodes.Nodes[i].NodeName)='item' then
      for j:=0 to XMLNode.ChildNodes.Nodes[i].ChildNodes.Count-1 do
       if lowercase(XMLNode.ChildNodes.Nodes[i].ChildNodes.Nodes[j].NodeName)='title' then
         if XMLNode.ChildNodes.Nodes[i].ChildNodes.Nodes[j].ChildNodes.Nodes[0].NodeValue=title then
            k:=i;

   end;
 for i:=0 to XMLNode.ChildNodes.Nodes[K].ChildNodes.Count-1 do
  begin
   RStringList1(XMLNode,K,i,TitleName1);
   RStringList2(XMLNode,K,i,TitleName2);
   RStringList3(XMLNode,K,i,TitleName3);
   RStringList4(XMLNode,K,i,TitleName4);
  end;
 Cou:=TitleName1.Count;
 T_Name:='';
 CSSMenu();
end;

procedure TFMRSS.WebBrowser1ProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
 dxBarProgressItem1.Max :=ProgressMax;
 dxBarProgressItem1.Position :=Progress;
end;

procedure TFMRSS.dxBarButton8Click(Sender: TObject);
var
 FMRAbout:TFMAbout;
begin
 FMRAbout:=TFMAbout.Create(self);
 FMRABOUT.ShowModal;
end;

procedure TFMRSS.N1Click(Sender: TObject);
begin
 SaveTempHTML(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N2Click(Sender: TObject);
begin
 SaveTempHTML2(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N3Click(Sender: TObject);
begin
 SaveTempHTML3(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N4Click(Sender: TObject);
begin
 SaveTempHTML4(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N5Click(Sender: TObject);
begin
 SaveTempHTML5(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N6Click(Sender: TObject);
begin
 SaveTempHTML6(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N8Click(Sender: TObject);
begin
 SaveTempHTML8(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N7Click(Sender: TObject);
begin
 SaveTempHTML7(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N9Click(Sender: TObject);
begin
 SaveTempHTML9(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure TFMRSS.N10Click(Sender: TObject);
begin
 SaveTempHTML10(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;