Sign in Join
Wiki copytemporary

RSS/fr: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: RSS/fr

OldNewLine
1+## Vue d'ensemble
2+
3+C'est une petite unité que Gints a écrit pour lire des flux RSS, en souhaitant qu'elle soit utile.
4+
5+## Code de l'unité RSS
6+
7+``` pascal
8+unit rss;
9+
10+{$mode objfpc}{$H+}
11+
12+interface
13+
14+uses
15+ Classes, SysUtils,
16+ lNetComponents, lNet, lhttp, lHTTPUtil, DOM, XMLRead, db;
17+
18+const
19+ RSSXML_RSS = 'rss';
20+ RSSXML_CHANNEL = 'channel';
21+ RSSXML_ITEM = 'item';
22+ RSSXML_TITLE = 'title';
23+ RSSXML_LINK = 'link';
24+ RSSXML_DESCRIPTION = 'description';
25+ RSSXML_PUBDATE = 'pubDate';
26+ RSSXML_COMMENTS = 'comments';
27+
28+type
29+
30+ { TFeedItem }
31+
32+ TFeedItem = class(TObject)
33+ private
34+ fTitle, fLink, fComments : String;
35+ fDescription: TStringList;
36+ fPubDate: TDateTime;
37+ public
38+ constructor create();
39+ destructor destroy(); override;
40+ class function CreateFromNode(aNode: TDOMNode): TFeedItem;
41+ property Title : String read fTitle write fTitle;
42+ property Link : String read fLink write fLink;
43+ property Comments : String read fComments write fComments;
44+ property Description : TStringList read fDescription write fDescription;
45+ end;
46+
47+ TFeedReadState = (frReady, frRequest, frParse, frSave, frDone, frError);
48+
49+ // Callback for result report
50+ TRSSResultEvent = procedure(const aFeedID: string) of object;
51+
52+ { TRssFeed }
53+
54+ TRssFeed = class(TObject)
55+ private
56+ fTitle, fLink, fLanguage, fError, fFeedID: String;
57+ fDescription: TStringList;
58+ fItems: TList;
59+ fXmlString: TStringList;
60+ fReadState: TFeedReadState;
61+ HTTPClient: TLHTTPClientComponent;
62+ HTTPBuffer: string;
63+ fDoc : TXMLDocument;
64+ fOnResult: TRSSResultEvent;
65+ fDatabase: TDatabase;
66+ procedure AddItem(aItem : TFeedItem);
67+ procedure ClearItems;
68+ procedure HTTPClientError(const msg: string; aSocket: TLSocket);
69+ function HTTPClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; ASize: integer): integer;
70+ procedure HTTPClientDisconnect(aSocket: TLSocket);
71+ public
72+ constructor create(aLink: String; aFeedID: string; aDatabase: TDatabase);
73+ destructor destroy(); override;
74+ procedure RssRead;
75+ property Title: String read fTitle write fTitle;
76+ property Language: String read fLanguage write fLanguage;
77+ property Link: String read fLink write fLink;
78+ property Description: TStringList read fDescription write fDescription;
79+ property Items: TList read fItems write fItems;
80+ property ReadState: TFeedReadState read fReadState;
81+ property OnResult: TRSSResultEvent read fOnResult write fOnResult;
82+ end;
83+
84+implementation
85+
86+{ TFeedItem }
87+
88+constructor TFeedItem.create();
89+begin
90+ fDescription := TStringList.Create;
91+end;
92+
93+destructor TFeedItem.destroy;
94+begin
95+ FreeAndNil(fDescription);
96+ inherited destroy;
97+end;
98+
99+class function TFeedItem.CreateFromNode(aNode: TDOMNode): TFeedItem;
100+var
101+ propertynode: TDOMNode;
102+begin
103+ Result := TFeedItem.Create();
104+ propertynode := aNode.FindNode(RSSXML_TITLE);
105+ if propertynode <> nil then
106+ Result.fTitle := propertynode.TextContent;
107+ propertynode := aNode.FindNode(RSSXML_LINK);
108+ if propertynode <> nil then
109+ Result.fLink := propertynode.TextContent;
110+ propertynode := aNode.FindNode(RSSXML_DESCRIPTION);
111+ if propertynode <> nil then
112+ Result.fDescription.Text := propertynode.TextContent;
113+ propertynode := aNode.FindNode(RSSXML_COMMENTS);
114+ if propertynode <> nil then
115+ Result.fComments := propertynode.TextContent;
116+end;
117+
118+{ TRssFeed }
119+
120+procedure TRssFeed.AddItem(aItem: TFeedItem);
121+begin
122+ fItems.Add(aItem);
123+end;
124+
125+procedure TRssFeed.ClearItems;
126+var
127+ i: Integer;
128+ Item: TFeedItem;
129+begin
130+ for i := 0 to fItems.Count - 1 do
131+ begin
132+ Item := TFeedItem(fItems[0]);
133+ FreeAndNil(Item);
134+ end;
135+ fItems.Clear;
136+end;
137+
138+procedure TRssFeed.HTTPClientError(const msg: string; aSocket: TLSocket);
139+begin
140+ fError := msg;
141+ fReadState := frError;
142+end;
143+
144+function TRssFeed.HTTPClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar;
145+ ASize: integer): integer;
146+var
147+ oldLength: dword;
148+begin
149+ oldLength := Length(HTTPBuffer);
150+ setlength(HTTPBuffer,oldLength + ASize);
151+ move(ABuffer^,HTTPBuffer[oldLength + 1], ASize);
152+ Result := aSize; // tell the http buffer we read it all
153+end;
154+
155+procedure TRssFeed.HTTPClientDisconnect(aSocket: TLSocket);
156+var
157+ S: TStringStream;
158+ channel, propertynode: TDOMNode;
159+ newsitem: TFeedItem;
160+begin
161+ fReadState:= frParse;
162+ try
163+ S := TStringStream.Create('');
164+ try
165+ ReadXMLFile(fDoc, S);
166+ finally
167+ S.Free;
168+ end;
169+ except
170+ on E : Exception do
171+ begin
172+ fReadState:= frError;
173+ fError := E.Message;
174+ Exit;
175+ end;
176+ end;
177+ if ((fDoc.documentElement.nodeName = RSSXML_RSS) and
178+ (fDoc.documentElement.hasChildNodes)) then
179+ begin
180+ channel := fDoc.DocumentElement.FindNode(RSSXML_CHANNEL);
181+ if channel <> nil then
182+ begin
183+ propertynode := channel.FindNode(RSSXML_TITLE);
184+ if propertynode <> nil then
185+ fTitle := propertynode.TextContent;
186+ propertynode := channel.FindNode(RSSXML_LINK);
187+ if propertynode <> nil then
188+ fLink := propertynode.TextContent;
189+ propertynode := channel.FindNode(RSSXML_DESCRIPTION);
190+ if propertynode <> nil then
191+ fDescription.Text := propertynode.TextContent;
192+ propertynode := channel.FindNode(RSSXML_ITEM);
193+ while propertynode <> nil do
194+ begin
195+ newsitem:= TFeedItem.CreateFromNode(propertynode);
196+ AddItem(newsitem);
197+ propertynode := propertynode.NextSibling;
198+ end;
199+ end;
200+ end;
201+ fReadState:= frSave;
202+end;
203+
204+constructor TRssFeed.create(aLink: String; aFeedID: string; aDatabase: TDatabase);
205+begin
206+ fFeedID := aFeedID;
207+ fLink := aLink;
208+ fDatabase := aDatabase;
209+ fReadState := frReady;
210+ fDescription := TStringList.Create;
211+ fItems := TList.Create;
212+ HTTPClient := TLHTTPClientComponent.Create(nil);
213+ fDoc := TXMLDocument.create;
214+end;
215+
216+destructor TRssFeed.destroy;
217+begin
218+ ClearItems;
219+ FreeAndNil(fDescription);
220+ FreeAndNil(HTTPClient);
221+ FreeAndNil(fDoc);
222+ inherited destroy;
223+end;
224+
225+procedure TRssFeed.RssRead;
226+var
227+ aHost, aURI: String;
228+ aPort: Word;
229+begin
230+ DecomposeURL(fLink, aHost, aURI, aPort);
231+ HTTPClient.Host:= aHost;
232+ HTTPClient.Port:= aPort;
233+ HTTPClient.URI:= aURI;
234+ HTTPClient.OnError:= @HTTPClientError;
235+ HTTPClient.OnInput:= @HTTPClientInput;
236+ HTTPClient.OnDisconnect:= @HTTPClientDisconnect;
237+ HTTPClient.SendRequest;
238+ fReadState:= frRequest;
239+end;
240+
241+end.
242+```
243+
244+---
245+*From the Free Pascal wiki, page "RSS/fr", as it stood on 2020-05-01 after a change by E-ric, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history