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.54 - (show annotations) (download) (as text)
Sun May 24 12:37:06 2009 UTC (14 years, 10 months ago) by h677
Branch: MAIN
Changes since 1.53: +36 -20 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 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
74 implementation
75
76 uses ExternalBoardManager, ExternalBoardPlugInMain, MojuUtils;
77
78 const
79 FAVORITE_ROOT_NAME = '?即?C???端??';
80 FAVORITE_FILE_NAME = 'Favorite.xml';
81
82 {$R *.dfm}
83
84 constructor TFavoriteBoardItem.Create(
85 inURL : string;
86 inTitle : string = '';
87 inItem : TBoard = nil
88 );
89 begin
90
91 inherited Create;
92
93 URL := inURL;
94 Title := inTitle;
95 Item := inItem;
96
97 end;
98
99 constructor TFavoriteBoardItem.CreateWithItem(
100 inItem : TBoard
101 );
102 begin
103
104 Create( inItem.URL, inItem.Title, inItem );
105
106 end;
107 destructor TFavoriteBoardItem.Destory;
108 begin
109 if FItem <> nil then
110 FItem.Free;
111 inherited;
112 end;
113 //! ?徹???直?????辿?????^?C?g????????
114 function TFavoriteBoardItem.GetItemTitle : string;
115 begin
116 Result := '';
117 //???x???????J?????????????鼎?i?N?貼?????L???r?l?b?g???即?C???端???????j
118 //?????鼎??FItem??nil?????長?泥?????鼎????????????
119 if FItem = nil then begin
120 FItem := BBSsFindBoardFromURL(URL);
121 end;
122 if FItem <> nil then begin
123 try
124 if not FItem.IsThreadDatRead then begin
125 GikoSys.ReadSubjectFile(FItem);
126 end;
127 except
128 end;
129 Result := FItem.Title;
130 end;
131 end;
132 function TFavoriteBoardItem.GetItem : TBoard;
133 var
134 protocol, host, path, document, port, bookmark : string;
135 BBSID : string;
136 tmpURL : string;
137 begin
138
139 if FItem = nil then begin
140 FItem := BBSsFindBoardFromURL( URL );
141 if FItem = nil then begin
142 tmpURL := URL;
143 GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
144 if GikoSys.Is2chHost( host ) then begin
145 BBSID := GikoSys.URLToID( tmpURL );
146 FItem := BBSs[ 0 ].FindBBSID( BBSID );
147 if FItem <> nil then
148 URL := FItem.URL;
149 end;
150 {
151 // ???????????A???????辿?J?e?S???????????長???直?足?徹?纏
152 FItem := GikoSys.GetUnknownBoard( nil, URL );
153 FItem.Title := Title;
154 }
155 end;
156 end;
157
158 Result := FItem;
159
160 end;
161
162 constructor TFavoriteThreadItem.Create(
163 inURL : string;
164 inTitle : string = '';
165 inItem : TThreadItem = nil
166 );
167 begin
168
169 inherited Create;
170 URL := inURL;
171
172 Title := inTitle;
173 Item := inItem;
174
175 end;
176
177 constructor TFavoriteThreadItem.CreateWithItem(
178 inItem : TThreadItem
179 );
180 begin
181
182 Create( inItem.URL, inItem.Title, inItem );
183
184 end;
185 destructor TFavoriteThreadItem.Destory;
186 begin
187 if FItem <> nil then
188 FItem.Free;
189 inherited;
190 end;
191 //! ?徹???直?????辿?X?????^?C?g????????
192 function TFavoriteThreadItem.GetItemTitle : string;
193 begin
194 Result := '';
195 if FItem = nil then begin
196 FItem := BBSsFindThreadFromURL(URL);
197 end;
198 if FItem <> nil then begin
199 Result := FItem.Title;
200 end;
201 end;
202
203 function TFavoriteThreadItem.GetItem : TThreadItem;
204 var
205 board : TBoard;
206 boardURL : string;
207 browsableURL : string;
208 protocol, host, path, document, port, bookmark : string;
209 BBSID, BBSKey : string;
210 tmpURL : string;
211 begin
212
213 Result := nil;
214 if FItem = nil then begin
215 browsableURL := GikoSys.GetBrowsableThreadURL( URL );
216 boardURL := GikoSys.GetThreadURL2BoardURL( browsableURL );
217 board := BBSsFindBoardFromURL( boardURL );
218
219 if board = nil then begin
220 tmpURL := URL;
221 GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
222 if GikoSys.Is2chHost( host ) then begin
223 GikoSys.Parse2chURL( tmpURL, path, document, BBSID, BBSKey );
224 board := BBSs[ 0 ].FindBBSID( BBSID );
225 end;
226
227 if board = nil then begin
228 Exit;
229 // ???????????A???????辿?J?e?S???????????長???直?足?徹?纏
230 //board := GikoSys.GetUnknownBoard( nil, boardURL )
231 end;
232 end;
233
234 FItem := board.FindThreadFromURL( browsableURL );
235
236 if FItem = nil then begin
237 tmpURL := URL;
238 GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
239 if GikoSys.Is2chHost( host ) then begin
240 GikoSys.Parse2chURL( tmpURL, path, document, BBSID, BBSKey );
241 FItem := BBSs[ 0 ].FindThreadItem( BBSID, BBSKey + '.dat' );
242 if FItem <> nil then
243 URL := FItem.URL;
244 end;
245 end;
246
247 if FItem = nil then begin
248 FItem := TThreadItem.Create( board.BoardPlugIn, board, browsableURL );
249
250 FItem.Title := Title;
251 board.Add( FItem );
252 end;
253 end;
254
255 Result := FItem;
256
257 end;
258
259 procedure TFavoriteDM.Clear;
260 var
261 Node : TTreeNode;
262 begin
263 TreeView.Items.BeginUpdate;
264 Node := TreeView.Items.GetFirstNode;
265 while Node <> nil do begin
266 if TObject(Node.Data) <> nil then
267 TObject(Node.Data).Free;
268 Node := Node.GetNext;
269 end;
270 TreeView.Items.Clear;
271 TreeView.Items.EndUpdate;
272
273 FavoriteDM.Modified := true;
274 end;
275
276 procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
277 begin
278 FTreeView := TreeView;
279 end;
280
281 procedure TFavoriteDM.ReadFavorite;
282 var
283 FileName: string;
284 XMLDoc: IXMLDocument;
285 XMLNode: IXMLNode;
286 Node: TTreeNode;
287 i: Integer;
288 FavFolder: TFavoriteFolder;
289 LinkExists: Boolean;
290 Stack: TStack;
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 Stack := TStack.Create;
310 try
311 Stack.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], Stack, FTreeView);
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 Stack.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 end;
341
342 procedure TFavoriteDM.ReadNode(Node: IXMLNode; Stack: TStack; TreeView: TTreeView);
343 var
344 i: Integer;
345
346 ParentNode: TTreeNode;
347 CurrentNode: TTreeNode;
348 FavFolder: TFavoriteFolder;
349 FavBoard: TFavoriteBoardItem;
350 FavThread: TFavoriteThreadItem;
351 board : TBoard;
352 threadItem : TThreadItem;
353 begin
354 if Node.NodeName = 'folder' then begin
355 CurrentNode := nil;
356 ParentNode := Stack.Peek;
357 if TObject(ParentNode.Data) is TFavoriteFolder then begin
358 FavFolder := TFavoriteFolder.Create;
359 CurrentNode := TreeView.Items.AddChildObjectFirst(ParentNode, Node.Attributes['title'], FavFolder);
360 CurrentNode.ImageIndex := 14;
361 CurrentNode.SelectedIndex := 14;
362 Stack.Push(CurrentNode);
363 end;
364 for i := Node.ChildNodes.Count - 1 downto 0 do begin
365 ReadNode(Node.ChildNodes[i], Stack, TreeView);
366 end;
367 if CurrentNode <> nil then
368 CurrentNode.Expanded := Node.Attributes[ 'expanded' ] = 'true';
369 if Stack.Count <> 0 then
370 Stack.Pop;
371 end else if Node.NodeName = 'favitem' then begin
372 try
373 ParentNode := Stack.Peek;
374 if TObject(ParentNode.Data) is TFavoriteFolder then begin
375 if Node.Attributes['favtype'] = 'board' then begin
376 FavBoard := nil;
377 // ???貼???即?C???端???????????鼎??????
378 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
379 board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
380 if board <> nil then
381 FavBoard := TFavoriteBoardItem.Create(
382 board.URL, MojuUtils.UnSanitize(Node.Attributes[ 'title' ]), board );
383 end else begin
384 FavBoard := TFavoriteBoardItem.Create(
385 Node.Attributes[ 'url' ], MojuUtils.UnSanitize(Node.Attributes[ 'title' ]), nil );
386 end;
387 CurrentNode := TreeView.Items.AddChildObjectFirst(ParentNode, UnSanitize(Node.Attributes['title']), FavBoard);
388 CurrentNode.ImageIndex := 15;
389 CurrentNode.SelectedIndex := 15;
390 end else if Node.Attributes['favtype'] = 'thread' then begin
391 // ???貼???即?C???端???????????鼎??????
392 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
393 board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
394 if board = nil then
395 Exit;
396
397 if not board.IsThreadDatRead then
398 GikoSys.ReadSubjectFile( board );
399 threadItem := board.FindThreadFromFileName( Node.Attributes[ 'thread' ] );
400 if threadItem = nil then begin
401 threadItem := TThreadItem.Create(
402 board.BoardPlugIn,
403 board,
404 GikoSys.Get2chBoard2ThreadURL( board, ChangeFileExt( Node.Attributes[ 'thread' ], '' ) ) );
405 threadItem.Title := UnSanitize(Node.Attributes[ 'title' ]);
406 board.Add( threadItem );
407 end;
408 FavThread := TFavoriteThreadItem.Create(
409 threadItem.URL, UnSanitize(Node.Attributes[ 'title' ]), threadItem );
410 threadItem.Free;
411 end else begin
412 FavThread := TFavoriteThreadItem.Create(
413 Node.Attributes[ 'url' ], UnSanitize(Node.Attributes[ 'title' ]), nil );
414 end;
415 CurrentNode := TreeView.Items.AddChildObjectFirst(ParentNode, UnSanitize(Node.Attributes['title']), FavThread);
416 CurrentNode.ImageIndex := 16;
417 CurrentNode.SelectedIndex := 16;
418 end;
419 end;
420 except
421 // ?????A?C?e???長?但?????N?鼎?????添???A?C?e?????e?甜???^?????足???????長
422 end;
423 end;
424 end;
425
426 procedure TFavoriteDM.WriteFavorite;
427 var
428 FileName, tmpFileName, bakFileName: string;
429 SaveList: TStringList;
430 Buffer: array[0..MAX_PATH] of Char; // ?o?b?t?@
431 FileRep : Boolean;
432 begin
433 FavoriteDM.Modified := true;
434 FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
435 SaveList := TStringList.Create;
436 tmpFileName := '';
437 // ???鼎?????p?????t?@?C?????転
438 if GetTempFileName(PChar(GikoSys.GetConfigDir), PChar('fav'), 0, Buffer) <> 0 then begin
439 tmpFileName := Buffer;
440 try
441 try
442 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
443 SaveList.Add('<favorite>');
444 AddSaveString(TreeView.Items.GetFirstNode.getFirstChild, SaveList);
445 SaveList.Add('</favorite>');
446 // ?????t?@?C?????直???徹??
447 SaveList.SaveToFile(tmpFileName);
448 FileRep := True;
449 // ?O???t?@?C???????貼???辿
450 if FileExists(FileName) then begin
451 bakFileName := GikoSys.GetConfigDir + '~' + FAVORITE_FILE_NAME;
452 if FileExists(bakFileName) then begin
453 FileRep := SysUtils.DeleteFile(bakFileName); //SysUtils.?????纏??????WinAPI???????長?鼎???????長
454 end;
455 if FileRep then begin
456 FileRep := RenameFile(FileName, bakFileName);
457 end;
458 end;
459 // ???K???t?@?C???添?????l?[?????辿
460 if FileRep then begin
461 FileRep := RenameFile(tmpFileName, FileName);
462 end;
463 except
464 end;
465 finally
466 SaveList.Free;
467 end;
468 end;
469 end;
470
471 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
472 var
473 s: string;
474 FavBoard: TFavoriteBoardItem;
475 FavThread: TFavoriteThreadItem;
476 data : Pointer;
477 begin
478 while Node <> nil do begin
479 data := Node.Data;
480 if TObject(data) is TFavoriteFolder then begin
481 if Node.Expanded then
482 s := Format('<folder title="%s" expanded="true">', [HtmlEncode(Node.Text)])
483 else
484 s := Format('<folder title="%s" expanded="false">', [HtmlEncode(Node.Text)]);
485 SaveList.Add(s);
486 AddSaveString(Node.getFirstChild, SaveList);
487 SaveList.Add('</folder>');
488 end else if TObject(data) is TFavoriteBoardItem then begin
489 FavBoard := TFavoriteBoardItem(data);
490 s := Format('<favitem type="2ch" favtype="board" url="%s" title="%s"/>',
491 [HtmlEncode( FavBoard.URL ), HtmlEncode(MojuUtils.Sanitize(Node.Text))]);
492 SaveList.Add(s);
493 end else if TObject(data) is TFavoriteThreadItem then begin
494 FavThread := TFavoriteThreadItem(data);
495 s := Format('<favitem type="2ch" favtype="thread" url="%s" title="%s"/>',
496 [HtmlEncode( FavThread.URL ), HtmlEncode(MojuUtils.Sanitize(Node.Text))]);
497 SaveList.Add(s);
498 end;
499 Node := Node.getNextSibling;
500 end;
501 end;
502
503 function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
504 var
505 FavoriteFilePath: string;
506 tempStringList: TStringList;
507 begin
508 WriteFavorite;
509 FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
510
511 if FileExists( FavoriteFilePath ) then begin
512 tempStringList := TStringList.Create;
513 try
514 tempStringList.LoadFromFile( FavoriteFilePath );
515 tempStringList.SaveToFile( FileName );
516 finally
517 tempStringList.Free;
518 end;
519 Result := true;
520 end else begin
521 Result := false;
522 end;
523 end;
524
525 procedure TFavoriteDM.URLReplace(oldURLs: TStringList; newURLs: TStringList);
526 var
527 i : Integer;
528 tmpURL: string;
529 oldHost: string;
530 oldBoardName: string;
531 newHost: string;
532 newBoardName: string;
533 tempString: string;
534 favBoard : TFavoriteBoardItem;
535 favThread : TFavoriteThreadItem;
536 favorites : TTreeNodes;
537 Node : TTreeNode;
538 begin
539
540 // ???|?転?纏??thread???泥???添??URL???`?F?b?N?直?????巽?但?????????鼎?叩???纏?????B
541 favorites := FavoriteDM.FTreeView.Items;
542 for i := 0 to oldURLs.Count - 1 do begin
543 try
544 tmpURL := Copy(oldURLs[i], 1, Length(oldURLs[i]) -1);
545 oldHost := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
546 oldBoardName := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
547 tmpURL := Copy(newURLs[i], 1, Length(newURLs[i]) -1);
548 newHost := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
549 newBoardName := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
550
551 Node := favorites.GetFirstNode.getFirstChild;
552 while Node <> nil do begin
553 try
554 if TObject( Node.Data ) is TFavoriteBoardItem then begin
555 favBoard := TFavoriteBoardItem( Node.Data );
556 if favBoard = nil then continue;
557 tempString := favBoard.URL;
558 if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
559 tempString := StringReplace(tempString, oldHost, newHost,[]);
560 favBoard.URL := tempString;
561 end;
562 end else if TObject( Node.Data ) is TFavoriteThreadItem then begin
563 favThread := TFavoriteThreadItem( Node.Data );
564 if favThread = nil then continue;
565 tempString := favThread.URL;
566 if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
567 tempString := StringReplace(tempString, oldHost, newHost,[]);
568 favThread.URL := tempString;
569 end;
570 end;
571 except
572 end;
573 Node := Node.GetNext;
574 end;
575 except
576 end;
577 end;
578
579 end;
580
581 function TFavoriteDM.GetFavoriteFilePath() : String;
582 begin
583 Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
584 end;
585
586 end.

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