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.52 - (show annotations) (download) (as text)
Wed Sep 19 15:00:38 2007 UTC (16 years, 7 months ago) by h677
Branch: MAIN
CVS Tags: v1_57_0_737, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_739, v1_57_0_738, v1_57_1_744, v1_57_0_736, v1_57_2_749, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_57_0_744
Branch point for: Bb57
Changes since 1.51: +8 -143 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, BoardGroup, windows;
8 {SAX, SAXHelpers, SAXComps, SAXKW;}
9
10 type
11 TFavoriteFolder = class
12 end;
13
14 TFavoriteItem = class(TObject)
15 private
16 FURL : string;
17 FTitle : string;
18 public
19 function GetItemTitle : string; virtual;abstract;
20 property URL : string read FURL write FURL; // Item ?????転?長?鼎???足???? URL ???鱈???徹???????辿
21 property Title : string read FTitle write FTitle;
22 end;
23 TFavoriteBoardItem = class(TFavoriteItem)
24 private
25 FItem : TBoard;
26 function GetItem : TBoard;
27 public
28 constructor Create( inURL : string; inTitle : string = ''; inItem : TBoard = nil );
29 constructor CreateWithItem( inItem : TBoard );
30 destructor Destory;
31 function GetItemTitle : string; override;
32 property Item : TBoard read GetItem write FItem;
33 end;
34
35 TFavoriteThreadItem = class(TFavoriteItem)
36 private
37 FItem : TThreadItem;
38 function GetItem : TThreadItem;
39 public
40 constructor Create( inURL : string; inTitle : string = ''; inItem : TThreadItem = nil );
41 constructor CreateWithItem( inItem : TThreadItem );
42 destructor Destory;
43 function GetItemTitle : string; override;
44 property Item : TThreadItem read GetItem write FItem;
45 end;
46
47 TFavoriteDM = class(TDataModule)
48 private
49 { Private ?辿?転 }
50 FAbEnd: Boolean;
51 FStack: TStack;
52 FTreeView: TTreeView;
53 FModified: boolean;
54 procedure ReadNode(Node: IXMLNode);
55 procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
56 public
57 { Public ?辿?転 }
58 procedure Clear;
59 function GetFavoriteFilePath() : String;
60 function SaveFavoriteFile(FileName: String) : Boolean;
61 procedure SetFavTreeView(TreeView: TTreeView);
62 procedure ReadFavorite;
63 procedure WriteFavorite;
64 procedure URLReplace(oldURLs: TStringList; newURLs: TStringList);
65 property TreeView: TTreeView read FTreeView;
66 property Modified: boolean read FModified write FModified;
67 property AbEnd: Boolean read FAbEnd write FAbEnd;
68 end;
69
70 var
71 FavoriteDM: TFavoriteDM;
72 const
73 FAVORITE_LINK_NAME = '?????N';
74
75 implementation
76
77 uses ExternalBoardManager, ExternalBoardPlugInMain, MojuUtils;
78
79 const
80 FAVORITE_ROOT_NAME = '?即?C???端??';
81 FAVORITE_FILE_NAME = 'Favorite.xml';
82
83 {$R *.dfm}
84
85 constructor TFavoriteBoardItem.Create(
86 inURL : string;
87 inTitle : string = '';
88 inItem : TBoard = nil
89 );
90 begin
91
92 inherited Create;
93
94 URL := inURL;
95 Title := inTitle;
96 Item := inItem;
97
98 end;
99
100 constructor TFavoriteBoardItem.CreateWithItem(
101 inItem : TBoard
102 );
103 begin
104
105 Create( inItem.URL, inItem.Title, inItem );
106
107 end;
108 destructor TFavoriteBoardItem.Destory;
109 begin
110 if FItem <> nil then
111 FItem.Free;
112 inherited;
113 end;
114 //! ?徹???直?????辿?????^?C?g????????
115 function TFavoriteBoardItem.GetItemTitle : string;
116 begin
117 Result := '';
118 //???x???????J?????????????鼎?i?N?貼?????L???r?l?b?g???即?C???端???????j
119 //?????鼎??FItem??nil?????長?泥?????鼎????????????
120 if FItem = nil then begin
121 FItem := BBSsFindBoardFromURL(URL);
122 end;
123 if FItem <> nil then begin
124 try
125 if not FItem.IsThreadDatRead then begin
126 GikoSys.ReadSubjectFile(FItem);
127 end;
128 except
129 end;
130 Result := FItem.Title;
131 end;
132 end;
133 function TFavoriteBoardItem.GetItem : TBoard;
134 var
135 protocol, host, path, document, port, bookmark : string;
136 BBSID : string;
137 tmpURL : string;
138 begin
139
140 if FItem = nil then begin
141 FItem := BBSsFindBoardFromURL( URL );
142 if FItem = nil then begin
143 tmpURL := URL;
144 GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
145 if GikoSys.Is2chHost( host ) then begin
146 BBSID := GikoSys.URLToID( tmpURL );
147 FItem := BBSs[ 0 ].FindBBSID( BBSID );
148 if FItem <> nil then
149 URL := FItem.URL;
150 end;
151 {
152 // ???????????A???????辿?J?e?S???????????長???直?足?徹?纏
153 FItem := GikoSys.GetUnknownBoard( nil, URL );
154 FItem.Title := Title;
155 }
156 end;
157 end;
158
159 Result := FItem;
160
161 end;
162
163 constructor TFavoriteThreadItem.Create(
164 inURL : string;
165 inTitle : string = '';
166 inItem : TThreadItem = nil
167 );
168 begin
169
170 inherited Create;
171 URL := inURL;
172
173 Title := inTitle;
174 Item := inItem;
175
176 end;
177
178 constructor TFavoriteThreadItem.CreateWithItem(
179 inItem : TThreadItem
180 );
181 begin
182
183 Create( inItem.URL, inItem.Title, inItem );
184
185 end;
186 destructor TFavoriteThreadItem.Destory;
187 begin
188 if FItem <> nil then
189 FItem.Free;
190 inherited;
191 end;
192 //! ?徹???直?????辿?X?????^?C?g????????
193 function TFavoriteThreadItem.GetItemTitle : string;
194 begin
195 Result := '';
196 if FItem = nil then begin
197 FItem := BBSsFindThreadFromURL(URL);
198 end;
199 if FItem <> nil then begin
200 Result := FItem.Title;
201 end;
202 end;
203
204 function TFavoriteThreadItem.GetItem : TThreadItem;
205 var
206 board : TBoard;
207 boardURL : string;
208 browsableURL : string;
209 protocol, host, path, document, port, bookmark : string;
210 BBSID, BBSKey : string;
211 tmpURL : string;
212 begin
213
214 Result := nil;
215 if FItem = nil then begin
216 browsableURL := GikoSys.GetBrowsableThreadURL( URL );
217 boardURL := GikoSys.GetThreadURL2BoardURL( browsableURL );
218 board := BBSsFindBoardFromURL( boardURL );
219
220 if board = nil then begin
221 tmpURL := URL;
222 GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
223 if GikoSys.Is2chHost( host ) then begin
224 GikoSys.Parse2chURL( tmpURL, path, document, BBSID, BBSKey );
225 board := BBSs[ 0 ].FindBBSID( BBSID );
226 end;
227
228 if board = nil then begin
229 Exit;
230 // ???????????A???????辿?J?e?S???????????長???直?足?徹?纏
231 //board := GikoSys.GetUnknownBoard( nil, boardURL )
232 end;
233 end;
234
235 FItem := board.FindThreadFromURL( browsableURL );
236
237 if FItem = nil then begin
238 tmpURL := URL;
239 GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
240 if GikoSys.Is2chHost( host ) then begin
241 GikoSys.Parse2chURL( tmpURL, path, document, BBSID, BBSKey );
242 FItem := BBSs[ 0 ].FindThreadItem( BBSID, BBSKey + '.dat' );
243 if FItem <> nil then
244 URL := FItem.URL;
245 end;
246 end;
247
248 if FItem = nil then begin
249 FItem := TThreadItem.Create( board.BoardPlugIn, board, browsableURL );
250
251 FItem.Title := Title;
252 board.Add( FItem );
253 end;
254 end;
255
256 Result := FItem;
257
258 end;
259
260 procedure TFavoriteDM.Clear;
261 var
262 Node : TTreeNode;
263 begin
264 TreeView.Items.BeginUpdate;
265 Node := TreeView.Items.GetFirstNode;
266 while Node <> nil do begin
267 if TObject(Node.Data) <> nil then
268 TObject(Node.Data).Free;
269 Node := Node.GetNext;
270 end;
271 TreeView.Items.Clear;
272 TreeView.Items.EndUpdate;
273
274 FavoriteDM.Modified := true;
275 end;
276
277 procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
278 begin
279 FTreeView := TreeView;
280 end;
281
282 procedure TFavoriteDM.ReadFavorite;
283 var
284 FileName: string;
285 XMLDoc: IXMLDocument;
286 XMLNode: IXMLNode;
287 Node: TTreeNode;
288 i: Integer;
289 FavFolder: TFavoriteFolder;
290 LinkExists: Boolean;
291 begin
292 FABend := False;
293
294 FavoriteDM.Modified := true;
295 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
296
297 FavFolder := TFavoriteFolder.Create;
298 Node := FTreeView.Items.AddChildObjectFirst(nil, FAVORITE_ROOT_NAME, FavFolder);
299 Node.ImageIndex := 14;
300 Node.SelectedIndex := 14;
301
302 if FileExists(FileName) then begin
303 try
304 XMLDoc := IXMLDocument.Create;
305 //XMLDoc := LoadXMLDocument(FileName);
306 LoadXMLDocument(FileName, XMLDoc);
307 XMLNode := XMLDoc.DocumentElement;
308
309 FStack := TStack.Create;
310 try
311 FStack.Push(Node);
312 LinkExists := False;
313 if XMLNode.NodeName = 'favorite' then begin
314 for i := XMLNode.ChildNodes.Count - 1 downto 0 do begin
315 ReadNode(XMLNode.ChildNodes[i]);
316 if (XMLNode.ChildNodes[i].NodeName = 'folder') and
317 (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
318 LinkExists := True;
319 end;
320 end;
321 end;
322 if not LinkExists then begin
323 FavFolder := TFavoriteFolder.Create;
324 Node := FTreeView.Items.AddChildObjectFirst(Node, FAVORITE_LINK_NAME, FavFolder);
325 Node.ImageIndex := 14;
326 Node.SelectedIndex := 14;
327 end;
328
329 finally
330 FStack.Free;
331 XMLDoc.Free;
332 end;
333 except
334 on e : Exception do begin
335 FABend := True;
336 end;
337 end;
338 end;
339
340 {
341 FavFolder := TFavoriteFolder.Create;
342 Node := FTreeView.Items.AddChildObjectFirst(nil, FAVORITE_ROOT_NAME, FavFolder);
343 Node.ImageIndex := 12;
344 Node.SelectedIndex := 13;
345
346 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
347 if not FileExists(FileName) then
348 Exit;
349
350 FavSAXHandler.OnStartDocument := SAXStartDocument;
351 FavSAXHandler.OnEndDocument := SAXEndDocument;
352 FavSAXHandler.OnStartElement := SAXStartElement;
353 FavSAXHandler.OnStartElement := SAXStartElement;
354 FavSAXHandler.OnEndElement := SAXEndElement;
355 FavSAXHandler.OnCharacters := SAXCharacters;
356
357 FavSAXReader.Vendor := 'Keith Wood';
358 FavSAXReader.URL := FileName;
359 FavSAXReader.Parse;}
360 end;
361
362 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
363 var
364 i: Integer;
365
366 ParentNode: TTreeNode;
367 CurrentNode: TTreeNode;
368 FavFolder: TFavoriteFolder;
369 FavBoard: TFavoriteBoardItem;
370 FavThread: TFavoriteThreadItem;
371 board : TBoard;
372 threadItem : TThreadItem;
373 begin
374 if Node.NodeName = 'folder' then begin
375 ParentNode := FStack.Peek;
376 if TObject(ParentNode.Data) is TFavoriteFolder then begin
377 FavFolder := TFavoriteFolder.Create;
378 CurrentNode := FTreeView.Items.AddChildObjectFirst(ParentNode, Node.Attributes['title'], FavFolder);
379 CurrentNode.ImageIndex := 14;
380 CurrentNode.SelectedIndex := 14;
381 FStack.Push(CurrentNode);
382 end;
383 for i := Node.ChildNodes.Count - 1 downto 0 do begin
384 ReadNode(Node.ChildNodes[i]);
385 end;
386 if TObject(ParentNode.Data) is TFavoriteFolder then
387 CurrentNode.Expanded := Node.Attributes[ 'expanded' ] = 'true';
388 if FStack.Count <> 0 then
389 FStack.Pop;
390 end else if Node.NodeName = 'favitem' then begin
391 try
392 ParentNode := FStack.Peek;
393 if TObject(ParentNode.Data) is TFavoriteFolder then begin
394 if Node.Attributes['favtype'] = 'board' then begin
395 FavBoard := nil;
396 // ???貼???即?C???端???????????鼎??????
397 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
398 board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
399 if board <> nil then
400 FavBoard := TFavoriteBoardItem.Create(
401 board.URL, MojuUtils.UnSanitize(Node.Attributes[ 'title' ]), board );
402 end else begin
403 FavBoard := TFavoriteBoardItem.Create(
404 Node.Attributes[ 'url' ], MojuUtils.UnSanitize(Node.Attributes[ 'title' ]), nil );
405 end;
406 CurrentNode := FTreeView.Items.AddChildObjectFirst(ParentNode, UnSanitize(Node.Attributes['title']), FavBoard);
407 CurrentNode.ImageIndex := 15;
408 CurrentNode.SelectedIndex := 15;
409 end else if Node.Attributes['favtype'] = 'thread' then begin
410 // ???貼???即?C???端???????????鼎??????
411 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
412 board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
413 if board = nil then
414 Exit;
415
416 if not board.IsThreadDatRead then
417 GikoSys.ReadSubjectFile( board );
418 threadItem := board.FindThreadFromFileName( Node.Attributes[ 'thread' ] );
419 if threadItem = nil then begin
420 threadItem := TThreadItem.Create(
421 board.BoardPlugIn,
422 board,
423 GikoSys.Get2chBoard2ThreadURL( board, ChangeFileExt( Node.Attributes[ 'thread' ], '' ) ) );
424 threadItem.Title := UnSanitize(Node.Attributes[ 'title' ]);
425 board.Add( threadItem );
426 end;
427 FavThread := TFavoriteThreadItem.Create(
428 threadItem.URL, UnSanitize(Node.Attributes[ 'title' ]), threadItem );
429 threadItem.Free;
430 end else begin
431 FavThread := TFavoriteThreadItem.Create(
432 Node.Attributes[ 'url' ], UnSanitize(Node.Attributes[ 'title' ]), nil );
433 end;
434 CurrentNode := FTreeView.Items.AddChildObjectFirst(ParentNode, UnSanitize(Node.Attributes['title']), FavThread);
435 CurrentNode.ImageIndex := 16;
436 CurrentNode.SelectedIndex := 16;
437 end;
438 end;
439 except
440 // ?????A?C?e???長?但?????N?鼎?????添???A?C?e?????e?甜???^?????足???????長
441 end;
442 end;
443 end;
444
445 procedure TFavoriteDM.WriteFavorite;
446 var
447 FileName, tmpFileName: string;
448 SaveList: TStringList;
449
450 begin
451 FavoriteDM.Modified := true;
452 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
453 if FileExists(FileName) then begin
454 tmpFileName := GikoSys.GetConfigDir + '~' + FAVORITE_FILE_NAME;
455 if FileExists(tmpFileName) then
456 SysUtils.DeleteFile(tmpFileName); //SysUtils.?????纏??????WinAPI???????長?鼎???????長
457 RenameFile(FileName, tmpFileName);
458 end;
459 SaveList := TStringList.Create;
460 try
461 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
462 SaveList.Add('<favorite>');
463 try
464 AddSaveString(TreeView.Items.GetFirstNode.getFirstChild, SaveList);
465 except
466 end;
467 SaveList.Add('</favorite>');
468 SaveList.SaveToFile(FileName);
469 finally
470 SaveList.Free;
471 end;
472 end;
473
474 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
475 var
476 s: string;
477 FavBoard: TFavoriteBoardItem;
478 FavThread: TFavoriteThreadItem;
479 data : Pointer;
480 begin
481 while Node <> nil do begin
482 data := Node.Data;
483 if TObject(data) is TFavoriteFolder then begin
484 if Node.Expanded then
485 s := Format('<folder title="%s" expanded="true">', [HtmlEncode(Node.Text)])
486 else
487 s := Format('<folder title="%s" expanded="false">', [HtmlEncode(Node.Text)]);
488 SaveList.Add(s);
489 AddSaveString(Node.getFirstChild, SaveList);
490 SaveList.Add('</folder>');
491 end else if TObject(data) is TFavoriteBoardItem then begin
492 FavBoard := TFavoriteBoardItem(data);
493 s := Format('<favitem type="2ch" favtype="board" url="%s" title="%s"/>',
494 [HtmlEncode( FavBoard.URL ), HtmlEncode(MojuUtils.Sanitize(Node.Text))]);
495 SaveList.Add(s);
496 end else if TObject(data) is TFavoriteThreadItem then begin
497 FavThread := TFavoriteThreadItem(data);
498 s := Format('<favitem type="2ch" favtype="thread" url="%s" title="%s"/>',
499 [HtmlEncode( FavThread.URL ), HtmlEncode(MojuUtils.Sanitize(Node.Text))]);
500 SaveList.Add(s);
501 end;
502 Node := Node.getNextSibling;
503 end;
504 end;
505
506 function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
507 var
508 FavoriteFilePath: string;
509 tempStringList: TStringList;
510 begin
511 WriteFavorite;
512 FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
513
514 if FileExists( FavoriteFilePath ) then begin
515 tempStringList := TStringList.Create;
516 try
517 tempStringList.LoadFromFile( FavoriteFilePath );
518 tempStringList.SaveToFile( FileName );
519 finally
520 tempStringList.Free;
521 end;
522 Result := true;
523 end else begin
524 Result := false;
525 end;
526 end;
527
528 procedure TFavoriteDM.URLReplace(oldURLs: TStringList; newURLs: TStringList);
529 var
530 i : Integer;
531 tmpURL: string;
532 oldHost: string;
533 oldBoardName: string;
534 newHost: string;
535 newBoardName: string;
536 tempString: string;
537 favBoard : TFavoriteBoardItem;
538 favThread : TFavoriteThreadItem;
539 favorites : TTreeNodes;
540 Node : TTreeNode;
541 begin
542
543 // ???|?転?纏??thread???泥???添??URL???`?F?b?N?直?????巽?但?????????鼎?叩???纏?????B
544 favorites := FavoriteDM.FTreeView.Items;
545 for i := 0 to oldURLs.Count - 1 do begin
546 try
547 tmpURL := Copy(oldURLs[i], 1, Length(oldURLs[i]) -1);
548 oldHost := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
549 oldBoardName := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
550 tmpURL := Copy(newURLs[i], 1, Length(newURLs[i]) -1);
551 newHost := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
552 newBoardName := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
553
554 Node := favorites.GetFirstNode.getFirstChild;
555 while Node <> nil do begin
556 try
557 if TObject( Node.Data ) is TFavoriteBoardItem then begin
558 favBoard := TFavoriteBoardItem( Node.Data );
559 if favBoard = nil then continue;
560 tempString := favBoard.URL;
561 if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
562 tempString := StringReplace(tempString, oldHost, newHost,[]);
563 favBoard.URL := tempString;
564 end;
565 end else if TObject( Node.Data ) is TFavoriteThreadItem then begin
566 favThread := TFavoriteThreadItem( Node.Data );
567 if favThread = nil then continue;
568 tempString := favThread.URL;
569 if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
570 tempString := StringReplace(tempString, oldHost, newHost,[]);
571 favThread.URL := tempString;
572 end;
573 end;
574 except
575 end;
576 Node := Node.GetNext;
577 end;
578 except
579 end;
580 end;
581
582 end;
583
584 function TFavoriteDM.GetFavoriteFilePath() : String;
585 begin
586 Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
587 end;
588
589 end.

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