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.4 - (hide 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 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.3 GikoSystem{, XMLIntf, XMLDoc}, GikoXMLDoc;
8 hi_ 1.1 {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 yoffy 1.2 procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
44     // procedure AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
45 hi_ 1.1 // 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 h677 1.4 function GetFavoriteFilePath() : String;
53     function SaveFavoriteFile(FileName: String) : Boolean;
54 hi_ 1.1 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 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    
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 yoffy 1.2 CurrentNode.ImageIndex := 14;
180     CurrentNode.SelectedIndex := 14;
181 hi_ 1.1 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 yoffy 1.2 CurrentNode.ImageIndex := 15;
197 hi_ 1.1 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 yoffy 1.2 CurrentNode.SelectedIndex := 16;
206 hi_ 1.1 end;
207     end;
208     end;
209     end;
210    
211     procedure TFavoriteDM.WriteFavorite;
212 yoffy 1.2 {
213 hi_ 1.1 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 yoffy 1.2 }
231     var
232 hi_ 1.1 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 yoffy 1.2 end;
246 hi_ 1.1 end;
247    
248 yoffy 1.2 {
249 hi_ 1.1 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 yoffy 1.2 }
283 hi_ 1.1
284 yoffy 1.2 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
285 hi_ 1.1 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 yoffy 1.2 end;
310 hi_ 1.1
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 h677 1.4 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 hi_ 1.1 end.

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