📄 fm_rss.~pas

📁 realworld source code
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
12 3 4 5 下一页
unit FM_RSS;
                       
interface      

uses
  Windows, Messages, StrUtils,SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ComCtrls,shellapi,ExtCtrls, ToolWin, StdCtrls, ImgList,
  xmldom, XMLIntf, msxmldom, XMLDoc, Menus, RzTreeVw, RzSplit, RzButton,
  NMURL, RzTray, RzBHints, RzCommon, RzListVw, RzCmboBx, Mask, RzEdit,RzTabs,
  RzPanel, RzStatus,Clipbrd,RzLabel, RzPrgres, Buttons,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,ScktComp,
  IdHTTP,TH_UpXMLChannel,ActiveX, RzSndMsg;
type
  TFMRSS = class(TForm)
    ImageList2: TImageList;
    ImageList3: TImageList;
    ImageList4: TImageList;
    XML1: TXMLDocument;
    XML2: TXMLDocument;
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    V1: TMenuItem;
    H1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    PopupMenu2: TPopupMenu;
    PopupMenu3: TPopupMenu;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N37: TMenuItem;
    PopupMenu4: TPopupMenu;
    N38: TMenuItem;
    N44: TMenuItem;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    RzToolBar2: TRzToolbar;
    btnFrames: TRzToolButton;
    RzStatusBar1: TRzStatusBar;
    RzSplitter1: TRzSplitter;
    RzPanel1: TRzPanel;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    RzTreeView2: TRzTreeView;
    RzSplitter2: TRzSplitter;
    RzStatusPane1: TRzStatusPane;
    RzPanel2: TRzPanel;
    RzTreeView1: TRzTreeView;
    XML3: TXMLDocument;
    ProgressBar1: TProgressBar;
    RzStatusPane2: TRzStatusPane;
    RzMenuController1: TRzMenuController;
    RzBalloonHints1: TRzBalloonHints;
    RzTrayIcon1: TRzTrayIcon;
    N49: TMenuItem;
    N51: TMenuItem;
    N52: TMenuItem;
    btnWelcome: TRzToolButton;
    RzSpacer1: TRzSpacer;
    btnComboBoxes: TRzToolButton;
    btnEdits: TRzToolButton;
    RzToolButton7: TRzToolButton;
    btnTabs: TRzToolButton;
    RzSpacer2: TRzSpacer;
    btnListBoxes: TRzToolButton;
    btnCommon: TRzToolButton;
    N53: TMenuItem;
    N54: TMenuItem;
    RzToolbar1: TRzToolbar;
    RzToolButton2: TRzToolButton;
    RzToolButton3: TRzToolButton;
    RzToolButton4: TRzToolButton;
    RzToolButton5: TRzToolButton;
    RzToolButton6: TRzToolButton;
    RzToolButton8: TRzToolButton;
    RzToolButton10: TRzToolButton;
    RzToolButton11: TRzToolButton;
    RzToolButton9: TRzToolButton;
    RzStandard: TRzComboBox;
    PopupMenu5: TPopupMenu;
    N55: TMenuItem;
    N56: TMenuItem;
    N57: TMenuItem;
    N58: TMenuItem;
    N59: TMenuItem;
    N60: TMenuItem;
    PopupMenu6: TPopupMenu;
    N61: TMenuItem;
    N62: TMenuItem;
    N63: TMenuItem;
    N64: TMenuItem;
    RzPanel3: TRzPanel;
    RzEdit1: TRzEdit;
    RzButton1: TRzButton;
    RzComboBox1: TRzComboBox;
    PageControl2: TRzPageControl;
    TabSheet3: TRzTabSheet;
    WebBrowser1: TWebBrowser;
    RzListView1: TRzListView;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    SaveDialog2: TSaveDialog;
    NMURL1: TNMURL;
    N39: TMenuItem;
    RzSendMessage1: TRzSendMessage;
    N9: TMenuItem;
    N40: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure dxBarButton1Click(Sender: TObject);
    procedure dxBarButton2Click(Sender: TObject);
    procedure SearchXML(XMLNode:IXMLNode; SList1: TStringList;ij:integer);
    procedure ListViewLoadXML(XMLNode: IXMLNode);
    procedure ListView1DblClick(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure ListView1Click(Sender: TObject);
    procedure TempHTML(XMLFile:string;Title:string;XMLDoc1:TXMLDocument);
    procedure WebBrowser1ProgressChange(Sender: TObject; Progress,ProgressMax: Integer);
    procedure dxBarButton8Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure dxBarButton29Click(Sender: TObject);
    procedure dxBarButton30Click(Sender: TObject);
    procedure dxBarButton5Click(Sender: TObject);
    procedure dxBarButton15Click(Sender: TObject);
    procedure dxBarButton23Click(Sender: TObject);
    procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);
    procedure dxBarButton33Click(Sender: TObject);
    procedure TreeViewLoadXML(XMLNode: IXMLNode; TreeNode: TTreeNode);
    procedure TreeView2LoadXML(XMLNode: IXMLNode; TreeNode: TTreeNode);
    procedure dxBarButton22Click(Sender: TObject);
    procedure dxBarButton27Click(Sender: TObject);
    procedure dxBarButton28Click(Sender: TObject);
    procedure dxBarLargeButton15Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
    procedure AOnDocumentComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
    procedure BonProgressChange(Sender: TObject; Progress,ProgressMax: Integer);
    procedure RzTreeView1CustomDrawItem(Sender: TCustomTreeView;Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure RzToolButton7Click(Sender: TObject);
    procedure btnEditsClick(Sender: TObject);
    procedure N37Click(Sender: TObject);
    procedure N49Click(Sender: TObject);
    procedure RzTreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N51Click(Sender: TObject);
    procedure N52Click(Sender: TObject);
    procedure RzToolbar1Resize(Sender: TObject);
    procedure RzToolButton10Click(Sender: TObject);
    procedure N55Click(Sender: TObject);
    procedure RzToolButton11Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure RzTreeView2DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure N57Click(Sender: TObject);
    procedure N56Click(Sender: TObject);
    procedure N60Click(Sender: TObject);
    procedure N59Click(Sender: TObject);
    procedure RzTreeView2DblClick(Sender: TObject);
    procedure RzToolButton1Click(Sender: TObject);
    procedure RzToolButton2Click(Sender: TObject);
    procedure RzToolButton3Click(Sender: TObject);
    procedure RzToolButton4Click(Sender: TObject);
    procedure RzToolButton5Click(Sender: TObject);
    procedure RzToolButton6Click(Sender: TObject);
    procedure RzStandardKeyPress(Sender: TObject; var Key: Char);
    procedure RzListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N38Click(Sender: TObject);
    procedure N45Click(Sender: TObject);
    procedure N46Click(Sender: TObject);
    procedure N47Click(Sender: TObject);
    procedure N48Click(Sender: TObject);
    procedure N53Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N61Click(Sender: TObject);
    procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
    procedure RzButton1Click(Sender: TObject);
    procedure SearchRSS(Url:string;Nodes:TTreeNode);
    procedure AddRSS(UrlString:String);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N40Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;
var
  UpItem,ItemCount,L1,L2:integer;
  FMRSS: TFMRSS;
  TitleName1,TitleName2,TitleName3,TitleName4,TitleName5,UrlList:TStringList;
  Cou:integer;
  T_Name,XMLtoHTML,ChannelNames,ChannelNamesList:string;
  ChannelNodeItem, XMLNames: IXMLNode;
  wb:twebbrowser;
  ThreadHandle1, ThreadHandle2,ThreadHandle3: THandle;
  XMLDown,XMLDown2,XMLDown3:TIDHTTP;
  Thread1:Array[0..3] of TUpXMLChannel;
  AddList:TAddListXMLChannel;
  A:TRzTabsheet;
  ShowForm,Cccc:Boolean;
implementation
uses
 FM_ADDCRow,FM_ADDChannel,FM_RssAbout,FM_ChanP,FM_ViewRss,FM_OuptRss,FM_InPutRss,UN_CSS
 ,FM_Splash,FM_Favorite,FM_NewFolder,FM_NewName;
{$R *.dfm}

procedure TFMRSS.FormCreate(Sender: TObject);
var
  XMLNode,XMLNode1:IXMLNode;
  XMLDoc1,XMLDoc2:TXMLDocument;
begin
 UrlList:=TStringList.Create;
 UrlList.Clear;
 XMLDoc1:=TXMLDocument.Create(Self);
 XMLDoc2:=TXMLDocument.Create(Self);
 L1:=RzSplitter1.Position;
 L2:=RzSplitter2.Position;
 XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'RSSChannel.xml';
 XMLDoc1.Active:=true;
 RzTreeView1.Items.Clear;
 XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
 RzTreeView1.Items.Add(nil,'聚合新闻（RSS）阅读器');
 XMLDoc2.FileName:=ExtractFilePath(Application.ExeName)+'Favorite.xml';
 XMLDoc2.Active:=true;
 RzTreeView2.Items.Clear;
 XMLNode1:=XMLDoc2.Node.ChildNodes.Nodes[0];
 RzTreeView2.Items.Add(nil,'我的收藏夹');
 Application.ProcessMessages;
 try                 
  TreeViewLoadXML(XMLNode,RzTreeView1.Items[0]);
 except
  RzStatusPane1.Caption:='装入频道列表有错误 ';
 end;
 FMSplash.Label1.Caption:='正在加载收藏夹列表......';
 FMSplash.Label1.Refresh;
 try
  TreeView2LoadXML(XMLNode1,RzTreeView2.Items[0]);
 except
  RzStatusPane1.Caption:=RzStatusPane1.Caption+'装入收藏夹列表有错误';
 end;
 RzTreeView1.Items[0].Expanded:=True;
 RzTreeView2.Items[0].Expanded:=True;
 FMSplash.Close;
 XMLDoc1.Free;
 XMLDoc2.Free;
 WebBrowser1.Navigate('res://' + ExtractFilePath(Application.ExeName) +'project1.exe/INDEXPAGE');
end;

procedure TFMRSS.dxBarButton1Click(Sender: TObject);
var
 XURL:string;
begin
try
  XURL:='';
  if Pos('http://',lowercase(Clipboard.AsText))=1 then
   XURL:=lowercase(Clipboard.AsText);
 AddRss(XURL);
except
end;
end;

procedure TFMRSS.dxBarButton2Click(Sender: TObject);
var
 FADDCR:TFMADDCRow;
begin
 if RzTreeView1.Selected<>nil then
  begin
   if RzTreeView1.Selected.ImageIndex<>3 then
    begin
     FADDCR:=TFMADDCRow.Create(self);
     FADDCR.ShowModal;
    end
   else
    Application.MessageBox('不能在频道节点下添加频道组','错误',MB_OK OR MB_ICONERROR);
  end
 else
    Application.MessageBox('请选择节点添加位置','错误',MB_OK OR MB_ICONERROR);
end;


procedure TFMRSS.TreeViewLoadXML(XMLNode: IXMLNode; TreeNode: TTreeNode);
var
 Item:TTreeNode;
 i,j:integer;
 XMLFileName,Mark:String;
begin
  for i:=0 to XMLNode.ChildNodes.Count-1 do
  begin
   if XMLNode.ChildNodes.Nodes[i].NodeName='ChannelName' then
     begin
      Item:=RzTreeView1.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['Name']);
      Item.SelectedIndex:=0;
      Item.ImageIndex:=0;
      FMSplash.ProgressBar1.Position:=FMSplash.ProgressBar1.Position+1;
      TreeViewLoadXML(XMLNode.ChildNodes.Nodes[i],Item);
     end;
   if XMLNode.ChildNodes.Nodes[i].NodeName='Channel' then  
     begin
      FMSplash.ProgressBar1.Position:=FMSplash.ProgressBar1.Position+1;
      for j:=1 to Length(XMLNode.ChildNodes.Nodes[i].NodeValue) do
       begin
        Mark:=MidStr(XMLNode.ChildNodes.Nodes[i].NodeValue,j,1);
        if (Mark<>'=')and(Mark<>'/')and(Mark<>'\')and(Mark<>':')and(Mark<>'?')and(Mark<>'*')and(Mark<>'&')and(Mark<>'%')  then
          XMLFileName:=XMLFileName+Mark;
       end;
      if FileExists(ExtractFilePath(Application.ExeName)+'Feed\'+XMLFileName+'.xml') then
        Item:=RzTreeView1.Items.Addchild(TreeNode,' '+XMLNode.ChildNodes.Nodes[i].Attributes['Name']+#10)
      else
        Item:=RzTreeView1.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['Name']);
      Item.SelectedIndex:=3;
      Item.ImageIndex:=3;
      XMLFileName:='';
      Mark:='';
     end;
    end;
end;
procedure TFMRSS.TreeView2LoadXML(XMLNode: IXMLNode; TreeNode: TTreeNode);
var
 Item:TTreeNode;
 i,j:integer;
 XMLNode1:IXMLNode;
begin
  for i:=0 to XMLNode.ChildNodes.Count-1 do
  begin
   if lowercase(XMLNode.ChildNodes.Nodes[i].NodeName)='folder' then
     begin
      Item:=RzTreeView2.Items.Addchild(TreeNode,XMLNode.ChildNodes.Nodes[i].Attributes['name']);
      Item.SelectedIndex:=0;
      Item.ImageIndex:=0;
      FMSplash.ProgressBar1.Position:=FMSplash.ProgressBar1.Position+1;
      TreeView2LoadXML(XMLNode.ChildNodes.Nodes[i],Item);
     end;
   if lowercase(XMLNode.ChildNodes.Nodes[i].NodeName)='favorite' then
     begin
      FMSplash.ProgressBar1.Position:=FMSplash.ProgressBar1.Position+1;
      XMLNode1:=XMLNode.ChildNodes.Nodes[i];
      XMLNode1:=XMLNode1.ChildNodes.Nodes[0];
      Item:=RzTreeView2.Items.Addchild(TreeNode,XMLNode1.NodeValue);
      Item.SelectedIndex:=11;
      Item.ImageIndex:=11;
     end;
    end;
end;

procedure TFMRSS.ListViewLoadXML(XMLNode: IXMLNode);
var
 i,j,k,l:integer;
 Item:TListItem;

begin
  TitleName1:=TStringList.Create;
  TitleName2:=TStringList.Create;
  TitleName3:=TStringList.Create;
  TitleName4:=TStringList.Create;
  TitleName5:=TStringList.Create;
12 3 4 5 下一页
💿 文件大小 929 K
👤 上传用户 IsabellaJ
📂 所属分类 Linux/Unix编程
🏷️ 相关标签

#realworld #source #code
⌨️ 快捷键说明

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