Favorite.pas

   1 unit Favorite;
   2
   3 interface
   4
   5 uses
   6         Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,} YofUtils,
   7         GikoSystem{, XMLIntf, XMLDoc}, GikoXMLDoc, BoardGroup;
   8         {SAX, SAXHelpers, SAXComps, SAXKW;}
   9
  10 type
  11         TFavoriteFolder = class
  12         end;
  13
  14         TFavoriteBoardItem = class
  15         private
  16                 FItem                           : TBoard;
  17                 FURL                            : string;
  18                 FTitle                  : string;
  19                 function        GetItem : TBoard;
  20         public
  21                 constructor Create( inURL : string; inTitle : string = ''; inItem : TBoard = nil );
  22                 property Item                           : TBoard        read GetItem write FItem;
  23                 property URL                            : string        read FURL write FURL;   // Item \82ª\8eæ\93¾\82Å\82«\82È\82\82Ä\82à URL \82Í\8fí\82É\95Û\8e\9d\82³\82ê\82é
  24                 property Title                  : string        read FTitle write FTitle;
  25         end;
  26
  27         TFavoriteThreadItem = class
  28         private
  29                 FItem                           : TThreadItem;
  30                 FURL                            : string;
  31                 FTitle                  : string;
  32                 function        GetItem : TThreadItem;
  33         public
  34                 constructor Create( inURL : string; inTitle : string = ''; inItem : TThreadItem = nil );
  35                 property Item                           : TThreadItem   read GetItem write FItem;
  36                 property URL                            : string                        read FURL write FURL;   // Item \82ª\8eæ\93¾\82Å\82«\82È\82\82Ä\82à URL \82Í\8fí\82É\95Û\8e\9d\82³\82ê\82é
  37                 property Title                  : string                        read FTitle write FTitle;
  38         end;
  39
  40         TFavoriteDM = class(TDataModule)
  41                 procedure DataModuleCreate(Sender: TObject);
  42                 procedure DataModuleDestroy(Sender: TObject);
  43         private
  44                 { Private \90é\8c¾ }
  45                 FStack: TStack;
  46                 FTreeView: TTreeView;
  47
  48                 procedure ReadNode(Node: IXMLNode);
  49                 procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
  50 //              procedure AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
  51 //              procedure SAXStartDocument(Sender: TObject);
  52 //              procedure SAXEndDocument(Sender: TObject);
  53 //              procedure SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; const Atts: IAttributes);
  54 //              procedure SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
  55 //              procedure SAXCharacters(Sender: TObject; const PCh: SAXString);
  56         public
  57                 { Public \90é\8c¾ }
  58                                 function GetFavoriteFilePath() : String;
  59                                 function SaveFavoriteFile(FileName: String) : Boolean;
  60                 procedure SetFavTreeView(TreeView: TTreeView);
  61                 procedure ReadFavorite;
  62                 procedure WriteFavorite;
  63                 property TreeView: TTreeView read FTreeView;
  64         end;
  65
  66 var
  67         FavoriteDM: TFavoriteDM;
  68 const
  69         FAVORITE_LINK_NAME = '\83\8a\83\93\83N';
  70
  71 implementation
  72
  73 uses    ExternalBoardManager, ExternalBoardPlugInMain;
  74
  75 const
  76         FAVORITE_ROOT_NAME = '\82¨\8bC\82É\93ü\82è';
  77         FAVORITE_FILE_NAME = 'Favorite.xml';
  78
  79 {$R *.dfm}
  80
  81 constructor TFavoriteBoardItem.Create(
  82         inURL           : string;
  83         inTitle : string = '';
  84         inItem  : TBoard = nil
  85 );
  86 begin
  87
  88         inherited Create;
  89
  90         URL             := inURL;
  91         Title   := inTitle;
  92         Item    := inItem;
  93
  94 end;
  95
  96 function        TFavoriteBoardItem.GetItem : TBoard;
  97 begin
  98
  99         if FItem = nil then begin
 100                 FItem := BBSsFindBoardFromURL( URL );
 101                 // \8b\8c\8e®\82Ì\82¨\8bC\82É\93ü\82è\82Æ\82Ì\8cÝ\8a·\90«\82Ì\82½\82ß
 102                 if FItem = nil then
 103                         // \81¦\8dì\82Á\82Ä\82à\81A\92Ç\89Á\82·\82é\83J\83e\83S\83\8a\82ª\96³\82¢\82Ì\82Å\8c\83\82µ\82\95Û\97¯
 104                         FItem := TBoard.Create( nil, URL );
 105         end;
 106
 107         Result := FItem;
 108
 109 end;
 110
 111 constructor TFavoriteThreadItem.Create(
 112         inURL           : string;
 113         inTitle : string = '';
 114         inItem  : TThreadItem = nil
 115 );
 116 begin
 117
 118         inherited Create;
 119
 120         URL             := inURL;
 121         Title   := inTitle;
 122         Item    := inItem;
 123
 124 end;
 125
 126 function        TFavoriteThreadItem.GetItem : TThreadItem;
 127 var
 128         threadItem      : TThreadItem;
 129         boardPlugIn     : TBoardPlugIn;
 130         board                           : TBoard;
 131         boardURL                : string;
 132         i                                               : Integer;
 133 begin
 134
 135         if FItem = nil then begin
 136                 //===== \83v\83\89\83O\83C\83\93
 137                 boardPlugIn     := nil;
 138                 try
 139                         for i := Length( BoardPlugIns ) - 1 downto 0 do begin
 140                                 if Assigned( Pointer( BoardPlugIns[ i ].Module ) ) then begin
 141                                         if BoardPlugIns[ i ].AcceptURL( url ) = atThread then begin
 142                                                 boardPlugIn := BoardPlugIns[ i ];
 143                                                 threadItem      := TThreadItem.Create(boardPlugIn, URL );
 144                                                 boardURL                := BoardPlugIns[ i ].GetBoardURL( Longword( threadItem ) );
 145                                                 threadItem.Free;
 146
 147                                                 Break;
 148                                         end;
 149                                 end;
 150                         end;
 151                 except
 152                         // exception \82ª\94\90¶\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
 153                 end;
 154
 155                 if Length( boardURL ) = 0 then
 156                         boardURL := GikoSys.Get2chThreadURL2BoardURL( URL );
 157
 158                 board   := BBSsFindBoardFromURL( boardURL );
 159
 160                 if board = nil then
 161                         // \81¦\8dì\82Á\82Ä\82à\81A\92Ç\89Á\82·\82é\83J\83e\83S\83\8a\82ª\96³\82¢\82Ì\82Å\8c\83\82µ\82\95Û\97¯
 162                         board := TBoard.Create( nil, boardURL )
 163                 else
 164                         FItem := board.FindThreadFromURL( URL );
 165
 166                 if FItem = nil then
 167                         FItem := TThreadItem.Create( boardPlugIn, URL );
 168
 169                 FItem.Title := Title;
 170                 board.Add( FItem );
 171         end;
 172
 173         Result := FItem;
 174
 175 end;
 176
 177 procedure TFavoriteDM.DataModuleCreate(Sender: TObject);
 178 begin
 179         //FTreeView := TreeView;
 180         //FTreeView := GikoForm.FavoriteTreeView;
 181 end;
 182
 183 procedure TFavoriteDM.DataModuleDestroy(Sender: TObject);
 184 var
 185         i: Integer;
 186 begin
 187         for i := 0 to TreeView.Items.Count - 1 do begin
 188                 TObject(TreeView.Items[i].Data).Free;
 189         end;
 190 end;
 191
 192 procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
 193 begin
 194         FTreeView := TreeView;
 195 end;
 196
 197 procedure TFavoriteDM.ReadFavorite;
 198 var
 199         FileName: string;
 200         XMLDoc: IXMLDocument;
 201         XMLNode: IXMLNode;
 202         Node: TTreeNode;
 203         i: Integer;
 204         FavFolder: TFavoriteFolder;
 205         LinkExists: Boolean;
 206 begin
 207
 208         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 209
 210         FavFolder := TFavoriteFolder.Create;
 211         Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
 212         Node.ImageIndex := 14;
 213         Node.SelectedIndex := 14;
 214
 215         if FileExists(FileName) then begin
 216                 try
 217                         XMLDoc := LoadXMLDocument(FileName);
 218                         XMLNode := XMLDoc.DocumentElement;
 219
 220                         FStack := TStack.Create;
 221                         try
 222                                 FStack.Push(Node);
 223                                 LinkExists := False;
 224                                 if XMLNode.NodeName = 'favorite' then begin
 225                                         for i := 0 to XMLNode.ChildNodes.Count - 1 do begin
 226                                                 ReadNode(XMLNode.ChildNodes[i]);
 227                                                 if (XMLNode.ChildNodes[i].NodeName = 'folder') and
 228                                                          (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
 229                                                         LinkExists := True;
 230                                                 end;
 231                                         end;
 232                                 end;
 233                                 if not LinkExists then begin
 234                                         FavFolder := TFavoriteFolder.Create;
 235                                         Node := FTreeView.Items.AddChildObject(Node, FAVORITE_LINK_NAME, FavFolder);
 236                                         Node.ImageIndex := 14;
 237                                         Node.SelectedIndex := 14;
 238                                 end;
 239                         finally
 240                                 FStack.Free;
 241                         end;
 242                 except
 243                 end;
 244         end;
 245
 246 {
 247         FavFolder := TFavoriteFolder.Create;
 248         Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
 249         Node.ImageIndex := 12;
 250         Node.SelectedIndex := 13;
 251
 252         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 253         if not FileExists(FileName) then
 254                 Exit;
 255
 256                 FavSAXHandler.OnStartDocument := SAXStartDocument;
 257                 FavSAXHandler.OnEndDocument := SAXEndDocument;
 258                 FavSAXHandler.OnStartElement := SAXStartElement;
 259                 FavSAXHandler.OnStartElement := SAXStartElement;
 260                 FavSAXHandler.OnEndElement := SAXEndElement;
 261                 FavSAXHandler.OnCharacters := SAXCharacters;
 262
 263                 FavSAXReader.Vendor := 'Keith Wood';
 264                 FavSAXReader.URL := FileName;
 265                 FavSAXReader.Parse;}
 266 end;
 267
 268 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
 269 var
 270         i: Integer;
 271         j, jBound : Integer;
 272
 273         ParentNode: TTreeNode;
 274         CurrentNode: TTreeNode;
 275         FavFolder: TFavoriteFolder;
 276         FavBoard: TFavoriteBoardItem;
 277         FavThread: TFavoriteThreadItem;
 278         board                           : TBoard;
 279         threadItem      : TThreadItem;
 280         url                                     : string;
 281 begin
 282         if Node.NodeName = 'folder' then begin
 283                 ParentNode := FStack.Peek;
 284                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 285                         FavFolder := TFavoriteFolder.Create;
 286                         CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
 287                         CurrentNode.ImageIndex := 14;
 288                         CurrentNode.SelectedIndex := 14;
 289                         CurrentNode.Expanded := Node.Attributes[ 'expanded' ] = 'true';
 290                         FStack.Push(CurrentNode);
 291                 end;
 292                 for i := 0 to Node.ChildNodes.Count - 1 do begin
 293                         ReadNode(Node.ChildNodes[i]);
 294                 end;
 295                 if FStack.Count <> 0 then
 296                         FStack.Pop;
 297         end else if Node.NodeName = 'favitem' then begin
 298                 ParentNode := FStack.Peek;
 299                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 300                         if Node.Attributes['favtype'] = 'board' then begin
 301                                 // \8b\8c\8e®\82Ì\82¨\8bC\82É\93ü\82è\82Æ\82Ì\8cÝ\8a·\90«\82Ì\82½\82ß
 302                                 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
 303                                         board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
 304                                         FavBoard := TFavoriteBoardItem.Create(
 305                                                 board.URL, Node.Attributes[ 'title' ], board );
 306                                 end else begin
 307                                         FavBoard := TFavoriteBoardItem.Create(
 308                                                 Node.Attributes[ 'url' ], Node.Attributes[ 'title' ], board );
 309                                 end;
 310                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
 311                                 CurrentNode.ImageIndex := 15;
 312                                 CurrentNode.SelectedIndex := 15;
 313                         end else if Node.Attributes['favtype'] = 'thread' then begin
 314                                 // \8b\8c\8e®\82Ì\82¨\8bC\82É\93ü\82è\82Æ\82Ì\8cÝ\8a·\90«\82Ì\82½\82ß
 315                                 if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
 316                                         board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
 317                                         if board = nil then
 318                                                 Exit;
 319
 320                                         if not board.IsThreadDatRead then
 321                                                 GikoSys.ReadSubjectFile( board );
 322                                         threadItem := board.Find( Node.Attributes[ 'thread' ] );
 323                                         if threadItem = nil then begin
 324                                                 threadItem := TThreadItem.Create(
 325                                                         board.BoardPlugIn,
 326                                                         GikoSys.Get2chBoard2ThreadURL( board, ChangeFileExt( Node.Attributes[ 'thread' ], '' ) ) );
 327                                                 threadItem.Title := Node.Attributes[ 'title' ];
 328                                                 board.Add( threadItem );
 329                                         end;
 330                                         FavThread := TFavoriteThreadItem.Create(
 331                                                 threadItem.URL, Node.Attributes[ 'title' ], threadItem );
 332                                 end else begin
 333                                         FavThread := TFavoriteThreadItem.Create(
 334                                                 Node.Attributes[ 'url' ], Node.Attributes[ 'title' ], threadItem );
 335                                 end;
 336                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
 337                                 CurrentNode.ImageIndex := 16;
 338                                 CurrentNode.SelectedIndex := 16;
 339                         end;
 340                 end;
 341         end;
 342 end;
 343
 344 procedure TFavoriteDM.WriteFavorite;
 345 {
 346 var
 347         FileName: string;
 348 //      SaveList: TStringList;
 349 //      i: Integer;
 350 //      Count: Integer;
 351
 352         XMLDoc: IXMLDocument;
 353         XMLNode: IXMLNode;
 354 //      FavoNode: IXMLNode;
 355 begin
 356         XMLDoc :=       NewXMLDocument;
 357         XMLDoc.Encoding := 'Shift_JIS';
 358         XMLDoc.StandAlone := 'yes';
 359         XMLNode := XMLDoc.AddChild('favorite');
 360         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 361         AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
 362         XMLDoc.SaveToFile(FileName);
 363 }
 364 var
 365         FileName: string;
 366         SaveList: TStringList;
 367 begin
 368         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 369         SaveList := TStringList.Create;
 370         try
 371                 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
 372                 SaveList.Add('<favorite>');
 373                 AddSaveString(TreeView.Items.GetFirstNode, SaveList);
 374                 SaveList.Add('</favorite>');
 375                 SaveList.SaveToFile(FileName);
 376         finally
 377                 SaveList.Free;
 378         end;
 379 end;
 380
 381 {
 382 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
 383 var
 384         i: Integer;
 385 //      s: string;
 386         FavBoard: TFavoriteBoardItem;
 387         FavThread: TFavoriteThreadItem;
 388         FavNode: IXMLNode;
 389 begin
 390         for i := 0 to Node.Count - 1 do begin
 391                 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
 392                         FavNode := XMLNode.AddChild('folder');
 393                         FavNode.Attributes['title'] := Node.Item[i].Text;
 394                         AddSaveString(Node.Item[i], FavNode);
 395                 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
 396                         FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
 397                         FavNode := XMLNode.AddChild('favitem');
 398                         FavNode.Attributes['type'] := '2ch';
 399                         FavNode.Attributes['favtype'] := 'board';
 400                         FavNode.Attributes['bbs'] := FavBoard.BBSID;
 401                         FavNode.Attributes['title'] := Node.Item[i].Text;
 402                         FavNode.Attributes['boardname'] := FavBoard.BoardName;
 403                 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
 404                         FavThread := TFavoriteThreadItem(Node.Item[i].Data);
 405                         FavNode := XMLNode.AddChild('favitem');
 406                         FavNode.Attributes['type'] := '2ch';
 407                         FavNode.Attributes['favtype'] := 'thread';
 408                         FavNode.Attributes['bbs'] := FavThread.BBSID;
 409                         FavNode.Attributes['thread'] := FavThread.ThreadID;
 410                         FavNode.Attributes['title'] := Node.Item[i].Text;
 411                         FavNode.Attributes['threadname'] := FavThread.ThreadName;
 412                 end;
 413         end;
 414 end;
 415 }
 416
 417 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
 418 var
 419         i: Integer;
 420         s: string;
 421         FavBoard: TFavoriteBoardItem;
 422         FavThread: TFavoriteThreadItem;
 423 begin
 424         for i := 0 to Node.Count - 1 do begin
 425                 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
 426                         if Node.Item[ i ].Expanded then
 427                                 s := Format('<folder title="%s" expanded="true">', [HttpEncode(Node.Item[i].Text)])
 428                         else
 429                                 s := Format('<folder title="%s" expanded="false">', [HttpEncode(Node.Item[i].Text)]);
 430                         SaveList.Add(s);
 431                         AddSaveString(Node.Item[i], SaveList);
 432                         SaveList.Add('</folder>');
 433                 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
 434                         FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
 435                         s := Format('<favitem type="2ch" favtype="board" url="%s" title="%s"/>',
 436                                                                         [HttpEncode( FavBoard.URL ), HttpEncode(FavBoard.Title)]);
 437                         SaveList.Add(s);
 438                 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
 439                         FavThread := TFavoriteThreadItem(Node.Item[i].Data);
 440                         s := Format('<favitem type="2ch" favtype="thread" url="%s" title="%s"/>',
 441                                                                         [HttpEncode( FavThread.URL ), HttpEncode(FavThread.Title)]);
 442                         SaveList.Add(s);
 443                 end;
 444         end;
 445 end;
 446
 447 {
 448 procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
 449 begin
 450         FStack := TStack.Create;
 451         FStack.Push(FTreeView.Items.GetFirstNode);
 452 end;
 453
 454 procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
 455 begin
 456         FStack.Free;
 457 end;
 458
 459 procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
 460         const Atts: IAttributes);
 461 var
 462         FavType: string;
 463         ParentNode: TTreeNode;
 464         CurrentNode: TTreeNode;
 465         FavFolder: TFavoriteFolder;
 466         FavBoard: TFavoriteBoardItem;
 467         FavThread: TFavoriteThreadItem;
 468 begin
 469         if QName = 'folder' then begin
 470                 ParentNode := FStack.Peek;
 471                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 472                         FavFolder := TFavoriteFolder.Create;
 473                         CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
 474                         CurrentNode.ImageIndex := 12;
 475                         CurrentNode.SelectedIndex := 13;
 476                         FStack.Push(CurrentNode);
 477                 end;
 478         end else if QName = 'favitem' then begin
 479                 ParentNode := FStack.Peek;
 480                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 481                         FavType := Atts.getValue('favtype');
 482                         if FavType = 'board' then begin
 483                                 FavBoard := TFavoriteBoardItem.Create;
 484                                 FavBoard.BBSID := Atts.getValue('bbs');
 485                                 FavBoard.BoardName := Atts.getValue('boardname');
 486                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
 487                                 CurrentNode.ImageIndex := 14;
 488                                 CurrentNode.SelectedIndex := 15;
 489                         end else if FavType = 'thread' then begin
 490                                 FavThread := TFavoriteThreadItem.Create;
 491                                 FavThread.BBSID := Atts.getValue('bbs');
 492                                 FavThread.ThreadID := Atts.getValue('thread');
 493                                 FavThread.ThreadName := Atts.getValue('threadname');
 494                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
 495                                 CurrentNode.ImageIndex := 16;
 496                                 CurrentNode.SelectedIndex := 17;
 497                         end;
 498                 end;
 499         end;
 500 end;
 501
 502 procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
 503 begin
 504         if QName = 'folder' then begin
 505                 if FStack.Count <> 0 then
 506                         FStack.Pop;
 507         end;
 508 end;
 509
 510 procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
 511 begin
 512 //
 513 end;
 514 }
 515 function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
 516 var
 517         FavoriteFilePath: string;
 518                 tempStringList: TStringList;
 519 begin
 520
 521         FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 522
 523         if FileExists( FavoriteFilePath ) then begin
 524                 tempStringList := TStringList.Create;
 525                 try
 526                         tempStringList.LoadFromFile( FavoriteFilePath );
 527                         tempStringList.SaveToFile( FileName );
 528                 finally
 529                         tempStringList.Free;
 530                 end;
 531                 Result := true;
 532         end else begin
 533                 Result := false;
 534         end;
 535 end;
 536
 537 function TFavoriteDM.GetFavoriteFilePath() : String;
 538 begin
 539         Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 540 end;
 541
 542 end.