📄 fm_rss.~pas

📁 realworld source code
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    begin
     UrlList.Add(XMLNode1.ChildNodes.Nodes[1].NodeValue);
     RzToolButton10.Enabled:=True;
     A:=TRzTabsheet.Create(PageControl2);
     A.Caption:='正在打开网页...';
     A.ImageIndex:=11;
     A.ShowHint:=true;
     A.PopupMenu:=PopupMenu3;
     //A.Hint:=XMLNode1.ChildNodes.Nodes[0].NodeValue;
     A.PageControl:=PageControl2;
     PageControl2.ActivePage:=A;
     wb:=TWEBBROWSER.Create(A);
     Twincontrol(wb).Parent := A;
     wb.Align:=alclient;
     wb.Navigate(XMLNode1.ChildNodes.Nodes[1].NodeValue);
     wb.OnDocumentComplete:=AOnDocumentComplete;
     wb.OnProgressChange:=BOnProgressChange;
    end;
  XMLDoc1.Free;
 end;
end;

procedure TFMRSS.RzToolButton1Click(Sender: TObject);
begin
  { UrlList.Add(''+'#10'+'');
   A:=TRzTabsheet.Create(PageControl2);
   A.Caption:='正在打开网页...';
   A.ImageIndex:=11;
   A.ShowHint:=true;
   A.PopupMenu:=PopupMenu3;
   A.PageControl:=PageControl2;
   PageControl2.ActivePage:=A;
   wb:=TWEBBROWSER.Create(A);
   Twincontrol(wb).Parent := A;
   wb.Align:=alclient;
   wb.Navigate('about:blank');
   wb.OnDocumentComplete:=AOnDocumentComplete;
   wb.OnProgressChange:=BOnProgressChange;  }
end;

procedure TFMRSS.RzToolButton2Click(Sender: TObject);
Var
 SaveHtml:TFileStream;
 SaveHtmll:TIDhttp;
 FPath:String;
begin
if (PageControl2.PageCount>1)and(PageControl2.ActivePageIndex<>0) then
 if SaveDialog2.Execute then
  begin
    SaveDialog2.Title:='保存网页';
    FPath:=UrlList.Strings[PageControl2.ActivePageIndex-1];
    try
     Application.ProcessMessages;
     SaveHtmll:=TIDhttp.Create(Self);
     SaveHtmll.HandleRedirects:= True;
     SaveHtml:=TFileStream.Create(SaveDialog2.FileName+'.htm',fmCreate);
     SaveHtmll.Get(FPath,SaveHtml);
     SaveHtmll.Disconnect;
     SaveHtml.Free;
    except
     SaveHtmll.Free;
     SaveHtml.Free;
     DeleteFile(SaveDialog2.FileName+'.htm');
    end;
  end;
end;

procedure TFMRSS.RzToolButton3Click(Sender: TObject);
begin
try
  WebBrowser1.GoBack;
except
end;
end;

procedure TFMRSS.RzToolButton4Click(Sender: TObject);
begin
try
 WebBrowser1.GoForward;
except
end;
end;

procedure TFMRSS.RzToolButton5Click(Sender: TObject);
begin
try
 WebBrowser1.Refresh;
except
end;
end;

procedure TFMRSS.RzToolButton6Click(Sender: TObject);
begin
try
 WebBrowser1.Stop;
except
end;
end;

procedure TFMRSS.RzStandardKeyPress(Sender: TObject; var Key: Char);
begin
 if key=#13 then
  begin
   if RightStr(RzStandard.Text,3)=lowercase('xml') then
    begin
     try
      AddRss(RzStandard.Text);
     except
     end;
    end
   else
    begin
     A:=TRzTabsheet.Create(PageControl2);
     A.Caption:='正在打开网页...';
     A.ImageIndex:=11;
     A.ShowHint:=true;
     A.PopupMenu:=PopupMenu3;
     A.PageControl:=PageControl2;
     PageControl2.ActivePage:=A;
     wb:=TWEBBROWSER.Create(A);
     Twincontrol(wb).Parent := A;
     wb.Align:=alclient;
     wb.Navigate(RzStandard.Text);
     wb.OnDocumentComplete:=AOnDocumentComplete;
     wb.OnProgressChange:=BOnProgressChange;
     UrlList.Add(RzStandard.Text);
     RzToolButton10.Enabled:=True;
   end;
   if RzStandard.FindItem(RzStandard.Text)=False then
      RzStandard.Items.Add(RzStandard.Text);
 end;
end;

procedure TFMRSS.RzListView1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbRight then
   (Sender AS TrzListView).Selected:=(Sender AS TrzListView).GetItemAt(X,Y)
end;

procedure TFMRSS.N38Click(Sender: TObject);
begin
 try
  ShellExecute(handle,'open',PChar(RzListView1.Selected.SubItems.Strings[3]),nil,nil,sw_show);
 except
 end;
end;

procedure TFMRSS.N45Click(Sender: TObject);
begin
 try
  RzListView1.ItemIndex:=0;
 except
 end;
end;

