Finishing an RSS Reader - Full code for the RSS reader
(Page 4 of 4 )
Entire Code:
Main Code:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw, ComCtrls, Buttons, ExtCtrls, ToolWin, ImgList, xmldom, XMLIntf, msxmldom, XMLDoc;
type
TForm1 = class(TForm)
ToolBar1: TToolBar;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
navback: TSpeedButton;
navforward: TSpeedButton;
wbHome: TSpeedButton;
SpeedButton6: TSpeedButton;
wbRefresh: TSpeedButton;
StatusBar1: TStatusBar;
ImageList1: TImageList;
SpeedButton3: TSpeedButton;
XMLDoc: TXMLDocument;
Panel1: TPanel;
tv1: TTreeView;
tvxml: TTreeView;
Panel2: TPanel;
Splitter1: TSplitter;
lv: TListView;
wb: TWebBrowser;
Splitter2: TSplitter;
procedure FormCreate(Sender: TObject);
procedure tv1DblClick(Sender: TObject);
procedure navbackClick(Sender: TObject);
procedure navforwardClick(Sender: TObject);
procedure wbHomeClick(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure wbRefreshClick(Sender: TObject);
procedure wbCommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure wbNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure wbStatusTextChange(Sender: TObject; const Text: WideString);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure tvxmlDblClick(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure refresh2;
end;
const
IMG_NODE_ROOT = 0;
IMG_NODE_CLOSED = 1;
IMG_NODE_OPEN = 2;
var
Form1: TForm1;
fn:string;
implementation
uses addlink, getxml;
{$R *.dfm}
procedure TForm1.refresh2;
var
SomeTxtFile : TextFile;
buffer : string;
begin
form1.tv1.Items.Clear;
//read links from links file ***********************************
with form1.tv1.Items.AddFirst( nil, 'RSS Links' ) do
begin
Selected := true;
{Set the roots image index}
ImageIndex := IMG_NODE_ROOT;
{Set the roots selected index. The same image is
uses as for the ImageIndex}
SelectedIndex := IMG_NODE_ROOT;
end;
if fileexists('links.txt') then begin
AssignFile(SomeTxtFile, 'links.txt');
Reset(SomeTxtFile);
while not EOF(SomeTxtFile) do begin
ReadLn(SomeTxtFile, buffer);
with form1.tv1.Items.AddChildFirst( form1.tv1.Selected, buffer) do
begin
{Set the image used when the node is not selected}
{Set the image used when the node is not selected}
ImageIndex := IMG_NODE_CLOSED;
{Image used when the node is selected}
SelectedIndex := IMG_NODE_OPEN;
MakeVisible;
end;
end;
CloseFile(SomeTxtFile);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
rec:TSearchRec;
SomeTxtFile : TextFile;
buffer : string;
begin
//read links from links file ***********************************
with tv1.Items.AddFirst(nil, 'RSS Links') do
begin
Selected := true;
{Set the roots image index}
ImageIndex := IMG_NODE_ROOT;
{Set the roots selected index. The same image is uses
as for the ImageIndex}
SelectedIndex := IMG_NODE_ROOT;
end;
if fileexists('links.txt') then begin
AssignFile(SomeTxtFile, 'links.txt');
Reset(SomeTxtFile);
while not EOF(SomeTxtFile) do begin
ReadLn(SomeTxtFile, buffer);
with tv1.Items.AddChildFirst( tv1.Selected, buffer) do
begin
{Set the image used when the node is not selected}
{Set the image used when the node is not selected}
ImageIndex := IMG_NODE_CLOSED;
{Image used when the node is selected}
SelectedIndex := IMG_NODE_OPEN;
MakeVisible;
end;
end;
CloseFile(SomeTxtFile);
end //fileexists
else begin
with tv1.Items.AddFirst( nil, 'No RSS Links Found' ) do
begin
Selected := true;
end;
end ;
if not DirectoryExists('MyFeeds') then createdir('MyFeeds');
// find all files matching *.xml in the current dir
if FindFirst('MyFeeds*.xml', faAnyFile, rec) = 0 then
begin
with tvxml.Items.AddFirst(nil, 'MyFeeds') do
begin
Selected:=true;
{Set the roots image index}
ImageIndex := IMG_NODE_ROOT;
{Set the roots selected index. The same image is
uses as for the ImageIndex}
SelectedIndex := IMG_NODE_ROOT;
end;
repeat
with tvxml.Items.AddChildFirst( tvxml.Selected, rec.Name) do
begin
{Set the image used when the node is not selected}
ImageIndex := IMG_NODE_CLOSED;
{Image used when the node is selected}
SelectedIndex := IMG_NODE_OPEN;
MakeVisible;
end;
until FindNext(rec) <> 0;
// Must free up resources used by these successful finds
FindClose(rec);
end
else begin
with tvxml.Items.AddFirst( nil, 'No Files Found' ) do
begin
Selected := true;
end;
end;
end;
procedure TForm1.tv1DblClick(Sender: TObject);
begin
if (tv1.Selected.Level <> 0) then begin
fn:=tv1.Selected.Text;
form1.Caption:='';
form1.Caption:='RSS XML File Reader - '+fn;
wb.Navigate(fn);
end;
end;
procedure TForm1.navbackClick(Sender: TObject);
begin
wb.GoBack;
end;
procedure TForm1.navforwardClick(Sender: TObject);
begin
wb.GoForward;
end;
procedure TForm1.wbHomeClick(Sender: TObject);
begin
wb.GoHome;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
wb.Stop;
end;
procedure TForm1.wbRefreshClick(Sender: TObject);
begin
wb.Refresh;
end;
procedure TForm1.wbCommandStateChange(Sender: TObject; Command: Integer; Enable: WordBool);
begin
case Command of CSC_UPDATECOMMANDS :
begin
//StopBtn.Enabled := Browser.Busy;
wbRefresh.Enabled := not wb.Busy;
end;
CSC_NAVIGATEFORWARD :
begin
navforward.Enabled := Enable;
end;
CSC_NAVIGATEBACK :
begin
navback.Enabled := Enable;
end;
end;
end;
procedure TForm1.wbDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
wbRefresh.Enabled := true;
end;
procedure TForm1.wbNewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
var
NewWindow : TForm1;
begin
NewWindow := TForm1.Create(self);
with NewWindow do begin
ppDisp := wb.Application;
show;
end;
end;
procedure TForm1.wbStatusTextChange(Sender: TObject;
const Text: WideString);
begin
StatusBar1.SimpleText := Text;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
form2.show;
end;
procedure TForm1.tvxmlDblClick(Sender: TObject);
var
StartItemNode : IXMLNode;
ANode : IXMLNode;
STitle, sDesc, sLink : WideString;
begin
LV.Clear;
if (tvxml.Selected.Level <> 0) then begin
fn:=tvxml.Selected.Text;
form1.Caption:='';
form1.Caption:='RSS XML File Reader - '+fn;
if not DirectoryExists('MyFeeds') then CreateDir('MyFeeds');
//points to local XML file in "original" code
XMLDoc.FileName :='MyFeeds'+fn;
XMLDoc.Active:=True;
StartItemNode := XMLDoc.DocumentElement.ChildNodes.First.ChildNodes.FindNode('item') ;
if StartItemNode = nil then begin
showmessage('DAMN!');
exit;
end;
ANode := StartItemNode;
repeat
STitle := ANode.ChildNodes['title'].Text;
sLink := ANode.ChildNodes['link'].Text;
sDesc := ANode.ChildNodes['description'].Text;
//add to list view
with LV.Items.Add do
begin
Caption := STitle;
SubItems.Add(sLink) ;
SubItems.Add(sDesc)
end;
ANode := ANode.NextSibling;
until ANode = nil;
end;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
form3.show;
end;
end.
AddLink Unit:
unit addlink;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm2 = class(TForm)
addfeed: TEdit;
btnAddFeed: TBitBtn;
StaticText1: TStaticText;
procedure btnAddFeedClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses main;
{$R *.dfm}
procedure TForm2.btnAddFeedClick(Sender: TObject);
var
SomeTxtFile : TextFile;
begin
if Fileexists('links.txt') then begin
AssignFile(SomeTxtFile, 'links.txt');
Append(SomeTxtFile);
WriteLn(SomeTxtFile, addfeed.text);
CloseFile(SomeTxtFile);
if MessageDlg('The link - ' + addfeed.text + ' - has now been added. Would you like to add another link?', mtInformation,[mbYes, mbNo], 0) = mrYes then begin
addfeed.Clear;
form1.tv1.Items.Clear;
form1.Refresh2;
end
else begin
form1.tv1.Items.Clear;
form1.Refresh2;
close;
end;
end
else begin
AssignFile(SomeTxtFile, 'links.txt');
Rewrite(SomeTxtFile);
WriteLn(SomeTxtFile, addfeed.text);
CloseFile(SomeTxtFile);
if MessageDlg('The link ' + addfeed.text + ' has now been added. ', mtInformation,[mbYes, mbNo], 0) = mrYes then begin
addfeed.Clear;
form1.tv1.Items.Clear;
form1.Refresh2;
end
else begin
form1.tv1.Items.Clear;
form1.Refresh2;
close;
end;
end;
end;
end.
Unit getxml:
unit getxml;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm3 = class(TForm)
url: TEdit;
btnurl: TBitBtn;
StaticText1: TStaticText;
IdHTTP1: TIdHTTP;
procedure btnurlClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses main;
{$R *.dfm}
procedure TForm3.btnurlClick(Sender: TObject);
var
FStream: TFileStream;
begin
FStream := TFileStream.Create('feed.xml', fmCreate);
try
IdHTTP1.Get(url.Text, FStream);
finally
FStream.Free;
form1.wb.Navigate(url.Text);
end;
close;
end;
end.
| DISCLAIMER: The content provided in this article is not warranted or guaranteed by Developer Shed, Inc. The content provided is intended for entertainment and/or educational purposes in order to introduce to the reader key ideas, concepts, and/or product reviews. As such it is incumbent upon the reader to employ real-world tactics for security and implementation of best practices. We are not liable for any negative consequences that may result from implementing any information covered in our articles or tutorials. If this is a hardware review, it is not recommended to open and/or modify your hardware. |
