Develop and Download Open Source Software

ギコナビ(避難所版)

Browse CVS Repository

/[OSDN]/gikonavigoeson/gikonavi/Favorite.pas

Contents of /gikonavigoeson/gikonavi/Favorite.pas

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

Revision 1.55 - (show annotations) (download) (as text)
Sun May 24 14:05:14 2009 UTC (14 years, 9 months ago) by h677
Branch: MAIN
CVS Tags: v1_63_1_819, v1_62_0_812, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_61_0_798, v1_61_0_799, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_62_0_803, v1_62_0_802, v1_62_0_809, v1_62_0_810, v1_62_0_811, v1_60_1_793, v1_62_1_813, v1_61_0_800, v1_60_0_793, v1_60_0_792, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb62, Bb63, Bb60, Bb61
Changes since 1.54: +2 -1 lines
File MIME type: text/x-pascal 
close #16924
お気に入りの初期化エラーの時のメッセージ追加＆エクスプローラでギコナビ
フォルダを開くように変更
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 FTreeView: TTreeView;
52 FModified: boolean;
53 procedure ReadNode(Node: IXMLNode; Stack: TStack; TreeView: TTreeView);
54 procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
55 public
56 { Public ?辿?転 }
57 procedure Clear;
58 function GetFavoriteFilePath() : String;
59 function SaveFavoriteFile(FileName: String) : Boolean;
60 procedure SetFavTreeView(TreeView: TTreeView);
61 procedure ReadFavorite;
62 procedure WriteFavorite;
63 procedure URLReplace(oldURLs: TStringList; newURLs: TStringList);
64 property TreeView: TTreeView read FTreeView;
65 property Modified: boolean read FModified write FModified;
66 property AbEnd: Boolean read FAbEnd write FAbEnd;
67 end;
68
69 var
70 FavoriteDM: TFavoriteDM;
71 const
72 FAVORITE_LINK_NAME = '?????N';
73 FAVORITE_FILE_NAME = 'Favorite.xml';
74
75 implementation
76
77 uses ExternalBoardManager, ExternalBoardPlugInMain, MojuUtils;
78
79 const
80 FAVORITE_ROOT_NAME = '?即?C???端??';
81
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 Stack: TStack;
292 begin
293 FABend := False;
294
295 FavoriteDM.Modified := true;
296 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
297
298 FavFolder := TFavoriteFolder.Create;
299 Node := FTreeView.Items.AddChildObjectFirst(nil, FAVORITE_ROOT_NAME, FavFolder);
300 Node.ImageIndex := 14;
301 Node.SelectedIndex := 14;
302
303 if FileExists(FileName) then begin
304 try
305 XMLDoc := IXMLDocument.Create;
306 //XMLDoc := LoadXMLDocument(FileName);
307 LoadXMLDocument(FileName, XMLDoc);
308 XMLNode := XMLDoc.DocumentElement;
309
310 Stack := TStack.Create;
311 try
312 Stack.Push(Node);
313 LinkExists := False;
314 if XMLNode.NodeName = 'favorite' then begin
315 for i := XMLNode.ChildNodes.Count - 1 downto 0 do begin
316 ReadNode(XMLNode.ChildNodes[i], Stack, FTreeView);
317 if (XMLNode.ChildNodes[i].NodeName = 'folder') and
318 (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
319 LinkExists := True;
320 end;
321 end;
322 end;
323 if not LinkExists then begin
324 FavFolder := TFavoriteFolder.Create;
325 Node := FTreeView.Items.AddChildObjectFirst(Node, FAVORITE_LINK_NAME, FavFolder);
326 Node.ImageIndex := 14;
327 Node.SelectedIndex := 14;
328 end;
329
330 finally
331 Stack.Free;
332 XMLDoc.Free;
333 end;
334 except
335 on e : Exception do begin
336 FABend := True;
337 end;
338 end;
339 end;
340
341 end;
342
343 procedure TFavoriteDM.ReadNode(Node: IXMLNode; Stack: TStack; TreeView: TTreeView);
344 var
345 i: Integer;
346
347 ParentNode: TTreeNode;
348 CurrentNode: TTreeNode;
349 FavFolder: TFavoriteFolder;
350 FavBoard: TFavoriteBoardItem;
351 FavThread: TFavoriteThreadItem;
352 board : TBoard;
353 threadItem : TThreadItem;
354 begin
355 if Node.NodeName = 'folder' then begin
356 CurrentNode := nil;
357 ParentNode := Stack.Peek;
358 if TObject(ParentNode.Data) is TFavoriteFolder then begin
359 FavFolder := TFavoriteFolder.Create;
360 CurrentNode := TreeView.Items.AddChildObjectFirst(ParentNode, Node.Attributes['title'], FavFolder);
361 CurrentNode.ImageIndex := 14;
362 CurrentNode.SelectedIndex := 14;
363 Stack.Push(CurrentNode);
364 end;
365 for i := Node.ChildNodes.Count - 1 downto 0 do begin
366 ReadNode(Node.ChildNodes[i], Stack, TreeView);
367 end;
368 if CurrentNode <> nil then
369 CurrentNode.Expanded := Node.Attributes[ 'expanded' ] = 'true';
370 if Stack.Count <> 0 then
371 Stack.Pop;
372 end else if Node.NodeName = 'favitem' then begin
373 try
374 ParentNode := Stack.Peek;
375 if TObject(ParentNode.Data) is TFavoriteFolder then begin
376 if Node.Attributes['favtype'] = 'board' then begin
377 FavBoard := nil;
378 // ???貼???即?C???端???????????鼎??????
379 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
380 board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
381 if board <> nil then
382 FavBoard := TFavoriteBoardItem.Create(
383 board.URL, MojuUtils.UnSanitize(Node.Attributes[ 'title' ]), board );
384 end else begin
385 FavBoard := TFavoriteBoardItem.Create(
386 Node.Attributes[ 'url' ], MojuUtils.UnSanitize(Node.Attributes[ 'title' ]), nil );
387 end;
388 CurrentNode := TreeView.Items.AddChildObjectFirst(ParentNode, UnSanitize(Node.Attributes['title']), FavBoard);
389 CurrentNode.ImageIndex := 15;
390 CurrentNode.SelectedIndex := 15;
391 end else if Node.Attributes['favtype'] = 'thread' then begin
392 // ???貼???即?C???端???????????鼎??????
393 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
394 board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
395 if board = nil then
396 Exit;
397
398 if not board.IsThreadDatRead then
399 GikoSys.ReadSubjectFile( board );
400 threadItem := board.FindThreadFromFileName( Node.Attributes[ 'thread' ] );
401 if threadItem = nil then begin
402 threadItem := TThreadItem.Create(
403 board.BoardPlugIn,
404 board,
405 GikoSys.Get2chBoard2ThreadURL( board, ChangeFileExt( Node.Attributes[ 'thread' ], '' ) ) );
406 threadItem.Title := UnSanitize(Node.Attributes[ 'title' ]);
407 board.Add( threadItem );
408 end;
409 FavThread := TFavoriteThreadItem.Create(
410 threadItem.URL, UnSanitize(Node.Attributes[ 'title' ]), threadItem );
411 threadItem.Free;
412 end else begin
413 FavThread := TFavoriteThreadItem.Create(
414 Node.Attributes[ 'url' ], UnSanitize(Node.Attributes[ 'title' ]), nil );
415 end;
416 CurrentNode := TreeView.Items.AddChildObjectFirst(ParentNode, UnSanitize(Node.Attributes['title']), FavThread);
417 CurrentNode.ImageIndex := 16;
418 CurrentNode.SelectedIndex := 16;
419 end;
420 end;
421 except
422 // ?????A?C?e???長?但?????N?鼎?????添???A?C?e?????e?甜???^?????足???????長
423 end;
424 end;
425 end;
426
427 procedure TFavoriteDM.WriteFavorite;
428 var
429 FileName, tmpFileName, bakFileName: string;
430 SaveList: TStringList;
431 Buffer: array[0..MAX_PATH] of Char; // ?o?b?t?@
432 FileRep : Boolean;
433 begin
434 FavoriteDM.Modified := true;
435 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
436 SaveList := TStringList.Create;
437 tmpFileName := '';
438 // ???鼎?????p?????t?@?C?????転
439 if GetTempFileName(PChar(GikoSys.GetConfigDir), PChar('fav'), 0, Buffer) <> 0 then begin
440 tmpFileName := Buffer;
441 try
442 try
443 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
444 SaveList.Add('<favorite>');
445 AddSaveString(TreeView.Items.GetFirstNode.getFirstChild, SaveList);
446 SaveList.Add('</favorite>');
447 // ?????t?@?C?????直???徹??
448 SaveList.SaveToFile(tmpFileName);
449 FileRep := True;
450 // ?O???t?@?C???????貼???辿
451 if FileExists(FileName) then begin
452 bakFileName := GikoSys.GetConfigDir + '~' + FAVORITE_FILE_NAME;
453 if FileExists(bakFileName) then begin
454 FileRep := SysUtils.DeleteFile(bakFileName); //SysUtils.?????纏??????WinAPI???????長?鼎???????長
455 end;
456 if FileRep then begin
457 FileRep := RenameFile(FileName, bakFileName);
458 end;
459 end;
460 // ???K???t?@?C???添?????l?[?????辿
461 if FileRep then begin
462 FileRep := RenameFile(tmpFileName, FileName);
463 end;
464 except
465 end;
466 finally
467 SaveList.Free;
468 end;
469 end;
470 end;
471
472 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
473 var
474 s: string;
475 FavBoard: TFavoriteBoardItem;
476 FavThread: TFavoriteThreadItem;
477 data : Pointer;
478 begin
479 while Node <> nil do begin
480 data := Node.Data;
481 if TObject(data) is TFavoriteFolder then begin
482 if Node.Expanded then
483 s := Format('<folder title="%s" expanded="true">', [HtmlEncode(Node.Text)])
484 else
485 s := Format('<folder title="%s" expanded="false">', [HtmlEncode(Node.Text)]);
486 SaveList.Add(s);
487 AddSaveString(Node.getFirstChild, SaveList);
488 SaveList.Add('</folder>');
489 end else if TObject(data) is TFavoriteBoardItem then begin
490 FavBoard := TFavoriteBoardItem(data);
491 s := Format('<favitem type="2ch" favtype="board" url="%s" title="%s"/>',
492 [HtmlEncode( FavBoard.URL ), HtmlEncode(MojuUtils.Sanitize(Node.Text))]);
493 SaveList.Add(s);
494 end else if TObject(data) is TFavoriteThreadItem then begin
495 FavThread := TFavoriteThreadItem(data);
496 s := Format('<favitem type="2ch" favtype="thread" url="%s" title="%s"/>',
497 [HtmlEncode( FavThread.URL ), HtmlEncode(MojuUtils.Sanitize(Node.Text))]);
498 SaveList.Add(s);
499 end;
500 Node := Node.getNextSibling;
501 end;
502 end;
503
504 function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
505 var
506 FavoriteFilePath: string;
507 tempStringList: TStringList;
508 begin
509 WriteFavorite;
510 FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
511
512 if FileExists( FavoriteFilePath ) then begin
513 tempStringList := TStringList.Create;
514 try
515 tempStringList.LoadFromFile( FavoriteFilePath );
516 tempStringList.SaveToFile( FileName );
517 finally
518 tempStringList.Free;
519 end;
520 Result := true;
521 end else begin
522 Result := false;
523 end;
524 end;
525
526 procedure TFavoriteDM.URLReplace(oldURLs: TStringList; newURLs: TStringList);
527 var
528 i : Integer;
529 tmpURL: string;
530 oldHost: string;
531 oldBoardName: string;
532 newHost: string;
533 newBoardName: string;
534 tempString: string;
535 favBoard : TFavoriteBoardItem;
536 favThread : TFavoriteThreadItem;
537 favorites : TTreeNodes;
538 Node : TTreeNode;
539 begin
540
541 // ???|?転?纏??thread???泥???添??URL???`?F?b?N?直?????巽?但?????????鼎?叩???纏?????B
542 favorites := FavoriteDM.FTreeView.Items;
543 for i := 0 to oldURLs.Count - 1 do begin
544 try
545 tmpURL := Copy(oldURLs[i], 1, Length(oldURLs[i]) -1);
546 oldHost := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
547 oldBoardName := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
548 tmpURL := Copy(newURLs[i], 1, Length(newURLs[i]) -1);
549 newHost := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
550 newBoardName := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
551
552 Node := favorites.GetFirstNode.getFirstChild;
553 while Node <> nil do begin
554 try
555 if TObject( Node.Data ) is TFavoriteBoardItem then begin
556 favBoard := TFavoriteBoardItem( Node.Data );
557 if favBoard = nil then continue;
558 tempString := favBoard.URL;
559 if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
560 tempString := StringReplace(tempString, oldHost, newHost,[]);
561 favBoard.URL := tempString;
562 end;
563 end else if TObject( Node.Data ) is TFavoriteThreadItem then begin
564 favThread := TFavoriteThreadItem( Node.Data );
565 if favThread = nil then continue;
566 tempString := favThread.URL;
567 if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
568 tempString := StringReplace(tempString, oldHost, newHost,[]);
569 favThread.URL := tempString;
570 end;
571 end;
572 except
573 end;
574 Node := Node.GetNext;
575 end;
576 except
577 end;
578 end;
579
580 end;
581
582 function TFavoriteDM.GetFavoriteFilePath() : String;
583 begin
584 Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
585 end;
586
587 end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help