procedure TFMRSS.N46Click(Sender: TObject);
begin
try
if RzListView1.ItemIndex<>0 then
 RzListView1.ItemIndex:=RzListView1.ItemIndex-1;
except
end;
end;

procedure TFMRSS.N47Click(Sender: TObject);
begin
try
 if RzListView1.ItemIndex<>RzListView1.Items.Count-1 then
  RzListView1.ItemIndex:=RzListView1.ItemIndex+1;
except
end;
end;

procedure TFMRSS.N48Click(Sender: TObject);
begin
 try
  RzListView1.ItemIndex:=RzListView1.Items.Count-1;
 except
 end;
end;

procedure TFMRSS.N53Click(Sender: TObject);
begin
 ShellExecute(handle,'open',PChar(ExtractFilePath(Application.ExeName)+'ReadWorldHelp.chm'),nil,nil,sw_show);
end;

procedure TFMRSS.N8Click(Sender: TObject);
begin
 Application.Terminate;
end;

procedure TFMRSS.N61Click(Sender: TObject);
begin
 ShowWindow(Handle, SW_SHOW);
 ShowWindow(Application.handle, SW_SHOW);
 SetWindowLong(Application.Handle, GWL_EXSTYLE,
               not (GetWindowLong(Application.handle, GWL_EXSTYLE)
               or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW));
end;

procedure TFMRSS.WMSysCommand(var Msg: TWMSysCommand);
begin
inherited;
  if (Msg.CmdType = SC_MINIMIZE) then
   begin
    ShowWindow(Handle,SW_HIDE);
    ShowWindow(Application.Handle, SW_HIDE);
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
                  GetWindowLong(Application.handle, GWL_EXSTYLE)
                  or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
   end;
end;

procedure TFMRSS.RzButton1Click(Sender: TObject);
var
 XMLDoc1:TXMLDocument;
 XMLNode,XMLNode1:IXMLNode;
 i,j,k:integer;
 FindNode,FindNode1:Boolean;
 Item:TTreeNode;
begin
 FindNode:=False;
 FindNode1:=False;
 XMLDoc1:=TXMLDocument.Create(self);
 XMLDoc1.FileName:=ExtractFilePath(Application.ExeName)+'RssChannel.xml';
 XMLDoc1.Active:=True;
 XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
 nmurl1.InputString :=RzEdit1.text;
 for i:=0 to XMLNode.ChildNodes.Count-1 do
  begin
   if XMLNode.ChildNodes.Nodes[i].Attributes['Name']='百度聚合搜索频道' then
    begin
     j:=i;
     FindNode:=True;
    end;
   if XMLNode.ChildNodes.Nodes[i].Attributes['Name']='FeedSearch聚合搜索频道' then
    begin
     k:=i;
     FindNode1:=True;
    end;
  end;
 if FindNode then
  begin
   if RzCombobox1.Text='百度聚合搜索频道' then
    begin
     XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
     XMLNode:=XMLNode.ChildNodes.Nodes[j];
     XMLNode1:=XMLNode.AddChild('Channel');
     XMLNode1.Attributes['Name']:=RzEdit1.Text;
     XMLNode1.NodeValue:='http://news.baidu.com/ns?word='+NMURL1.Encode+'&ie=gb2312&cl=2&rn=20&ct=0&tn=newsrss&class=0';
     Item:=RzTreeView1.Items.AddChild(RzTreeView1.Items[0].Item[j],RzEdit1.Text);
     Item.ImageIndex:=3;
     Item.SelectedIndex:=3;
     Application.ProcessMessages;
     SearchRSS(XMLNode1.NodeValue,Item);
    end;
  end
 else
  begin
   XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
   XMLNode1:=XMLNode.AddChild('ChannelName');
   XMLNode1.Attributes['Name']:='百度聚合搜索频道';
   XMLNode1:=XMLNode1.AddChild('Channel');
   XMLNode1.Attributes['Name']:=RzEdit1.Text;
   XMLNode1.NodeValue:='http://news.baidu.com/ns?word='+NMURL1.Encode+'&ie=gb2312&cl=2&rn=20&ct=0&tn=newsrss&class=0';
   Item:=RzTreeView1.Items.AddChild(RzTreeView1.Items[0],'百度聚合搜索频道');
   Item.ImageIndex:=0;
   Item.SelectedIndex:=0;
   Item:=RzTreeView1.Items.AddChild(Item,RzEdit1.Text);
   Item.ImageIndex:=3;
   Item.SelectedIndex:=3;
   SearchRSS(XMLNode1.NodeValue,Item);
  end;
 if FindNode1 then
  begin
   if RzCombobox1.Text='FeedSearch聚合搜索频道' then
    begin
     XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
     XMLNode:=XMLNode.ChildNodes.Nodes[k];
     XMLNode1:=XMLNode.AddChild('Channel');
     XMLNode1.Attributes['Name']:=RzEdit1.Text;
     XMLNode1.NodeValue:='http://www.feedsearch.net/search?m=blog&q='+NMURL1.Encode+'&outputFormat=RSS&encoding=utf-8';
     Item:=RzTreeView1.Items.AddChild(RzTreeView1.Items[0].Item[k],RzEdit1.Text);
     Item.ImageIndex:=3;
     Item.SelectedIndex:=3;
     Application.ProcessMessages;
     SearchRSS(XMLNode1.NodeValue,Item);
    end;
  end
 else
  begin
   XMLNode:=XMLDoc1.Node.ChildNodes.Nodes[0];
   XMLNode1:=XMLNode.AddChild('ChannelName');
   XMLNode1.Attributes['Name']:='FeedSearch聚合搜索频道';
   XMLNode1:=XMLNode1.AddChild('Channel');
   XMLNode1.Attributes['Name']:=RzEdit1.Text;
   XMLNode1.NodeValue:='http://www.feedsearch.net/search?m=blog&q='+NMURL1.Encode+'&outputFormat=RSS&encoding=utf-8';
   Item:=RzTreeView1.Items.AddChild(RzTreeView1.Items[0],'FeedSearch聚合搜索频道');
   Item.ImageIndex:=0;
   Item.SelectedIndex:=0;
   Item:=RzTreeView1.Items.AddChild(Item,RzEdit1.Text);
   Item.ImageIndex:=3;
   Item.SelectedIndex:=3;
   SearchRSS(XMLNode1.NodeValue,Item);
  end;
 XMLDoc1.SaveToFile(ExtractFilePath(Application.ExeName)+'RssChannel.xml');
