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.4 - (show annotations) (download) (as text)
Fri Nov 14 17:29:59 2003 UTC (20 years, 5 months ago) by h677
Branch: MAIN
Changes since 1.3: +29 -0 lines
File MIME type: text/x-pascal
お気に入り(Favorite.xml)のエクスポートをメニューのファイルのところに追加

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 function GetFavoriteFilePath() : String;
53 function SaveFavoriteFile(FileName: String) : Boolean;
54 procedure SetFavTreeView(TreeView: TTreeView);
55 procedure ReadFavorite;
56 procedure WriteFavorite;
57 property TreeView: TTreeView read FTreeView;
58 end;
59
60 var
61 FavoriteDM: TFavoriteDM;
62 const
63 FAVORITE_LINK_NAME = '?????N';
64
65 implementation
66
67 const
68 FAVORITE_ROOT_NAME = '?即?C???端??';
69 FAVORITE_FILE_NAME = 'Favorite.xml';
70
71 {$R *.dfm}
72
73 procedure TFavoriteDM.DataModuleCreate(Sender: TObject);
74 begin
75 //FTreeView := TreeView;
76 //FTreeView := GikoForm.FavoriteTreeView;
77 end;
78
79 procedure TFavoriteDM.DataModuleDestroy(Sender: TObject);
80 var
81 i: Integer;
82 begin
83 for i := 0 to TreeView.Items.Count - 1 do begin
84 TObject(TreeView.Items[i].Data).Free;
85 end;
86 end;
87
88 procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
89 begin
90 FTreeView := TreeView;
91 end;
92
93 procedure TFavoriteDM.ReadFavorite;
94 var
95 FileName: string;
96 XMLDoc: IXMLDocument;
97 XMLNode: IXMLNode;
98 Node: TTreeNode;
99 i: Integer;
100 FavFolder: TFavoriteFolder;
101 LinkExists: Boolean;
102 begin
103
104 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
105
106 FavFolder := TFavoriteFolder.Create;
107 Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
108 Node.ImageIndex := 14;
109 Node.SelectedIndex := 14;
110
111 if FileExists(FileName) then begin
112 try
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 := 14;
133 Node.SelectedIndex := 14;
134 end;
135 finally
136 FStack.Free;
137 end;
138 except
139 end;
140 end;
141
142 {
143 FavFolder := TFavoriteFolder.Create;
144 Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
145 Node.ImageIndex := 12;
146 Node.SelectedIndex := 13;
147
148 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
149 if not FileExists(FileName) then
150 Exit;
151
152 FavSAXHandler.OnStartDocument := SAXStartDocument;
153 FavSAXHandler.OnEndDocument := SAXEndDocument;
154 FavSAXHandler.OnStartElement := SAXStartElement;
155 FavSAXHandler.OnStartElement := SAXStartElement;
156 FavSAXHandler.OnEndElement := SAXEndElement;
157 FavSAXHandler.OnCharacters := SAXCharacters;
158
159 FavSAXReader.Vendor := 'Keith Wood';
160 FavSAXReader.URL := FileName;
161 FavSAXReader.Parse;}
162 end;
163
164 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
165 var
166 i: Integer;
167
168 ParentNode: TTreeNode;
169 CurrentNode: TTreeNode;
170 FavFolder: TFavoriteFolder;
171 FavBoard: TFavoriteBoardItem;
172 FavThread: TFavoriteThreadItem;
173 begin
174 if Node.NodeName = 'folder' then begin
175 ParentNode := FStack.Peek;
176 if TObject(ParentNode.Data) is TFavoriteFolder then begin
177 FavFolder := TFavoriteFolder.Create;
178 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
179 CurrentNode.ImageIndex := 14;
180 CurrentNode.SelectedIndex := 14;
181 FStack.Push(CurrentNode);
182 end;
183 for i := 0 to Node.ChildNodes.Count - 1 do begin
184 ReadNode(Node.ChildNodes[i]);
185 end;
186 if FStack.Count <> 0 then
187 FStack.Pop;
188 end else if Node.NodeName = 'favitem' then begin
189 ParentNode := FStack.Peek;
190 if TObject(ParentNode.Data) is TFavoriteFolder then begin
191 if Node.Attributes['favtype'] = 'board' then begin
192 FavBoard := TFavoriteBoardItem.Create;
193 FavBoard.BBSID := Node.Attributes['bbs'];
194 FavBoard.BoardName := Node.Attributes['boardname'];
195 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
196 CurrentNode.ImageIndex := 15;
197 CurrentNode.SelectedIndex := 15;
198 end else if Node.Attributes['favtype'] = 'thread' then begin
199 FavThread := TFavoriteThreadItem.Create;
200 FavThread.BBSID := Node.Attributes['bbs'];
201 FavThread.ThreadID := Node.Attributes['thread'];
202 FavThread.ThreadName := Node.Attributes['threadname'];
203 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
204 CurrentNode.ImageIndex := 16;
205 CurrentNode.SelectedIndex := 16;
206 end;
207 end;
208 end;
209 end;
210
211 procedure TFavoriteDM.WriteFavorite;
212 {
213 var
214 FileName: string;
215 // SaveList: TStringList;
216 // i: Integer;
217 // Count: Integer;
218
219 XMLDoc: IXMLDocument;
220 XMLNode: IXMLNode;
221 // FavoNode: IXMLNode;
222 begin
223 XMLDoc := NewXMLDocument;
224 XMLDoc.Encoding := 'Shift_JIS';
225 XMLDoc.StandAlone := 'yes';
226 XMLNode := XMLDoc.AddChild('favorite');
227 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
228 AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
229 XMLDoc.SaveToFile(FileName);
230 }
231 var
232 FileName: string;
233 SaveList: TStringList;
234 begin
235 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
236 SaveList := TStringList.Create;
237 try
238 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
239 SaveList.Add('<favorite>');
240 AddSaveString(TreeView.Items.GetFirstNode, SaveList);
241 SaveList.Add('</favorite>');
242 SaveList.SaveToFile(FileName);
243 finally
244 SaveList.Free;
245 end;
246 end;
247
248 {
249 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
250 var
251 i: Integer;
252 // s: string;
253 FavBoard: TFavoriteBoardItem;
254 FavThread: TFavoriteThreadItem;
255 FavNode: IXMLNode;
256 begin
257 for i := 0 to Node.Count - 1 do begin
258 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
259 FavNode := XMLNode.AddChild('folder');
260 FavNode.Attributes['title'] := Node.Item[i].Text;
261 AddSaveString(Node.Item[i], FavNode);
262 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
263 FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
264 FavNode := XMLNode.AddChild('favitem');
265 FavNode.Attributes['type'] := '2ch';
266 FavNode.Attributes['favtype'] := 'board';
267 FavNode.Attributes['bbs'] := FavBoard.BBSID;
268 FavNode.Attributes['title'] := Node.Item[i].Text;
269 FavNode.Attributes['boardname'] := FavBoard.BoardName;
270 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
271 FavThread := TFavoriteThreadItem(Node.Item[i].Data);
272 FavNode := XMLNode.AddChild('favitem');
273 FavNode.Attributes['type'] := '2ch';
274 FavNode.Attributes['favtype'] := 'thread';
275 FavNode.Attributes['bbs'] := FavThread.BBSID;
276 FavNode.Attributes['thread'] := FavThread.ThreadID;
277 FavNode.Attributes['title'] := Node.Item[i].Text;
278 FavNode.Attributes['threadname'] := FavThread.ThreadName;
279 end;
280 end;
281 end;
282 }
283
284 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
285 var
286 i: Integer;
287 s: string;
288 FavBoard: TFavoriteBoardItem;
289 FavThread: TFavoriteThreadItem;
290 begin
291 for i := 0 to Node.Count - 1 do begin
292 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
293 s := Format('<folder title="%s">', [HtmlEncode(Node.Item[i].Text)]);
294 SaveList.Add(s);
295 AddSaveString(Node.Item[i], SaveList);
296 SaveList.Add('</folder>');
297 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
298 FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
299 s := Format('<favitem type="2ch" favtype="board" bbs="%s" title="%s" boardname="%s"/>',
300 [FavBoard.BBSID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavBoard.BoardName)]);
301 SaveList.Add(s);
302 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
303 FavThread := TFavoriteThreadItem(Node.Item[i].Data);
304 s := Format('<favitem type="2ch" favtype="thread" bbs="%s" thread="%s" title="%s" threadname="%s"/>',
305 [FavThread.BBSID, FavThread.ThreadID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavThread.ThreadName)]);
306 SaveList.Add(s);
307 end;
308 end;
309 end;
310
311 {
312 procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
313 begin
314 FStack := TStack.Create;
315 FStack.Push(FTreeView.Items.GetFirstNode);
316 end;
317
318 procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
319 begin
320 FStack.Free;
321 end;
322
323 procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
324 const Atts: IAttributes);
325 var
326 FavType: string;
327 ParentNode: TTreeNode;
328 CurrentNode: TTreeNode;
329 FavFolder: TFavoriteFolder;
330 FavBoard: TFavoriteBoardItem;
331 FavThread: TFavoriteThreadItem;
332 begin
333 if QName = 'folder' then begin
334 ParentNode := FStack.Peek;
335 if TObject(ParentNode.Data) is TFavoriteFolder then begin
336 FavFolder := TFavoriteFolder.Create;
337 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
338 CurrentNode.ImageIndex := 12;
339 CurrentNode.SelectedIndex := 13;
340 FStack.Push(CurrentNode);
341 end;
342 end else if QName = 'favitem' then begin
343 ParentNode := FStack.Peek;
344 if TObject(ParentNode.Data) is TFavoriteFolder then begin
345 FavType := Atts.getValue('favtype');
346 if FavType = 'board' then begin
347 FavBoard := TFavoriteBoardItem.Create;
348 FavBoard.BBSID := Atts.getValue('bbs');
349 FavBoard.BoardName := Atts.getValue('boardname');
350 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
351 CurrentNode.ImageIndex := 14;
352 CurrentNode.SelectedIndex := 15;
353 end else if FavType = 'thread' then begin
354 FavThread := TFavoriteThreadItem.Create;
355 FavThread.BBSID := Atts.getValue('bbs');
356 FavThread.ThreadID := Atts.getValue('thread');
357 FavThread.ThreadName := Atts.getValue('threadname');
358 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
359 CurrentNode.ImageIndex := 16;
360 CurrentNode.SelectedIndex := 17;
361 end;
362 end;
363 end;
364 end;
365
366 procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
367 begin
368 if QName = 'folder' then begin
369 if FStack.Count <> 0 then
370 FStack.Pop;
371 end;
372 end;
373
374 procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
375 begin
376 //
377 end;
378 }
379 function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
380 var
381 FavoriteFilePath: string;
382 tempStringList: TStringList;
383 begin
384
385 FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
386
387 if FileExists( FavoriteFilePath ) then begin
388 tempStringList := TStringList.Create;
389 try
390 tempStringList.LoadFromFile( FavoriteFilePath );
391 tempStringList.SaveToFile( FileName );
392 finally
393 tempStringList.Free;
394 end;
395 Result := true;
396 end else begin
397 Result := false;
398 end;
399 end;
400
401 function TFavoriteDM.GetFavoriteFilePath() : String;
402 begin
403 Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
404 end;
405
406 end.

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