Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/Favorite.pas

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

revision 1.3 by yoffy, Sun Sep 21 08:46:17 2003 UTC revision 1.3.2.1 by yoffy, Mon Apr 19 22:46:48 2004 UTC
# Line 4  interface Line 4  interface
4    
5  uses  uses
6          Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,} YofUtils,          Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,} YofUtils,
7          GikoSystem{, XMLIntf, XMLDoc}, GikoXMLDoc;          GikoSystem{, XMLIntf, XMLDoc}, GikoXMLDoc, BoardGroup, windows,
8        MojuUtils;
9          {SAX, SAXHelpers, SAXComps, SAXKW;}          {SAX, SAXHelpers, SAXComps, SAXKW;}
10    
11  type  type
# Line 13  type Line 14  type
14    
15          TFavoriteBoardItem = class          TFavoriteBoardItem = class
16          private          private
17                  FBBSID: string;                  FItem                           : TBoard;
18                  FBoardName: string;                  FURL                            : string;
19                    FTitle                  : string;
20                    function        GetItem : TBoard;
21          public          public
22                  property BBSID: string read FBBSID write FBBSID;                  constructor Create( inURL : string; inTitle : string = ''; inItem : TBoard = nil );
23                  property BoardName: string read FBoardName write FBoardName;                  constructor CreateWithItem( inItem : TBoard );
24            destructor Destory;
25                    property Item                           : TBoard        read GetItem write FItem;
26                    property URL                            : string        read FURL write FURL;   // Item が取得できなくても URL は常に保持される
27                    property Title                  : string        read FTitle write FTitle;
28          end;          end;
29    
30          TFavoriteThreadItem = class          TFavoriteThreadItem = class
31          private          private
32                  FBBSID: string;                  FItem                           : TThreadItem;
33                  FThreadID: string;                  FURL                            : string;
34                  FThreadName: string;                  FTitle                  : string;
35                    function        GetItem : TThreadItem;
36          public          public
37                  property BBSID: string read FBBSID write FBBSID;                  constructor Create( inURL : string; inTitle : string = ''; inItem : TThreadItem = nil );
38                  property ThreadID: string read FThreadID write FThreadID;                  constructor CreateWithItem( inItem : TThreadItem );
39                  property ThreadName: string read FThreadName write FThreadName;          destructor Destory;
40                    property Item                           : TThreadItem   read GetItem write FItem;
41                    property URL                            : string                        read FURL write FURL;   // Item が取得できなくても URL は常に保持される
42                    property Title                  : string                        read FTitle write FTitle;
43          end;          end;
44    
45          TFavoriteDM = class(TDataModule)          TFavoriteDM = class(TDataModule)
                 procedure DataModuleCreate(Sender: TObject);  
