Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/Favorite.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download) (as text)
Sun Sep 21 08:46:17 2003 UTC (20 years, 7 months ago) by yoffy
Branch: MAIN
CVS Tags: b41, b40, b43
Branch point for: stable
Changes since 1.2: +1 -1 lines
File MIME type: text/x-pascal
・コード整理

1 unit Favorite;
2
3 interface
4
5 uses
6 Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,} YofUtils,
7 GikoSystem{, XMLIntf, XMLDoc}, GikoXMLDoc;
8 {SAX, SAXHelpers, SAXComps, SAXKW;}
9
10 type
11 TFavoriteFolder = class
12 end;
13
14 TFavoriteBoardItem = class
15 private
16 FBBSID: string;
17 FBoardName: string;
18 public
19 property BBSID: string read FBBSID write FBBSID;
20 property BoardName: string read FBoardName write FBoardName;
21 end;
22
23 TFavoriteThreadItem = class
24 private
25 FBBSID: string;
26 FThreadID: string;
27 FThreadName: string;
28 public
29 property BBSID: string read FBBSID write FBBSID;
30 property ThreadID: string read FThreadID write FThreadID;
31 property ThreadName: string read FThreadName write FThreadName;
32 end;
33
34 TFavoriteDM = class(TDataModule)
35 procedure DataModuleCreate(Sender: TObject);
36 procedure DataModuleDestroy(Sender: TObject);
37 private
38 { Private ?辿?転 }
39 FStack: TStack;
40 FTreeView: TTreeView;
41
42 procedure ReadNode(Node: IXMLNode);
43 procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
44 // procedure AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
45 // procedure SAXStartDocument(Sender: TObject);
46 // procedure SAXEndDocument(Sender: TObject);
47 // procedure SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; const Atts: IAttributes);
48 // procedure SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
49 // procedure SAXCharacters(Sender: TObject; const PCh: SAXString);
50 public
51 { Public ?辿?転 }
52 procedure SetFavTreeView(TreeView: TTreeView);
53 procedure ReadFavorite;
54 procedure WriteFavorite;
55 property TreeView: TTreeView read FTreeView;
56 end;
57
58 var
59 FavoriteDM: TFavoriteDM;
60 const
61 FAVORITE_LINK_NAME = '?????N';
62
63 implementation
64
65 const
66 FAVORITE_ROOT_NAME = '?即?C???端??';
67 FAVORITE_FILE_NAME = 'Favorite.xml';
68
69 {$R *.dfm}
70
71 procedure TFavoriteDM.DataModuleCreate(Sender: TObject);
72 begin
73 //FTreeView := TreeView;
74 //FTreeView := GikoForm.FavoriteTreeView;
75 end;
76
77 procedure TFavoriteDM.DataModuleDestroy(Sender: TObject);
78 var
79 i: Integer;
80 begin
81 for i := 0 to TreeView.Items.Count - 1 do begin
82 TObject(TreeView.Items[i].Data).Free;
83 end;
84 end;
85
86 procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
87 begin
88 FTreeView := TreeView;
89 end;
90
91 procedure TFavoriteDM.ReadFavorite;
92 var
93 FileName: string;
94 XMLDoc: IXMLDocument;
95 XMLNode: IXMLNode;
96 Node: TTreeNode;
97 i: Integer;
98 FavFolder: TFavoriteFolder;
99 LinkExists: Boolean;
100 begin
101
102 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
103
104 FavFolder := TFavoriteFolder.Create;
105 Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
106 Node.ImageIndex := 14;
107 Node.SelectedIndex := 14;
108
109 if FileExists(FileName) then begin
110 try
111 XMLDoc := LoadXMLDocument(FileName);
112 XMLNode := XMLDoc.DocumentElement;
113
114 FStack := TStack.Create;
115 try
116 FStack.Push(Node);
117 LinkExists := False;
118 if XMLNode.NodeName = 'favorite' then begin
119 for i := 0 to XMLNode.ChildNodes.Count - 1 do begin
120 ReadNode(XMLNode.ChildNodes[i]);
121 if (XMLNode.ChildNodes[i].NodeName = 'folder') and
122 (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
123 LinkExists := True;
124 end;
125 end;
126 end;
127 if not LinkExists then begin
128 FavFolder := TFavoriteFolder.Create;
129 Node := FTreeView.Items.AddChildObject(Node, FAVORITE_LINK_NAME, FavFolder);
130 Node.ImageIndex := 14;
131 Node.SelectedIndex := 14;
132 end;
133 finally
134 FStack.Free;
135 end;
136 except
137 end;
138 end;
139
140 {
141 FavFolder := TFavoriteFolder.Create;
142 Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
143 Node.ImageIndex := 12;
144 Node.SelectedIndex := 13;
145
146 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
147 if not FileExists(FileName) then
148 Exit;
149
150 FavSAXHandler.OnStartDocument := SAXStartDocument;
151 FavSAXHandler.OnEndDocument := SAXEndDocument;
152 FavSAXHandler.OnStartElement := SAXStartElement;
153 FavSAXHandler.OnStartElement := SAXStartElement;
154 FavSAXHandler.OnEndElement := SAXEndElement;
155 FavSAXHandler.OnCharacters := SAXCharacters;
156
157 FavSAXReader.Vendor := 'Keith Wood';
158 FavSAXReader.URL := FileName;
159 FavSAXReader.Parse;}
160 end;
161
162 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
163 var
164 i: Integer;
165
166 ParentNode: TTreeNode;
167 CurrentNode: TTreeNode;
168 FavFolder: TFavoriteFolder;
169 FavBoard: TFavoriteBoardItem;
170 FavThread: TFavoriteThreadItem;
171 begin
172 if Node.NodeName = 'folder' then begin
173 ParentNode := FStack.Peek;
174 if TObject(ParentNode.Data) is TFavoriteFolder then begin
175 FavFolder := TFavoriteFolder.Create;
176 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
177 CurrentNode.ImageIndex := 14;
178 CurrentNode.SelectedIndex := 14;
179 FStack.Push(CurrentNode);
180 end;
181 for i := 0 to Node.ChildNodes.Count - 1 do begin
182 ReadNode(Node.ChildNodes[i]);
183 end;
184 if FStack.Count <> 0 then
185 FStack.Pop;
186 end else if Node.NodeName = 'favitem' then begin
187 ParentNode := FStack.Peek;
188 if TObject(ParentNode.Data) is TFavoriteFolder then begin
189 if Node.Attributes['favtype'] = 'board' then begin
190 FavBoard := TFavoriteBoardItem.Create;
191 FavBoard.BBSID := Node.Attributes['bbs'];
192 FavBoard.BoardName := Node.Attributes['boardname'];
193 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
194 CurrentNode.ImageIndex := 15;
195 CurrentNode.SelectedIndex := 15;
196 end else if Node.Attributes['favtype'] = 'thread' then begin
197 FavThread := TFavoriteThreadItem.Create;
198 FavThread.BBSID := Node.Attributes['bbs'];
199 FavThread.ThreadID := Node.Attributes['thread'];
200 FavThread.ThreadName := Node.Attributes['threadname'];
201 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
202 CurrentNode.ImageIndex := 16;
203 CurrentNode.SelectedIndex := 16;
204 end;
205 end;
206 end;
207 end;
208
209 procedure TFavoriteDM.WriteFavorite;
210 {
211 var
212 FileName: string;
213 // SaveList: TStringList;
214 // i: Integer;
215 // Count: Integer;
216
217 XMLDoc: IXMLDocument;
218 XMLNode: IXMLNode;
219 // FavoNode: IXMLNode;
220 begin
221 XMLDoc := NewXMLDocument;
222 XMLDoc.Encoding := 'Shift_JIS';
223 XMLDoc.StandAlone := 'yes';
224 XMLNode := XMLDoc.AddChild('favorite');
225 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
226 AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
227 XMLDoc.SaveToFile(FileName);
228 }
229 var
230 FileName: string;
231 SaveList: TStringList;
232 begin
233 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
234 SaveList := TStringList.Create;
235 try
236 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
237 SaveList.Add('<favorite>');
238 AddSaveString(TreeView.Items.GetFirstNode, SaveList);
239 SaveList.Add('</favorite>');
240 SaveList.SaveToFile(FileName);
241 finally
242 SaveList.Free;
243 end;
244 end;
245
246 {
247 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
248 var
249 i: Integer;
250 // s: string;
251 FavBoard: TFavoriteBoardItem;
252 FavThread: TFavoriteThreadItem;
253 FavNode: IXMLNode;
254 begin
255 for i := 0 to Node.Count - 1 do begin
256 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
257 FavNode := XMLNode.AddChild('folder');
258 FavNode.Attributes['title'] := Node.Item[i].Text;
259 AddSaveString(Node.Item[i], FavNode);
260 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
261 FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
262 FavNode := XMLNode.AddChild('favitem');
263 FavNode.Attributes['type'] := '2ch';
264 FavNode.Attributes['favtype'] := 'board';
265 FavNode.Attributes['bbs'] := FavBoard.BBSID;
266 FavNode.Attributes['title'] := Node.Item[i].Text;
267 FavNode.Attributes['boardname'] := FavBoard.BoardName;
268 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
269 FavThread := TFavoriteThreadItem(Node.Item[i].Data);
270 FavNode := XMLNode.AddChild('favitem');
271 FavNode.Attributes['type'] := '2ch';
272 FavNode.Attributes['favtype'] := 'thread';
273 FavNode.Attributes['bbs'] := FavThread.BBSID;
274 FavNode.Attributes['thread'] := FavThread.ThreadID;
275 FavNode.Attributes['title'] := Node.Item[i].Text;
276 FavNode.Attributes['threadname'] := FavThread.ThreadName;
277 end;
278 end;
279 end;
280 }
281
282 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
283 var
284 i: Integer;
285 s: string;
286 FavBoard: TFavoriteBoardItem;
287 FavThread: TFavoriteThreadItem;
288 begin
289 for i := 0 to Node.Count - 1 do begin
290 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
291 s := Format('<folder title="%s">', [HtmlEncode(Node.Item[i].Text)]);
292 SaveList.Add(s);
293 AddSaveString(Node.Item[i], SaveList);
294 SaveList.Add('</folder>');
295 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
296 FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
297 s := Format('<favitem type="2ch" favtype="board" bbs="%s" title="%s" boardname="%s"/>',
298 [FavBoard.BBSID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavBoard.BoardName)]);
299 SaveList.Add(s);
300 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
301 FavThread := TFavoriteThreadItem(Node.Item[i].Data);
302 s := Format('<favitem type="2ch" favtype="thread" bbs="%s" thread="%s" title="%s" threadname="%s"/>',
303 [FavThread.BBSID, FavThread.ThreadID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavThread.ThreadName)]);
304 SaveList.Add(s);
305 end;
306 end;
307 end;
308
309 {
310 procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
311 begin
312 FStack := TStack.Create;
313 FStack.Push(FTreeView.Items.GetFirstNode);
314 end;
315
316 procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
317 begin
318 FStack.Free;
319 end;
320
321 procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
322 const Atts: IAttributes);
323 var
324 FavType: string;
325 ParentNode: TTreeNode;
326 CurrentNode: TTreeNode;
327 FavFolder: TFavoriteFolder;
328 FavBoard: TFavoriteBoardItem;
329 FavThread: TFavoriteThreadItem;
330 begin
331 if QName = 'folder' then begin
332 ParentNode := FStack.Peek;
333 if TObject(ParentNode.Data) is TFavoriteFolder then begin
334 FavFolder := TFavoriteFolder.Create;
335 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
336 CurrentNode.ImageIndex := 12;
337 CurrentNode.SelectedIndex := 13;
338 FStack.Push(CurrentNode);
339 end;
340 end else if QName = 'favitem' then begin
341 ParentNode := FStack.Peek;
342 if TObject(ParentNode.Data) is TFavoriteFolder then begin
343 FavType := Atts.getValue('favtype');
344 if FavType = 'board' then begin
345 FavBoard := TFavoriteBoardItem.Create;
346 FavBoard.BBSID := Atts.getValue('bbs');
347 FavBoard.BoardName := Atts.getValue('boardname');
348 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
349 CurrentNode.ImageIndex := 14;
350 CurrentNode.SelectedIndex := 15;
351 end else if FavType = 'thread' then begin
352 FavThread := TFavoriteThreadItem.Create;
353 FavThread.BBSID := Atts.getValue('bbs');
354 FavThread.ThreadID := Atts.getValue('thread');
355 FavThread.ThreadName := Atts.getValue('threadname');
356 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
357 CurrentNode.ImageIndex := 16;
358 CurrentNode.SelectedIndex := 17;
359 end;
360 end;
361 end;
362 end;
363
364 procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
365 begin
366 if QName = 'folder' then begin
367 if FStack.Count <> 0 then
368 FStack.Pop;
369 end;
370 end;
371
372 procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
373 begin
374 //
375 end;
376 }
377 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26