Favorite.pas

   1 unit Favorite;
   2
   3 interface
   4
   5 uses
   6         Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,}
   7         GikoSystem, XMLIntf, XMLDoc;
   8         {SAX, SAXHelpers, SAXComps, SAXKW;}
   9
  10 type
  11         TFavoriteFolder = class
  12         end;
  13
  14         TFavoriteBoardItem = class
  15         private
  16                 FBBSID: string;
  17                 FBoardName: string;
  18         public
  19                 property BBSID: string read FBBSID write FBBSID;
  20                 property BoardName: string read FBoardName write FBoardName;
  21         end;
  22
  23         TFavoriteThreadItem = class
  24         private
  25                 FBBSID: string;
  26                 FThreadID: string;
  27                 FThreadName: string;
  28         public
  29                 property BBSID: string read FBBSID write FBBSID;
  30                 property ThreadID: string read FThreadID write FThreadID;
  31                 property ThreadName: string read FThreadName write FThreadName;
  32         end;
  33
  34         TFavoriteDM = class(TDataModule)
  35                 procedure DataModuleCreate(Sender: TObject);
  36                 procedure DataModuleDestroy(Sender: TObject);
  37         private
  38                 { Private \90é\8c¾ }
  39                 FStack: TStack;
  40                 FTreeView: TTreeView;
  41
  42                 procedure ReadNode(Node: IXMLNode);
  43 //              procedure AddSaveString(Node: TTreeNode; SaveList: TStringList);
  44                 procedure AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
  45 //              procedure SAXStartDocument(Sender: TObject);
  46 //              procedure SAXEndDocument(Sender: TObject);
  47 //              procedure SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; const Atts: IAttributes);
  48 //              procedure SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
  49 //              procedure SAXCharacters(Sender: TObject; const PCh: SAXString);
  50         public
  51                 { Public \90é\8c¾ }
  52                 procedure SetFavTreeView(TreeView: TTreeView);
  53                 procedure ReadFavorite;
  54                 procedure WriteFavorite;
  55                 property TreeView: TTreeView read FTreeView;
  56         end;
  57
  58 var
  59         FavoriteDM: TFavoriteDM;
  60 const
  61         FAVORITE_LINK_NAME = '\83\8a\83\93\83N';
  62
  63 implementation
  64
  65 const
  66         FAVORITE_ROOT_NAME = '\82¨\8bC\82É\93ü\82è';
  67         FAVORITE_FILE_NAME = 'Favorite.xml';
  68
  69 {$R *.dfm}
  70
  71 procedure TFavoriteDM.DataModuleCreate(Sender: TObject);
  72 begin
  73         //FTreeView := TreeView;
  74         //FTreeView := GikoForm.FavoriteTreeView;
  75 end;
  76
  77 procedure TFavoriteDM.DataModuleDestroy(Sender: TObject);
  78 var
  79         i: Integer;
  80 begin
  81         for i := 0 to TreeView.Items.Count - 1 do begin
  82                 TObject(TreeView.Items[i].Data).Free;
  83         end;
  84 end;
  85
  86 procedure TFavoriteDM.SetFavTreeView(TreeView: TTreeView);
  87 begin
  88         FTreeView := TreeView;
  89 end;
  90
  91 procedure TFavoriteDM.ReadFavorite;
  92 {var
  93         FileName: string;
  94         Node: TTreeNode;
  95         FavFolder: TFavoriteFolder;}
  96 var
  97         FileName: string;
  98         XMLDoc: IXMLDocument;
  99         XMLNode: IXMLNode;
 100         Node: TTreeNode;
 101         i: Integer;
 102         FavFolder: TFavoriteFolder;
 103         LinkExists: Boolean;
 104 begin
 105         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 106
 107         FavFolder := TFavoriteFolder.Create;
 108         Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
 109         Node.ImageIndex := 12;
 110         Node.SelectedIndex := 13;
 111
 112         if FileExists(FileName) then begin
 113                 XMLDoc := LoadXMLDocument(FileName);
 114                 XMLNode := XMLDoc.DocumentElement;
 115
 116                 FStack := TStack.Create;
 117                 try
 118                         FStack.Push(Node);
 119                         LinkExists := False;
 120                         if XMLNode.NodeName = 'favorite' then begin
 121                                 for i := 0 to XMLNode.ChildNodes.Count - 1 do begin
 122                                         ReadNode(XMLNode.ChildNodes[i]);
 123                                         if (XMLNode.ChildNodes[i].NodeName = 'folder') and
 124                                                  (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
 125                                                 LinkExists := True;
 126                                         end;
 127                                 end;
 128                         end;
 129                         if not LinkExists then begin
 130                                 FavFolder := TFavoriteFolder.Create;
 131                                 Node := FTreeView.Items.AddChildObject(Node, FAVORITE_LINK_NAME, FavFolder);
 132                                 Node.ImageIndex := 12;
 133                                 Node.SelectedIndex := 13;
 134                         end;
 135                 finally
 136                         FStack.Free;
 137                 end;
 138         end;
 139
 140 {       FavFolder := TFavoriteFolder.Create;
 141         Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
 142         Node.ImageIndex := 12;
 143         Node.SelectedIndex := 13;
 144
 145         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 146         if not FileExists(FileName) then
 147                 Exit;
 148
 149                 FavSAXHandler.OnStartDocument := SAXStartDocument;
 150                 FavSAXHandler.OnEndDocument := SAXEndDocument;
 151                 FavSAXHandler.OnStartElement := SAXStartElement;
 152                 FavSAXHandler.OnStartElement := SAXStartElement;
 153                 FavSAXHandler.OnEndElement := SAXEndElement;
 154                 FavSAXHandler.OnCharacters := SAXCharacters;
 155
 156                 FavSAXReader.Vendor := 'Keith Wood';
 157                 FavSAXReader.URL := FileName;
 158                 FavSAXReader.Parse;}
 159 end;
 160
 161 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
 162 var
 163         i: Integer;
 164
 165         ParentNode: TTreeNode;
 166         CurrentNode: TTreeNode;
 167         FavFolder: TFavoriteFolder;
 168         FavBoard: TFavoriteBoardItem;
 169         FavThread: TFavoriteThreadItem;
 170 begin
 171         if Node.NodeName = 'folder' then begin
 172                 ParentNode := FStack.Peek;
 173                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 174                         FavFolder := TFavoriteFolder.Create;
 175                         CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
 176                         CurrentNode.ImageIndex := 12;
 177                         CurrentNode.SelectedIndex := 13;
 178                         FStack.Push(CurrentNode);
 179                 end;
 180                 for i := 0 to Node.ChildNodes.Count - 1 do begin
 181                         ReadNode(Node.ChildNodes[i]);
 182                 end;
 183                 if FStack.Count <> 0 then
 184                         FStack.Pop;
 185         end else if Node.NodeName = 'favitem' then begin
 186                 ParentNode := FStack.Peek;
 187                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 188                         if Node.Attributes['favtype'] = 'board' then begin
 189                                 FavBoard := TFavoriteBoardItem.Create;
 190                                 FavBoard.BBSID := Node.Attributes['bbs'];
 191                                 FavBoard.BoardName := Node.Attributes['boardname'];
 192                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
 193                                 CurrentNode.ImageIndex := 14;
 194                                 CurrentNode.SelectedIndex := 15;
 195                         end else if Node.Attributes['favtype'] = 'thread' then begin
 196                                 FavThread := TFavoriteThreadItem.Create;
 197                                 FavThread.BBSID := Node.Attributes['bbs'];
 198                                 FavThread.ThreadID := Node.Attributes['thread'];
 199                                 FavThread.ThreadName := Node.Attributes['threadname'];
 200                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
 201                                 CurrentNode.ImageIndex := 16;
 202                                 CurrentNode.SelectedIndex := 17;
 203                         end;
 204                 end;
 205         end;
 206 end;
 207
 208 procedure TFavoriteDM.WriteFavorite;
 209 var
 210         FileName: string;
 211 //      SaveList: TStringList;
 212 //      i: Integer;
 213 //      Count: Integer;
 214
 215         XMLDoc: IXMLDocument;
 216         XMLNode: IXMLNode;
 217 //      FavoNode: IXMLNode;
 218 begin
 219         XMLDoc :=  NewXMLDocument;
 220         XMLDoc.Encoding := 'Shift_JIS';
 221         XMLDoc.StandAlone := 'yes';
 222         XMLNode := XMLDoc.AddChild('favorite');
 223         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 224         AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
 225         XMLDoc.SaveToFile(FileName);
 226 {var
 227         FileName: string;
 228         SaveList: TStringList;
 229 begin
 230         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 231         SaveList := TStringList.Create;
 232         try
 233                 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
 234                 SaveList.Add('<favorite>');
 235                 AddSaveString(TreeView.Items.GetFirstNode, SaveList);
 236                 SaveList.Add('</favorite>');
 237                 SaveList.SaveToFile(FileName);
 238         finally
 239                 SaveList.Free;
 240         end;}
 241 end;
 242
 243 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
 244 var
 245         i: Integer;
 246 //      s: string;
 247         FavBoard: TFavoriteBoardItem;
 248         FavThread: TFavoriteThreadItem;
 249         FavNode: IXMLNode;
 250 begin
 251         for i := 0 to Node.Count - 1 do begin
 252                 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
 253                         FavNode := XMLNode.AddChild('folder');
 254                         FavNode.Attributes['title'] := Node.Item[i].Text;
 255                         AddSaveString(Node.Item[i], FavNode);
 256                 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
 257                         FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
 258                         FavNode := XMLNode.AddChild('favitem');
 259                         FavNode.Attributes['type'] := '2ch';
 260                         FavNode.Attributes['favtype'] := 'board';
 261                         FavNode.Attributes['bbs'] := FavBoard.BBSID;
 262                         FavNode.Attributes['title'] := Node.Item[i].Text;
 263                         FavNode.Attributes['boardname'] := FavBoard.BoardName;
 264                 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
 265                         FavThread := TFavoriteThreadItem(Node.Item[i].Data);
 266                         FavNode := XMLNode.AddChild('favitem');
 267                         FavNode.Attributes['type'] := '2ch';
 268                         FavNode.Attributes['favtype'] := 'thread';
 269                         FavNode.Attributes['bbs'] := FavThread.BBSID;
 270                         FavNode.Attributes['thread'] := FavThread.ThreadID;
 271                         FavNode.Attributes['title'] := Node.Item[i].Text;
 272                         FavNode.Attributes['threadname'] := FavThread.ThreadName;
 273                 end;
 274         end;
 275 end;
 276
 277 {procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
 278 var
 279         i: Integer;
 280         s: string;
 281         FavBoard: TFavoriteBoardItem;
 282         FavThread: TFavoriteThreadItem;
 283 begin
 284         for i := 0 to Node.Count - 1 do begin
 285                 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
 286                         s := Format('<folder title="%s">', [HtmlEncode(Node.Item[i].Text)]);
 287                         SaveList.Add(s);
 288                         AddSaveString(Node.Item[i], SaveList);
 289                         SaveList.Add('</folder>');
 290                 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
 291                         FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
 292                         s := Format('<favitem type="2ch" favtype="board" bbs="%s" title="%s" boardname="%s"/>',
 293                                                                         [FavBoard.BBSID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavBoard.BoardName)]);
 294                         SaveList.Add(s);
 295                 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
 296                         FavThread := TFavoriteThreadItem(Node.Item[i].Data);
 297                         s := Format('<favitem type="2ch" favtype="thread" bbs="%s" thread="%s" title="%s" threadname="%s"/>',
 298                                                                         [FavThread.BBSID, FavThread.ThreadID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavThread.ThreadName)]);
 299                         SaveList.Add(s);
 300                 end;
 301         end;
 302 end;}
 303
 304 {
 305 procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
 306 begin
 307         FStack := TStack.Create;
 308         FStack.Push(FTreeView.Items.GetFirstNode);
 309 end;
 310
 311 procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
 312 begin
 313         FStack.Free;
 314 end;
 315
 316 procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
 317         const Atts: IAttributes);
 318 var
 319         FavType: string;
 320         ParentNode: TTreeNode;
 321         CurrentNode: TTreeNode;
 322         FavFolder: TFavoriteFolder;
 323         FavBoard: TFavoriteBoardItem;
 324         FavThread: TFavoriteThreadItem;
 325 begin
 326         if QName = 'folder' then begin
 327                 ParentNode := FStack.Peek;
 328                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 329                         FavFolder := TFavoriteFolder.Create;
 330                         CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
 331                         CurrentNode.ImageIndex := 12;
 332                         CurrentNode.SelectedIndex := 13;
 333                         FStack.Push(CurrentNode);
 334                 end;
 335         end else if QName = 'favitem' then begin
 336                 ParentNode := FStack.Peek;
 337                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 338                         FavType := Atts.getValue('favtype');
 339                         if FavType = 'board' then begin
 340                                 FavBoard := TFavoriteBoardItem.Create;
 341                                 FavBoard.BBSID := Atts.getValue('bbs');
 342                                 FavBoard.BoardName := Atts.getValue('boardname');
 343                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
 344                                 CurrentNode.ImageIndex := 14;
 345                                 CurrentNode.SelectedIndex := 15;
 346                         end else if FavType = 'thread' then begin
 347                                 FavThread := TFavoriteThreadItem.Create;
 348                                 FavThread.BBSID := Atts.getValue('bbs');
 349                                 FavThread.ThreadID := Atts.getValue('thread');
 350                                 FavThread.ThreadName := Atts.getValue('threadname');
 351                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
 352                                 CurrentNode.ImageIndex := 16;
 353                                 CurrentNode.SelectedIndex := 17;
 354                         end;
 355                 end;
 356         end;
 357 end;
 358
 359 procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
 360 begin
 361         if QName = 'folder' then begin
 362                 if FStack.Count <> 0 then
 363                         FStack.Pop;
 364         end;
 365 end;
 366
 367 procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
 368 begin
 369 //
 370 end;
 371 }
 372 end.