46                  procedure DataModuleDestroy(Sender: TObject);                  procedure DataModuleDestroy(Sender: TObject);
47          private          private
48                  { Private 宣言 }                  { Private 宣言 }
# Line 49  type Line 59  type
59  //              procedure SAXCharacters(Sender: TObject; const PCh: SAXString);  //              procedure SAXCharacters(Sender: TObject; const PCh: SAXString);
60          public          public
61                  { Public 宣言 }                  { Public 宣言 }
62            procedure Clear;
63                                    function GetFavoriteFilePath() : String;
64                                    function SaveFavoriteFile(FileName: String) : Boolean;
65                  procedure SetFavTreeView(TreeView: TTreeView);                  procedure SetFavTreeView(TreeView: TTreeView);
66                  procedure ReadFavorite;                  procedure ReadFavorite;
67                  procedure WriteFavorite;                  procedure WriteFavorite;
68            procedure URLReplace(oldURLs: TStringList; newURLs: TStringList);
69                  property TreeView: TTreeView read FTreeView;                  property TreeView: TTreeView read FTreeView;
70          end;          end;
71    
# Line 62  const Line 76  const
76    
77  implementation  implementation
78    
79    uses    ExternalBoardManager, ExternalBoardPlugInMain;
80    
81  const  const
82          FAVORITE_ROOT_NAME = 'お気に入り';          FAVORITE_ROOT_NAME = 'お気に入り';
83          FAVORITE_FILE_NAME = 'Favorite.xml';          FAVORITE_FILE_NAME = 'Favorite.xml';
84    
85  {$R *.dfm}  {$R *.dfm}
86    
87  procedure TFavoriteDM.DataModuleCreate(Sender: TObject);  constructor TFavoriteBoardItem.Create(
88            inURL           : string;
89            inTitle : string = '';
90            inItem  : TBoard = nil
91    );
92    begin
93    
94            inherited Create;
95    
96            URL             := inURL;
97            Title   := inTitle;
98            Item    := inItem;
99    
100    end;
101    
102    constructor TFavoriteBoardItem.CreateWithItem(
103            inItem  : TBoard
104    );
105    begin
106    
107            Create( inItem.URL, inItem.Title, inItem );
108    
109    end;
110    destructor TFavoriteBoardItem.Destory;
111    begin
112            if FItem <> nil then
113            FItem.Free;
114        inherited;
115    end;
116    function        TFavoriteBoardItem.GetItem : TBoard;
117    var
118            protocol, host, path, document, port, bookmark : string;
119            BBSID{, BBSKey} : string;
120            tmpURL                          : string;
121    //      category : TCategory;
122    begin
123    
124            if FItem = nil then begin
125                    FItem := BBSsFindBoardFromURL( URL );
126                    if FItem = nil then begin
127                            tmpURL := URL;
128                            GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
129                            if GikoSys.Is2chHost( host ) then begin
130                                    BBSID := GikoSys.URLToID( tmpURL );
131                                    FItem := BBSs[ 0 ].FindBBSID( BBSID );
132                                    if FItem <> nil then
133                                            URL := FItem.URL;
134                            end;
135                            {
136                            // ※作っても、追加するカテゴリが無いので激しく保留
137                            FItem                           := GikoSys.GetUnknownBoard( nil, URL );
138                            FItem.Title     := Title;
139                            }
140                    end;
141            end;
142    
143            Result := FItem;
144    
145    end;
146    
147    constructor TFavoriteThreadItem.Create(
148            inURL           : string;
149            inTitle : string = '';
150            inItem  : TThreadItem = nil
151    );
152    begin
153    
154            inherited Create;
155    
156            URL             := inURL;
157            Title   := inTitle;
158            Item    := inItem;
159    
160    end;
161    
162    constructor TFavoriteThreadItem.CreateWithItem(
163            inItem  : TThreadItem
164    );
165    begin
166    
167            Create( inItem.URL, inItem.Title, inItem );
168    
169    end;
170    destructor TFavoriteThreadItem.Destory;
171  begin  begin
172          //FTreeView := TreeView;          if FItem <> nil then
173          //FTreeView := GikoForm.FavoriteTreeView;          FItem.Free;
174        inherited;
175    end;
176    
177    function        TFavoriteThreadItem.GetItem : TThreadItem;
178    var
179            board                                   : TBoard;
180            boardURL                        : string;
181            browsableURL    : string;
182            protocol, host, path, document, port, bookmark : string;
183            BBSID, BBSKey   : string;
184            tmpURL                          : string;
185    begin
186    
187            Result := nil;
188            if FItem = nil then begin
189                    browsableURL    := GikoSys.GetBrowsableThreadURL( URL );
190                    boardURL                        := GikoSys.GetThreadURL2BoardURL( browsableURL );
191                    board                                   := BBSsFindBoardFromURL( boardURL );
192    
193                    if board = nil then begin
194                            tmpURL := URL;
195                            GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
196                            if GikoSys.Is2chHost( host ) then begin
197                                    GikoSys.Parse2chURL( tmpURL, path, document, BBSID, BBSKey );
198                                    board := BBSs[ 0 ].FindBBSID( BBSID );
199                            end;
200    
201                            if board = nil then begin
202                                    Exit;
203                                    // ※作っても、追加するカテゴリが無いので激しく保留
204                                    //board := GikoSys.GetUnknownBoard( nil, boardURL )
205                            end;
206                    end;
207    
208                    FItem := board.FindThreadFromURL( browsableURL );
209    
210                    if FItem = nil then begin
211                            tmpURL := URL;
212                            GikoSys.ParseURI( tmpURL, protocol, host, path, document, port, bookmark );
213                            if GikoSys.Is2chHost( host ) then begin
214                                    GikoSys.Parse2chURL( tmpURL, path, document, BBSID, BBSKey );
215                                    FItem := BBSs[ 0 ].FindThreadItem( BBSID, BBSKey + '.dat' );
216                                    if FItem <> nil then
217                                            URL := FItem.URL;
218                            end;
219                    end;
220    
221                    if FItem = nil then begin
222                            FItem := TThreadItem.Create( board.BoardPlugIn, browsableURL );
223    
224                            FItem.Title := Title;
225                            board.Add( FItem );
226                    end;
227            end;
228    
229            Result := FItem;
230    
231  end;  end;
232    
233  procedure TFavoriteDM.DataModuleDestroy(Sender: TObject);  procedure TFavoriteDM.DataModuleDestroy(Sender: TObject);
234    //var
235    //      i: Integer;
236    begin
237    {    TreeView.Items.BeginUpdate;
238            for i := TreeView.Items.Count - 1 downto 0 do begin
239               //   if TObject(TreeView.Items[i].Data) <> nil then
240           //       TObject(TreeView.Items[i].Data).Free;
241            end;
242        TreeView.Items.Clear;
243        TreeView.Items.EndUpdate;
244    }    //TreeView.Free;
245    end;
246    procedure TFavoriteDM.Clear;
247  var  var
248          i: Integer;          i: Integer;
249  begin  begin
250          for i := 0 to TreeView.Items.Count - 1 do begin      TreeView.Items.BeginUpdate;
251                  TObject(TreeView.Items[i].Data).Free;          for i := TreeView.Items.Count - 1 downto 0 do begin
252          end;                  if TObject(TreeView.Items[i].Data) <> nil then
253                    TObject(TreeView.Items[i].Data).Free;
254            end;
255        TreeView.Items.Clear;
256        TreeView.Items.EndUpdate;
257        //TreeView.Free;
258  end;  end;
259    
260  procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);  procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
# Line 108  begin Line 282  begin
282    
283          if FileExists(FileName) then begin          if FileExists(FileName) then begin
284                  try                  try
285                          XMLDoc := LoadXMLDocument(FileName);              XMLDoc := IXMLDocument.Create;
286                            //XMLDoc := LoadXMLDocument(FileName);
287                LoadXMLDocument(FileName, XMLDoc);
288                          XMLNode := XMLDoc.DocumentElement;                          XMLNode := XMLDoc.DocumentElement;
289    
290                          FStack := TStack.Create;                          FStack := TStack.Create;
# Line 132  begin Line 308  begin
308                                  end;                                  end;
309                          finally                          finally
310                                  FStack.Free;                                  FStack.Free;
311                    XMLDoc.Free;
312                          end;                          end;
313                  except                  except
314                  end;                  end;
# Line 168  var Line 345  var
345          FavFolder: TFavoriteFolder;          FavFolder: TFavoriteFolder;
346          FavBoard: TFavoriteBoardItem;          FavBoard: TFavoriteBoardItem;
347          FavThread: TFavoriteThreadItem;          FavThread: TFavoriteThreadItem;
348            board                           : TBoard;
349            threadItem      : TThreadItem;
350  begin  begin
351          if Node.NodeName = 'folder' then begin          if Node.NodeName = 'folder' then begin
352                  ParentNode := FStack.Peek;                  ParentNode := FStack.Peek;
# Line 176  begin Line 355  begin
355                          CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);                          CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
356                          CurrentNode.ImageIndex := 14;                          CurrentNode.ImageIndex := 14;
357                          CurrentNode.SelectedIndex := 14;                          CurrentNode.SelectedIndex := 14;
358                            CurrentNode.Expanded := Node.Attributes[ 'expanded' ] = 'true';
359                          FStack.Push(CurrentNode);                          FStack.Push(CurrentNode);
360                  end;                  end;
361                  for i := 0 to Node.ChildNodes.Count - 1 do begin                  for i := 0 to Node.ChildNodes.Count - 1 do begin
# Line 184  begin Line 364  begin
364                  if FStack.Count <> 0 then                  if FStack.Count <> 0 then
365                          FStack.Pop;                          FStack.Pop;
366          end else if Node.NodeName = 'favitem' then begin          end else if Node.NodeName = 'favitem' then begin
367                  ParentNode := FStack.Peek;                  try
368                  if TObject(ParentNode.Data) is TFavoriteFolder then begin                          ParentNode := FStack.Peek;
369                          if Node.Attributes['favtype'] = 'board' then begin                          if TObject(ParentNode.Data) is TFavoriteFolder then begin
370                                  FavBoard := TFavoriteBoardItem.Create;                                  if Node.Attributes['favtype'] = 'board' then begin
371                                  FavBoard.BBSID := Node.Attributes['bbs'];                                          FavBoard := nil;
372                                  FavBoard.BoardName := Node.Attributes['boardname'];                                          // 旧式のお気に入りとの互換性のため
373                                  CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);                                          if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
374                                  CurrentNode.ImageIndex := 15;                                                  board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
375                                  CurrentNode.SelectedIndex := 15;                                                  if board <> nil then
376                          end else if Node.Attributes['favtype'] = 'thread' then begin                                                          FavBoard := TFavoriteBoardItem.Create(
377                                  FavThread := TFavoriteThreadItem.Create;                                                                  board.URL, Node.Attributes[ 'title' ], board );
378                                  FavThread.BBSID := Node.Attributes['bbs'];                                          end else begin
379                                  FavThread.ThreadID := Node.Attributes['thread'];                                                  FavBoard := TFavoriteBoardItem.Create(
380                                  FavThread.ThreadName := Node.Attributes['threadname'];                                                          Node.Attributes[ 'url' ], Node.Attributes[ 'title' ], nil );
381                                  CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);                                          end;
382                                  CurrentNode.ImageIndex := 16;                                          CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
383                                  CurrentNode.SelectedIndex := 16;                                          CurrentNode.ImageIndex := 15;
384                                            CurrentNode.SelectedIndex := 15;
385                                    end else if Node.Attributes['favtype'] = 'thread' then begin
386                                            // 旧式のお気に入りとの互換性のため
387                                            if Length( Node.Attributes[ 'bbs' ] ) > 0 then begin
388                                                    board := BBSsFindBoardFromBBSID( Node.Attributes[ 'bbs' ] );
389                                                    if board = nil then
390                                                            Exit;
391    
392                                                    if not board.IsThreadDatRead then
393                                                            GikoSys.ReadSubjectFile( board );
394                                                    threadItem := board.FindThreadFromFileName( Node.Attributes[ 'thread' ] );
395                                                    if threadItem = nil then begin
396                                                            threadItem := TThreadItem.Create(
397                                                                    board.BoardPlugIn,
398                                                                    GikoSys.Get2chBoard2ThreadURL( board, ChangeFileExt( Node.Attributes[ 'thread' ], '' ) ) );
399                                                            threadItem.Title := Node.Attributes[ 'title' ];
400                                                            board.Add( threadItem );
401                                                    end;
402                                                    FavThread := TFavoriteThreadItem.Create(
403                                                            threadItem.URL, Node.Attributes[ 'title' ], threadItem );
404                            threadItem.Free;
405                                            end else begin
406                                                    FavThread := TFavoriteThreadItem.Create(
407                                                            Node.Attributes[ 'url' ], Node.Attributes[ 'title' ], nil );
408                                            end;
409                                            CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
410                                            CurrentNode.ImageIndex := 16;
411                                            CurrentNode.SelectedIndex := 16;
412                                    end;
413                          end;                          end;
414                    except
415                            // このアイテムで問題が起きても他のアイテムに影響を与えたくないので
416                  end;                  end;
417          end;          end;
418  end;  end;
# Line 218  var Line 429  var
429          XMLNode: IXMLNode;          XMLNode: IXMLNode;
430  //      FavoNode: IXMLNode;  //      FavoNode: IXMLNode;
431  begin  begin
432          XMLDoc :=  NewXMLDocument;          XMLDoc :=       NewXMLDocument;
433          XMLDoc.Encoding := 'Shift_JIS';          XMLDoc.Encoding := 'Shift_JIS';
434          XMLDoc.StandAlone := 'yes';          XMLDoc.StandAlone := 'yes';
435          XMLNode := XMLDoc.AddChild('favorite');          XMLNode := XMLDoc.AddChild('favorite');
# Line 288  var Line 499  var
499  begin  begin
500          for i := 0 to Node.Count - 1 do begin          for i := 0 to Node.Count - 1 do begin
501                  if TObject(Node.Item[i].Data) is TFavoriteFolder then begin                  if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
502                          s := Format('<folder title="%s">', [HtmlEncode(Node.Item[i].Text)]);                          if Node.Item[ i ].Expanded then
503                                    s := Format('<folder title="%s" expanded="true">', [HtmlEncode(Node.Item[i].Text)])
504                            else
505                                    s := Format('<folder title="%s" expanded="false">', [HtmlEncode(Node.Item[i].Text)]);
506                          SaveList.Add(s);                          SaveList.Add(s);
507                          AddSaveString(Node.Item[i], SaveList);                          AddSaveString(Node.Item[i], SaveList);
508                          SaveList.Add('</folder>');                          SaveList.Add('</folder>');
509                  end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin                  end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
510                          FavBoard := TFavoriteBoardItem(Node.Item[i].Data);                          FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
511                          s := Format('<favitem type="2ch" favtype="board" bbs="%s" title="%s" boardname="%s"/>',                          s := Format('<favitem type="2ch" favtype="board" url="%s" title="%s"/>',
512                                                                          [FavBoard.BBSID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavBoard.BoardName)]);                                                                          [HtmlEncode( FavBoard.URL ), HtmlEncode(Node.Item[ i ].Text)]);
513                          SaveList.Add(s);                          SaveList.Add(s);
514                  end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin                  end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
515                          FavThread := TFavoriteThreadItem(Node.Item[i].Data);                          FavThread := TFavoriteThreadItem(Node.Item[i].Data);
516                          s := Format('<favitem type="2ch" favtype="thread" bbs="%s" thread="%s" title="%s" threadname="%s"/>',                          s := Format('<favitem type="2ch" favtype="thread" url="%s" title="%s"/>',
517                                                                          [FavThread.BBSID, FavThread.ThreadID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavThread.ThreadName)]);                                                                          [HtmlEncode( FavThread.URL ), HtmlEncode(Node.Item[ i ].Text)]);
518                          SaveList.Add(s);                          SaveList.Add(s);
519                  end;                  end;
520          end;          end;
# Line 374  begin Line 588  begin
588  //  //
589  end;  end;
590  }  }
591    function TFavoriteDM.SaveFavoriteFile(FileName: String) : Boolean;
592    var
593            FavoriteFilePath: string;
594                    tempStringList: TStringList;
595    begin
596    
597            FavoriteFilePath := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
598    
599            if FileExists( FavoriteFilePath ) then begin
600                    tempStringList := TStringList.Create;
601                    try
602                            tempStringList.LoadFromFile( FavoriteFilePath );
603                            tempStringList.SaveToFile( FileName );
604                    finally
605                            tempStringList.Free;
606                    end;
607                    Result := true;
608            end else begin
609                    Result := false;
610            end;
611    end;
612    
613    procedure TFavoriteDM.URLReplace(oldURLs: TStringList; newURLs: TStringList);
614    var
615            i, j                    : Integer;
616                    tmpURL: string;
617        oldHost: string;
618        oldBoardName: string;
619        newHost: string;
620        newBoardName: string;
621                    tempString: string;
622            favBoard        : TFavoriteBoardItem;
623            favThread       : TFavoriteThreadItem;
624            favorites       : TTreeNodes;
625    begin
626    
627            // 面倒だけどthreadはそれぞれURLをチェックしながらやってかなきゃいけない。
628            favorites := FavoriteDM.FTreeView.Items;
629            for i := 0 to oldURLs.Count - 1 do begin
630                    try
631                            tmpURL                  := Copy(oldURLs[i], 1, Length(oldURLs[i]) -1);
632                            oldHost                 := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
633                            oldBoardName    := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
634                            tmpURL                  := Copy(newURLs[i], 1, Length(newURLs[i]) -1);
635                            newHost                 := Copy(tmpURL, 1, LastDelimiter('/', tmpURL) );
636                            newBoardName    := Copy(tmpURL, LastDelimiter('/', tmpURL), Length(tmpURL) ) + '/';
637    
638                            for j := favorites.Count - 1 downto 0 do begin
639                                    try
640                                            if TObject( favorites.Item[ j ].Data ) is TFavoriteBoardItem then begin
641                                                    favBoard := TFavoriteBoardItem( favorites.Item[ j ].Data );
642                                                    if favBoard = nil then continue;
643                                                    tempString := favBoard.URL;
644                                                    if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
645                                                            tempString              := StringReplace(tempString, oldHost, newHost,[]);
646                                                            favBoard.URL    := tempString;
647                                                    end;
648                                            end else if TObject( favorites.Item[ j ].Data ) is TFavoriteThreadItem then begin
649                                                    favThread := TFavoriteThreadItem( favorites.Item[ j ].Data );
650                                                    if favThread = nil then continue;
651                                                    tempString := favThread.URL;
652                                                    if ( AnsiPos(oldBoardName, tempString) <> 0 ) and ( AnsiPos(oldHost, tempString ) <> 0 ) then begin
653                                                            tempString              := StringReplace(tempString, oldHost, newHost,[]);
654                                                            favThread.URL   := tempString;
655                                                    end;
656                                            end;
657                                    except
658                                    end;
659                            end;
660                    except
661                    end;
662            end;
663    
664    end;
665    
666    function TFavoriteDM.GetFavoriteFilePath() : String;
667    begin
668            Result := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
669    end;
670    
671  end.  end.

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.3.2.1

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