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.1 - (show annotations) (download) (as text)
Sat Aug 9 13:50:43 2003 UTC (20 years, 8 months ago) by hi_
Branch: MAIN
Branch point for: hi
File MIME type: text/x-pascal
Initial revision

1 unit Favorite;
2
3 interface
4
5 uses
6 Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,}
7 GikoSystem, XMLIntf, XMLDoc;
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 Node: TTreeNode;
95 FavFolder: TFavoriteFolder;}
96 var
97 FileName: string;
98 XMLDoc: IXMLDocument;
99 XMLNode: IXMLNode;
100 Node: TTreeNode;
101 i: Integer;
102 FavFolder: TFavoriteFolder;
103 LinkExists: Boolean;
104 begin
105 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
106
107 FavFolder := TFavoriteFolder.Create;
108 Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
109 Node.ImageIndex := 12;
110 Node.SelectedIndex := 13;
111
112 if FileExists(FileName) then begin
113 XMLDoc := LoadXMLDocument(FileName);
114 XMLNode := XMLDoc.DocumentElement;
115
116 FStack := TStack.Create;
117 try
118 FStack.Push(Node);
119 LinkExists := False;
120 if XMLNode.NodeName = 'favorite' then begin
121 for i := 0 to XMLNode.ChildNodes.Count - 1 do begin
122 ReadNode(XMLNode.ChildNodes[i]);
123 if (XMLNode.ChildNodes[i].NodeName = 'folder') and
124 (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
125 LinkExists := True;
126 end;
127 end;
128 end;
129 if not LinkExists then begin
130 FavFolder := TFavoriteFolder.Create;
131 Node := FTreeView.Items.AddChildObject(Node, FAVORITE_LINK_NAME, FavFolder);
132 Node.ImageIndex := 12;
133 Node.SelectedIndex := 13;
134 end;
135 finally
136 FStack.Free;
137 end;
138 end;
139
140 { FavFolder := TFavoriteFolder.Create;
141 Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
142 Node.ImageIndex := 12;
143 Node.SelectedIndex := 13;
144
145 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
146 if not FileExists(FileName) then
147 Exit;
148
149 FavSAXHandler.OnStartDocument := SAXStartDocument;
150 FavSAXHandler.OnEndDocument := SAXEndDocument;
151 FavSAXHandler.OnStartElement := SAXStartElement;
152 FavSAXHandler.OnStartElement := SAXStartElement;
153 FavSAXHandler.OnEndElement := SAXEndElement;
154 FavSAXHandler.OnCharacters := SAXCharacters;
155
156 FavSAXReader.Vendor := 'Keith Wood';
157 FavSAXReader.URL := FileName;
158 FavSAXReader.Parse;}
159 end;
160
161 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
162 var
163 i: Integer;
164
165 ParentNode: TTreeNode;
166 CurrentNode: TTreeNode;
167 FavFolder: TFavoriteFolder;
168 FavBoard: TFavoriteBoardItem;
169 FavThread: TFavoriteThreadItem;
170 begin
171 if Node.NodeName = 'folder' then begin
172 ParentNode := FStack.Peek;
173 if TObject(ParentNode.Data) is TFavoriteFolder then begin
174 FavFolder := TFavoriteFolder.Create;
175 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
176 CurrentNode.ImageIndex := 12;
177 CurrentNode.SelectedIndex := 13;
178 FStack.Push(CurrentNode);
179 end;
180 for i := 0 to Node.ChildNodes.Count - 1 do begin
181 ReadNode(Node.ChildNodes[i]);
182 end;
183 if FStack.Count <> 0 then
184 FStack.Pop;
185 end else if Node.NodeName = 'favitem' then begin
186 ParentNode := FStack.Peek;
187 if TObject(ParentNode.Data) is TFavoriteFolder then begin
188 if Node.Attributes['favtype'] = 'board' then begin
189 FavBoard := TFavoriteBoardItem.Create;
190 FavBoard.BBSID := Node.Attributes['bbs'];
191 FavBoard.BoardName := Node.Attributes['boardname'];
192 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
193 CurrentNode.ImageIndex := 14;
194 CurrentNode.SelectedIndex := 15;
195 end else if Node.Attributes['favtype'] = 'thread' then begin
196 FavThread := TFavoriteThreadItem.Create;
197 FavThread.BBSID := Node.Attributes['bbs'];
198 FavThread.ThreadID := Node.Attributes['thread'];
199 FavThread.ThreadName := Node.Attributes['threadname'];
200 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
201 CurrentNode.ImageIndex := 16;
202 CurrentNode.SelectedIndex := 17;
203 end;
204 end;
205 end;
206 end;
207
208 procedure TFavoriteDM.WriteFavorite;
209 var
210 FileName: string;
211 // SaveList: TStringList;
212 // i: Integer;
213 // Count: Integer;
214
215 XMLDoc: IXMLDocument;
216 XMLNode: IXMLNode;
217 // FavoNode: IXMLNode;
218 begin
219 XMLDoc := NewXMLDocument;
220 XMLDoc.Encoding := 'Shift_JIS';
221 XMLDoc.StandAlone := 'yes';
222 XMLNode := XMLDoc.AddChild('favorite');
223 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
224 AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
225 XMLDoc.SaveToFile(FileName);
226 {var
227 FileName: string;
228 SaveList: TStringList;
229 begin
230 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
231 SaveList := TStringList.Create;
232 try
233 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
234 SaveList.Add('<favorite>');
235 AddSaveString(TreeView.Items.GetFirstNode, SaveList);
236 SaveList.Add('</favorite>');
237 SaveList.SaveToFile(FileName);
238 finally
239 SaveList.Free;
240 end;}
241 end;
242
243 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
244 var
245 i: Integer;
246 // s: string;
247 FavBoard: TFavoriteBoardItem;
248 FavThread: TFavoriteThreadItem;
249 FavNode: IXMLNode;
250 begin
251 for i := 0 to Node.Count - 1 do begin
252 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
253 FavNode := XMLNode.AddChild('folder');
254 FavNode.Attributes['title'] := Node.Item[i].Text;
255 AddSaveString(Node.Item[i], FavNode);
256 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
257 FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
258 FavNode := XMLNode.AddChild('favitem');
259 FavNode.Attributes['type'] := '2ch';
260 FavNode.Attributes['favtype'] := 'board';
261 FavNode.Attributes['bbs'] := FavBoard.BBSID;
262 FavNode.Attributes['title'] := Node.Item[i].Text;
263 FavNode.Attributes['boardname'] := FavBoard.BoardName;
264 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
265 FavThread := TFavoriteThreadItem(Node.Item[i].Data);
266 FavNode := XMLNode.AddChild('favitem');
267 FavNode.Attributes['type'] := '2ch';
268 FavNode.Attributes['favtype'] := 'thread';
269 FavNode.Attributes['bbs'] := FavThread.BBSID;
270 FavNode.Attributes['thread'] := FavThread.ThreadID;
271 FavNode.Attributes['title'] := Node.Item[i].Text;
272 FavNode.Attributes['threadname'] := FavThread.ThreadName;
273 end;
274 end;
275 end;
276
277 {procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
278 var
279 i: Integer;
280 s: string;
281 FavBoard: TFavoriteBoardItem;
282 FavThread: TFavoriteThreadItem;
283 begin
284 for i := 0 to Node.Count - 1 do begin
285 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
286 s := Format('<folder title="%s">', [HtmlEncode(Node.Item[i].Text)]);
287 SaveList.Add(s);
288 AddSaveString(Node.Item[i], SaveList);
289 SaveList.Add('</folder>');
290 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
291 FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
292 s := Format('<favitem type="2ch" favtype="board" bbs="%s" title="%s" boardname="%s"/>',
293 [FavBoard.BBSID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavBoard.BoardName)]);
294 SaveList.Add(s);
295 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
296 FavThread := TFavoriteThreadItem(Node.Item[i].Data);
297 s := Format('<favitem type="2ch" favtype="thread" bbs="%s" thread="%s" title="%s" threadname="%s"/>',
298 [FavThread.BBSID, FavThread.ThreadID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavThread.ThreadName)]);
299 SaveList.Add(s);
300 end;
301 end;
302 end;}
303
304 {
305 procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
306 begin
307 FStack := TStack.Create;
308 FStack.Push(FTreeView.Items.GetFirstNode);
309 end;
310
311 procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
312 begin
313 FStack.Free;
314 end;
315
316 procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
317 const Atts: IAttributes);
318 var
319 FavType: string;
320 ParentNode: TTreeNode;
321 CurrentNode: TTreeNode;
322 FavFolder: TFavoriteFolder;
323 FavBoard: TFavoriteBoardItem;
324 FavThread: TFavoriteThreadItem;
325 begin
326 if QName = 'folder' then begin
327 ParentNode := FStack.Peek;
328 if TObject(ParentNode.Data) is TFavoriteFolder then begin
329 FavFolder := TFavoriteFolder.Create;
330 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
331 CurrentNode.ImageIndex := 12;
332 CurrentNode.SelectedIndex := 13;
333 FStack.Push(CurrentNode);
334 end;
335 end else if QName = 'favitem' then begin
336 ParentNode := FStack.Peek;
337 if TObject(ParentNode.Data) is TFavoriteFolder then begin
338 FavType := Atts.getValue('favtype');
339 if FavType = 'board' then begin
340 FavBoard := TFavoriteBoardItem.Create;
341 FavBoard.BBSID := Atts.getValue('bbs');
342 FavBoard.BoardName := Atts.getValue('boardname');
343 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
344 CurrentNode.ImageIndex := 14;
345 CurrentNode.SelectedIndex := 15;
346 end else if FavType = 'thread' then begin
347 FavThread := TFavoriteThreadItem.Create;
348 FavThread.BBSID := Atts.getValue('bbs');
349 FavThread.ThreadID := Atts.getValue('thread');
350 FavThread.ThreadName := Atts.getValue('threadname');
351 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
352 CurrentNode.ImageIndex := 16;
353 CurrentNode.SelectedIndex := 17;
354 end;
355 end;
356 end;
357 end;
358
359 procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
360 begin
361 if QName = 'folder' then begin
362 if FStack.Count <> 0 then
363 FStack.Pop;
364 end;
365 end;
366
367 procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
368 begin
369 //
370 end;
371 }
372 end.

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