end;



procedure TFMRSS.SearchRSS(Url: string;Nodes:TTreeNode);
var
 IDHttp1:TIDHTTP;
 WriteXML:TFileStream;
 XMLFileName,Mark:String;
 i:integer;
begin
 for i:=1 to Length(Url) do
  begin
   Mark:=MidStr(Url,i,1);
   if (Mark<>'=')and(Mark<>'/')and(Mark<>'\')and(Mark<>':')and(Mark<>'?')and(Mark<>'*')and(Mark<>'&')and(Mark<>'%')  then
    XMLFileName:=XMLFileName+Mark;
  end;
 try
  WriteXML:=TFileStream.Create(ExtractFilePath(Application.ExeName) + 'Feed\'+XMLFileName+'.xml',fmCreate);
  IDHttp1:=TIDHTTP.Create(Self);
  IDHttp1.HandleRedirects:= True;
  IDHttp1.Get(Url,WriteXML);
  IDHttp1.Disconnect;
  IDHttp1.Free;
  WriteXML.Free;
  Nodes.Text:=' '+Nodes.Text+#10;
 except
  IDHttp1.Disconnect;
  IDHttp1.Free;
  WriteXML.Free;
  DeleteFile(ExtractFilePath(Application.ExeName) + 'Feed\'+XMLFileName+'.xml');
 end;
end;

procedure TFMRSS.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 try
 except
 end;
end;

procedure TFMRSS.AddRSS(UrlString:String);
var
 FADDC:TFMADDChannel;
 XMLDoc1:TXMLDocument;
 XMLNode1:IXMLNode;
 j,k:integer;
begin
 FADDC:=TFMADDChannel.Create(self);
 FADDC.Edit1.Text:=UrlString;
 FADDC.ShowModal;
 XMLDoc1:=TXMLDocument.Create(Self);
 XMLDoc1.FileName:=XMLtoHtml;
 XMLDoc1.Active:=True;
 for j:=0 to XMLDoc1.Node.ChildNodes.Count-1 do
  if LowerCase(XMLDoc1.Node.ChildNodes.Nodes[j].NodeName)='rss' then
     Break;
 XMLNode1:=XMLDoc1.Node.ChildNodes.Nodes[j];
 for k:=0 to XMLNode1.ChildNodes.Count-1 do
  if LowerCase(XMLNode1.ChildNodes.Nodes[k].NodeName)='channel' then
     break;
 XMLNode1:=XMLNode1.ChildNodes.Nodes[k];
 RzListView1.Items.Clear;
 ListViewLoadXML(XMLNode1);
 XMLDoc1.Free;
end;

procedure TFMRSS.N40Click(Sender: TObject);
begin
try
 RzSendMessage1.Subject:=RzListView1.Selected.SubItems.Strings[0];
 RzSendMessage1.MessageText.Add('标题：'+RzListView1.Selected.SubItems.Strings[0]);
 RzSendMessage1.MessageText.Add('');
 RzSendMessage1.MessageText.Add('地址：'+RzListView1.Selected.SubItems.Strings[3]);
 RzSendMessage1.MessageText.Add('');
 RzSendMessage1.MessageText.Add('');
 RzSendMessage1.MessageText.Add('敞一扇看世界的窗，触摸时代脉向。');
 RzSendMessage1.MessageText.Add('——ReadWorld聚合新闻阅读器 http://CyqLinux.ku.net');
 RzSendMessage1.MessageText.Add('CyqLinux软件工作室');
 RzSendMessage1.Send;
except
end;
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.
上一页 1 2 3 45
💿 文件大小 929 K
👤 上传用户 IsabellaJ
📂 所属分类 Linux/Unix编程
🏷️ 相关标签

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

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