Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/Favorite.pas

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


Revision 1.6 - (hide annotations) (download) (as text)
Sat Nov 22 12:17:50 2003 UTC (20 years, 5 months ago) by yoffy
Branch: MAIN
Changes since 1.5: +4 -4 lines
File MIME type: text/x-pascal
・デコードは URL デコードなのに、エンコードが間違っていたので URL エンコードするように修正。

1 hi_ 1.1 unit Favorite;
2    
3     interface
4    
5     uses
6 yoffy 1.2 Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,} YofUtils,
7 yoffy 1.5 GikoSystem{, XMLIntf, XMLDoc}, GikoXMLDoc, BoardGroup;
8 hi_ 1.1 {SAX, SAXHelpers, SAXComps, SAXKW;}
9    
10     type
11     TFavoriteFolder = class
12     end;
13    
14     TFavoriteBoardItem = class
15     private
16 yoffy 1.5 FItem : TBoard;
17     FTitle : string;
18 hi_ 1.1 public
19 yoffy 1.5 property Item : TBoard read FItem write FItem;
20     property Title : string read FTitle write FTitle;
21 hi_ 1.1 end;
22    
23     TFavoriteThreadItem = class
24     private
25 yoffy 1.5 FItem : TThreadItem;
26     FTitle : string;
27 hi_ 1.1 public
28 yoffy 1.5 property Item : TThreadItem read FItem write FItem;
29     property Title : string read FTitle write FTitle;
30 hi_ 1.1 end;
31    
32     TFavoriteDM = class(TDataModule)
33     procedure DataModuleCreate(Sender: TObject);
34     procedure DataModuleDestroy(Sender: TObject);
35     private
36     { Private ?辿?転 }
37     FStack: TStack;
38     FTreeView: TTreeView;
39    
40     procedure ReadNode(Node: IXMLNode);
41 yoffy 1.2 procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
42     // procedure AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
43 hi_ 1.1 // procedure SAXStartDocument(Sender: TObject);
44     // procedure SAXEndDocument(Sender: TObject);
45     // procedure SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; const Atts: IAttributes);
46     // procedure SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
47     // procedure SAXCharacters(Sender: TObject; const PCh: SAXString);
48     public
49     { Public ?辿?転 }
50 h677 1.4 function GetFavoriteFilePath() : String;
51     function SaveFavoriteFile(FileName: String) : Boolean;
52 hi_ 1.1 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 yoffy 1.5 uses ExternalBoardManager, ExternalBoardPlugInMain;
66    
67 hi_ 1.1 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 yoffy 1.2
104 hi_ 1.1 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
105    
106     FavFolder := TFavoriteFolder.Create;
107     Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
108 yoffy 1.2 Node.ImageIndex := 14;
109     Node.SelectedIndex := 14;
110 hi_ 1.1
111     if FileExists(FileName) then begin
112 yoffy 1.2 try
113     XMLDoc := LoadXMLDocument(FileName);
114     XMLNode := XMLDoc.DocumentElement;
115 hi_ 1.1
116 yoffy 1.2 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 hi_ 1.1 end;
128     end;
129 yoffy 1.2 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 hi_ 1.1 end;
138 yoffy 1.2 except
139 hi_ 1.1 end;
140     end;
141    
142 yoffy 1.2 {
143     FavFolder := TFavoriteFolder.Create;
144 hi_ 1.1 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 yoffy 1.5 j, jBound : Integer;
168 hi_ 1.1
169     ParentNode: TTreeNode;
170     CurrentNode: TTreeNode;
171     FavFolder: TFavoriteFolder;
172     FavBoard: TFavoriteBoardItem;
173     FavThread: TFavoriteThreadItem;
174 yoffy 1.5 board : TBoard;
175     url : string;
176 hi_ 1.1 begin
177     if Node.NodeName = 'folder' then begin
178     ParentNode := FStack.Peek;
179     if TObject(ParentNode.Data) is TFavoriteFolder then begin
180     FavFolder := TFavoriteFolder.Create;
181     CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
182 yoffy 1.2 CurrentNode.ImageIndex := 14;
183     CurrentNode.SelectedIndex := 14;
184 yoffy 1.5 CurrentNode.Expanded := Node.Attributes[ 'expanded' ] = 'true';
185 hi_ 1.1 FStack.Push(CurrentNode);
186     end;
187     for i := 0 to Node.ChildNodes.Count - 1 do begin
188     ReadNode(Node.ChildNodes[i]);
189     end;
190     if FStack.Count <> 0 then
191     FStack.Pop;
192     end else if Node.NodeName = 'favitem' then begin
193     ParentNode := FStack.Peek;
194     if TObject(ParentNode.Data) is TFavoriteFolder then begin
195     if Node.Attributes['favtype'] = 'board' then begin
196 yoffy 1.5 FavBoard := TFavoriteBoardItem.Create;
197     FavBoard.Item := BBSsFindBoardFromURL( Node.Attributes[ 'url' ] );
198     // ???貼???即?C???端???????????鼎??????
199     if FavBoard.Item = nil then begin
200     if Node.Attributes[ 'url' ] = '' then begin
201     FavBoard.Item := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
202     if FavBoard.Item = nil then begin
203     FavBoard.Free;
204     Exit;
205     end;
206     end else begin
207     // ???????????A???????辿?J?e?S???????????長???直?足?徹?纏
208     //FavBoard.Item := TBoard.Create( nil, Node.Attributes[ 'url' ] );
209     end;
210     end;
211     FavBoard.Title := Node.Attributes['title'];
212 hi_ 1.1 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
213 yoffy 1.2 CurrentNode.ImageIndex := 15;
214 hi_ 1.1 CurrentNode.SelectedIndex := 15;
215     end else if Node.Attributes['favtype'] = 'thread' then begin
216 yoffy 1.5 url := Node.Attributes[ 'url' ];
217     FavThread := TFavoriteThreadItem.Create;
218     FavThread.Item := BBSsFindThreadFromURL( url );
219     // ???貼???即?C???端???????????鼎??????
220     if FavThread.Item = nil then begin
221     if Node.Attributes[ 'url' ] = '' then begin
222     board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
223     if board = nil then begin
224     FavThread.Free;
225     Exit;
226     end;
227     if not board.IsThreadDatRead then
228     GikoSys.ReadSubjectFile( board );
229     FavThread.Item := board.Find( Node.Attributes[ 'thread' ] );
230     if FavThread.Item = nil then begin
231     FavThread.Item := TThreadItem.Create(
232     board.BoardPlugIn,
233     GikoSys.Get2chBoard2ThreadURL( board, ChangeFileExt( Node.Attributes[ 'thread' ], '' ) ) );
234     board.Add( FavThread.Item )
235     end;
236     end else begin
237     board := BBSsFindBoardFromURL( GikoSys.Get2chThreadURL2BoardURL( url ) );
238     if board <> nil then begin
239     //===== ?v???O?C??
240     try
241     jBound := Length( BoardPlugIns ) - 1;
242     for j := 0 to jBound do begin
243     if Assigned( Pointer( BoardPlugIns[ j ].Module ) ) then begin
244     if BoardPlugIns[ j ].AcceptURL( url ) = atThread then begin
245     FavThread.Item := TThreadItem.Create( BoardPlugIns[ j ], url );
246    
247     Break;
248     end;
249     end;
250     end;
251     except
252     // exception ???足???直???????????????????C?邸???????長?????長???????直????
253     end;
254    
255     //===== ????
256     if FavThread.Item = nil then
257     FavThread.Item := TThreadItem.Create( nil, url );
258    
259     board.Add( FavThread.Item );
260     end;
261     end;
262     end;
263     FavThread.Title := Node.Attributes['title'];
264 hi_ 1.1 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
265     CurrentNode.ImageIndex := 16;
266 yoffy 1.2 CurrentNode.SelectedIndex := 16;
267 hi_ 1.1 end;
268     end;
269     end;
270     end;
271    
272     procedure TFavoriteDM.WriteFavorite;
273 yoffy 1.2 {
274 hi_ 1.1 var
275     FileName: string;
276     // SaveList: TStringList;
277     // i: Integer;
278     // Count: Integer;
279    
280     XMLDoc: IXMLDocument;
281     XMLNode: IXMLNode;
282     // FavoNode: IXMLNode;
283     begin
284     XMLDoc := NewXMLDocument;
285     XMLDoc.Encoding := 'Shift_JIS';
286     XMLDoc.StandAlone := 'yes';
287     XMLNode := XMLDoc.AddChild('favorite');
288     FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
289     AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
290     XMLDoc.SaveToFile(FileName);
291 yoffy 1.2 }
292     var
293 hi_ 1.1 FileName: string;
294     SaveList: TStringList;
295     begin
296     FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
297     SaveList := TStringList.Create;
298     try
299     SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
300     SaveList.Add('<favorite>');
301     AddSaveString(TreeView.Items.GetFirstNode, SaveList);
302     SaveList.Add('</favorite>');
303     SaveList.SaveToFile(FileName);
304     finally
305     SaveList.Free;
306 yoffy 1.2 end;
307 hi_ 1.1 end;
308    
309 yoffy 1.2 {
310 hi_ 1.1 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
311     var
312     i: Integer;
313     // s: string;
314     FavBoard: TFavoriteBoardItem;
315     FavThread: TFavoriteThreadItem;
316     FavNode: IXMLNode;
317     begin
318     for i := 0 to Node.Count - 1 do begin
319     if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
320     FavNode := XMLNode.AddChild('folder');
321     FavNode.Attributes['title'] := Node.Item[i].Text;
322     AddSaveString(Node.Item[i], FavNode);
323     end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
324     FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
325     FavNode := XMLNode.AddChild('favitem');
326     FavNode.Attributes['type'] := '2ch';
327     FavNode.Attributes['favtype'] := 'board';
328     FavNode.Attributes['bbs'] := FavBoard.BBSID;
329     FavNode.Attributes['title'] := Node.Item[i].Text;
330     FavNode.Attributes['boardname'] := FavBoard.BoardName;
331     end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
332     FavThread := TFavoriteThreadItem(Node.Item[i].Data);
333     FavNode := XMLNode.AddChild('favitem');
334     FavNode.Attributes['type'] := '2ch';
335     FavNode.Attributes['favtype'] := 'thread';
336     FavNode.Attributes['bbs'] := FavThread.BBSID;
337     FavNode.Attributes['thread'] := FavThread.ThreadID;
338     FavNode.Attributes['title'] := Node.Item[i].Text;
339     FavNode.Attributes['threadname'] := FavThread.ThreadName;
340     end;
341     end;
342     end;
343 yoffy 1.2 }
344 hi_ 1.1
345 yoffy 1.2 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
346 hi_ 1.1 var
347     i: Integer;
348     s: string;
349     FavBoard: TFavoriteBoardItem;
350     FavThread: TFavoriteThreadItem;
351     begin
352     for i := 0 to Node.Count - 1 do begin
353     if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
354 yoffy 1.5 if Node.Item[ i ].Expanded then
355 yoffy 1.6 s := Format('<folder title="%s" expanded="true">', [HttpEncode(Node.Item[i].Text)])
356 yoffy 1.5 else
357 yoffy 1.6 s := Format('<folder title="%s" expanded="false">', [HttpEncode(Node.Item[i].Text)]);
358 hi_ 1.1 SaveList.Add(s);
359     AddSaveString(Node.Item[i], SaveList);
360     SaveList.Add('</folder>');
361     end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
362     FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
363 yoffy 1.5 s := Format('<favitem type="2ch" favtype="board" url="%s" title="%s"/>',
364 yoffy 1.6 [HttpEncode( FavBoard.Item.URL ), HttpEncode(FavBoard.Title)]);
365 hi_ 1.1 SaveList.Add(s);
366     end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
367     FavThread := TFavoriteThreadItem(Node.Item[i].Data);
368 yoffy 1.5 s := Format('<favitem type="2ch" favtype="thread" url="%s" title="%s"/>',
369 yoffy 1.6 [HttpEncode( FavThread.Item.URL ), HttpEncode(FavThread.Title)]);
370 hi_ 1.1 SaveList.Add(s);
371     end;
372     end;
373 yoffy 1.2 end;
374 hi_ 1.1
375     {
376     procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
377     begin
378     FStack := TStack.Create;
379     FStack.Push(FTreeView.Items.GetFirstNode);
380     end;
381    
382     procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
383     begin
384     FStack.Free;
385     end;
386    
387     procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
388     const Atts: IAttributes);
389     var
390     FavType: string;
391     ParentNode: TTreeNode;
392     CurrentNode: TTreeNode;
393     FavFolder: TFavoriteFolder;
394     FavBoard: TFavoriteBoardItem;
395     FavThread: TFavoriteThreadItem;
396     begin
397     if QName = 'folder' then begin
398     ParentNode := FStack.Peek;
399     if TObject(ParentNode.Data) is TFavoriteFolder then begin
400     FavFolder := TFavoriteFolder.Create;
401     CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
402     CurrentNode.ImageIndex := 12;
403     CurrentNode.SelectedIndex := 13;
404     FStack.Push(CurrentNode);
405     end;
406     end else if QName = 'favitem' then begin
407     ParentNode := FStack.Peek;
408     if TObject(ParentNode.Data) is TFavoriteFolder then begin
409     FavType := Atts.getValue('favtype');
410     if FavType = 'board' then begin
411     FavBoard := TFavoriteBoardItem.Create;
412     FavBoard.BBSID := Atts.getValue('bbs');
413     FavBoard.BoardName := Atts.getValue('boardname');
414     CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
415     CurrentNode.ImageIndex := 14;
416     CurrentNode.SelectedIndex := 15;
417     end else if FavType = 'thread' then begin
418     FavThread := TFavoriteThreadItem.Create;
419     FavThread.BBSID := Atts.getValue('bbs');
420     FavThread.ThreadID := Atts.getValue('thread');
421     FavThread.ThreadName := Atts.getValue('threadname');
422     CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
423     CurrentNode.ImageIndex := 16;
424     CurrentNode.SelectedIndex := 17;
425     end;
426     end;
427     end;
428     end;
429    
430     procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
431     begin
432     if QName = 'folder' then begin
433     if FStack.Count <> 0 then
434     FStack.Pop;
435     end;
436     end;
437    
438     procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
439     begin
440     //
441     end;
442     }
443 h677 1.4 function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
444     var
445     FavoriteFilePath: string;
446     tempStringList: TStringList;
447     begin
448    
449     FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
450    
451     if FileExists( FavoriteFilePath ) then begin
452     tempStringList := TStringList.Create;
453     try
454     tempStringList.LoadFromFile( FavoriteFilePath );
455     tempStringList.SaveToFile( FileName );
456     finally
457     tempStringList.Free;
458     end;
459     Result := true;
460     end else begin
461     Result := false;
462     end;
463     end;
464    
465     function TFavoriteDM.GetFavoriteFilePath() : String;
466     begin
467     Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
468     end;
469    
470 hi_ 1.1 end.

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