Favorite.pas

   1 unit Favorite;
   2
   3 interface
   4
   5 uses
   6         Messages, SysUtils, Classes, Contnrs, ComCtrls, {HttpApp,} YofUtils,
   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         XMLDoc: IXMLDocument;
  95         XMLNode: IXMLNode;
  96         Node: TTreeNode;
  97         i: Integer;
  98         FavFolder: TFavoriteFolder;
  99         LinkExists: Boolean;
 100 begin
 101
 102         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 103
 104         FavFolder := TFavoriteFolder.Create;
 105         Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
 106         Node.ImageIndex := 14;
 107         Node.SelectedIndex := 14;
 108
 109         if FileExists(FileName) then begin
 110                 try
 111                         XMLDoc := LoadXMLDocument(FileName);
 112                         XMLNode := XMLDoc.DocumentElement;
 113
 114                         FStack := TStack.Create;
 115                         try
 116                                 FStack.Push(Node);
 117                                 LinkExists := False;
 118                                 if XMLNode.NodeName = 'favorite' then begin
 119                                         for i := 0 to XMLNode.ChildNodes.Count - 1 do begin
 120                                                 ReadNode(XMLNode.ChildNodes[i]);
 121                                                 if (XMLNode.ChildNodes[i].NodeName = 'folder') and
 122                                                          (XMLNode.ChildNodes[i].Attributes['title'] = FAVORITE_LINK_NAME) then begin
 123                                                         LinkExists := True;
 124                                                 end;
 125                                         end;
 126                                 end;
 127                                 if not LinkExists then begin
 128                                         FavFolder := TFavoriteFolder.Create;
 129                                         Node := FTreeView.Items.AddChildObject(Node, FAVORITE_LINK_NAME, FavFolder);
 130                                         Node.ImageIndex := 14;
 131                                         Node.SelectedIndex := 14;
 132                                 end;
 133                         finally
 134                                 FStack.Free;
 135                         end;
 136                 except
 137                 end;
 138         end;
 139
 140 {
 141         FavFolder := TFavoriteFolder.Create;
 142         Node := FTreeView.Items.AddChildObject(nil, FAVORITE_ROOT_NAME, FavFolder);
 143         Node.ImageIndex := 12;
 144         Node.SelectedIndex := 13;
 145
 146         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 147         if not FileExists(FileName) then
 148                 Exit;
 149
 150                 FavSAXHandler.OnStartDocument := SAXStartDocument;
 151                 FavSAXHandler.OnEndDocument := SAXEndDocument;
 152                 FavSAXHandler.OnStartElement := SAXStartElement;
 153                 FavSAXHandler.OnStartElement := SAXStartElement;
 154                 FavSAXHandler.OnEndElement := SAXEndElement;
 155                 FavSAXHandler.OnCharacters := SAXCharacters;
 156
 157                 FavSAXReader.Vendor := 'Keith Wood';
 158                 FavSAXReader.URL := FileName;
 159                 FavSAXReader.Parse;}
 160 end;
 161
 162 procedure TFavoriteDM.ReadNode(Node: IXMLNode);
 163 var
 164         i: Integer;
 165
 166         ParentNode: TTreeNode;
 167         CurrentNode: TTreeNode;
 168         FavFolder: TFavoriteFolder;
 169         FavBoard: TFavoriteBoardItem;
 170         FavThread: TFavoriteThreadItem;
 171 begin
 172         if Node.NodeName = 'folder' then begin
 173                 ParentNode := FStack.Peek;
 174                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 175                         FavFolder := TFavoriteFolder.Create;
 176                         CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavFolder);
 177                         CurrentNode.ImageIndex := 14;
 178                         CurrentNode.SelectedIndex := 14;
 179                         FStack.Push(CurrentNode);
 180                 end;
 181                 for i := 0 to Node.ChildNodes.Count - 1 do begin
 182                         ReadNode(Node.ChildNodes[i]);
 183                 end;
 184                 if FStack.Count <> 0 then
 185                         FStack.Pop;
 186         end else if Node.NodeName = 'favitem' then begin
 187                 ParentNode := FStack.Peek;
 188                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 189                         if Node.Attributes['favtype'] = 'board' then begin
 190                                 FavBoard := TFavoriteBoardItem.Create;
 191                                 FavBoard.BBSID := Node.Attributes['bbs'];
 192                                 FavBoard.BoardName := Node.Attributes['boardname'];
 193                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavBoard);
 194                                 CurrentNode.ImageIndex := 15;
 195                                 CurrentNode.SelectedIndex := 15;
 196                         end else if Node.Attributes['favtype'] = 'thread' then begin
 197                                 FavThread := TFavoriteThreadItem.Create;
 198                                 FavThread.BBSID := Node.Attributes['bbs'];
 199                                 FavThread.ThreadID := Node.Attributes['thread'];
 200                                 FavThread.ThreadName := Node.Attributes['threadname'];
 201                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Node.Attributes['title'], FavThread);
 202                                 CurrentNode.ImageIndex := 16;
 203                                 CurrentNode.SelectedIndex := 16;
 204                         end;
 205                 end;
 206         end;
 207 end;
 208
 209 procedure TFavoriteDM.WriteFavorite;
 210 {
 211 var
 212         FileName: string;
 213 //      SaveList: TStringList;
 214 //      i: Integer;
 215 //      Count: Integer;
 216
 217         XMLDoc: IXMLDocument;
 218         XMLNode: IXMLNode;
 219 //      FavoNode: IXMLNode;
 220 begin
 221         XMLDoc :=  NewXMLDocument;
 222         XMLDoc.Encoding := 'Shift_JIS';
 223         XMLDoc.StandAlone := 'yes';
 224         XMLNode := XMLDoc.AddChild('favorite');
 225         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 226         AddSaveString(TreeView.Items.GetFirstNode, XMLNode);
 227         XMLDoc.SaveToFile(FileName);
 228 }
 229 var
 230         FileName: string;
 231         SaveList: TStringList;
 232 begin
 233         FileName := GikoSys.GetConfigDir + FAVORITE_FILE_NAME;
 234         SaveList := TStringList.Create;
 235         try
 236                 SaveList.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
 237                 SaveList.Add('<favorite>');
 238                 AddSaveString(TreeView.Items.GetFirstNode, SaveList);
 239                 SaveList.Add('</favorite>');
 240                 SaveList.SaveToFile(FileName);
 241         finally
 242                 SaveList.Free;
 243         end;
 244 end;
 245
 246 {
 247 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; XMLNode: IXMLNode);
 248 var
 249         i: Integer;
 250 //      s: string;
 251         FavBoard: TFavoriteBoardItem;
 252         FavThread: TFavoriteThreadItem;
 253         FavNode: IXMLNode;
 254 begin
 255         for i := 0 to Node.Count - 1 do begin
 256                 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
 257                         FavNode := XMLNode.AddChild('folder');
 258                         FavNode.Attributes['title'] := Node.Item[i].Text;
 259                         AddSaveString(Node.Item[i], FavNode);
 260                 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
 261                         FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
 262                         FavNode := XMLNode.AddChild('favitem');
 263                         FavNode.Attributes['type'] := '2ch';
 264                         FavNode.Attributes['favtype'] := 'board';
 265                         FavNode.Attributes['bbs'] := FavBoard.BBSID;
 266                         FavNode.Attributes['title'] := Node.Item[i].Text;
 267                         FavNode.Attributes['boardname'] := FavBoard.BoardName;
 268                 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
 269                         FavThread := TFavoriteThreadItem(Node.Item[i].Data);
 270                         FavNode := XMLNode.AddChild('favitem');
 271                         FavNode.Attributes['type'] := '2ch';
 272                         FavNode.Attributes['favtype'] := 'thread';
 273                         FavNode.Attributes['bbs'] := FavThread.BBSID;
 274                         FavNode.Attributes['thread'] := FavThread.ThreadID;
 275                         FavNode.Attributes['title'] := Node.Item[i].Text;
 276                         FavNode.Attributes['threadname'] := FavThread.ThreadName;
 277                 end;
 278         end;
 279 end;
 280 }
 281
 282 procedure TFavoriteDM.AddSaveString(Node: TTreeNode; SaveList: TStringList);
 283 var
 284         i: Integer;
 285         s: string;
 286         FavBoard: TFavoriteBoardItem;
 287         FavThread: TFavoriteThreadItem;
 288 begin
 289         for i := 0 to Node.Count - 1 do begin
 290                 if TObject(Node.Item[i].Data) is TFavoriteFolder then begin
 291                         s := Format('<folder title="%s">', [HtmlEncode(Node.Item[i].Text)]);
 292                         SaveList.Add(s);
 293                         AddSaveString(Node.Item[i], SaveList);
 294                         SaveList.Add('</folder>');
 295                 end else if TObject(Node.Item[i].Data) is TFavoriteBoardItem then begin
 296                         FavBoard := TFavoriteBoardItem(Node.Item[i].Data);
 297                         s := Format('<favitem type="2ch" favtype="board" bbs="%s" title="%s" boardname="%s"/>',
 298                                                                         [FavBoard.BBSID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavBoard.BoardName)]);
 299                         SaveList.Add(s);
 300                 end else if TObject(Node.Item[i].Data) is TFavoriteThreadItem then begin
 301                         FavThread := TFavoriteThreadItem(Node.Item[i].Data);
 302                         s := Format('<favitem type="2ch" favtype="thread" bbs="%s" thread="%s" title="%s" threadname="%s"/>',
 303                                                                         [FavThread.BBSID, FavThread.ThreadID, HtmlEncode(Node.Item[i].Text), HtmlEncode(FavThread.ThreadName)]);
 304                         SaveList.Add(s);
 305                 end;
 306         end;
 307 end;
 308
 309 {
 310 procedure TFavoriteDM.SAXStartDocument(Sender: TObject);
 311 begin
 312         FStack := TStack.Create;
 313         FStack.Push(FTreeView.Items.GetFirstNode);
 314 end;
 315
 316 procedure TFavoriteDM.SAXEndDocument(Sender: TObject);
 317 begin
 318         FStack.Free;
 319 end;
 320
 321 procedure TFavoriteDM.SAXStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString;
 322         const Atts: IAttributes);
 323 var
 324         FavType: string;
 325         ParentNode: TTreeNode;
 326         CurrentNode: TTreeNode;
 327         FavFolder: TFavoriteFolder;
 328         FavBoard: TFavoriteBoardItem;
 329         FavThread: TFavoriteThreadItem;
 330 begin
 331         if QName = 'folder' then begin
 332                 ParentNode := FStack.Peek;
 333                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 334                         FavFolder := TFavoriteFolder.Create;
 335                         CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavFolder);
 336                         CurrentNode.ImageIndex := 12;
 337                         CurrentNode.SelectedIndex := 13;
 338                         FStack.Push(CurrentNode);
 339                 end;
 340         end else if QName = 'favitem' then begin
 341                 ParentNode := FStack.Peek;
 342                 if TObject(ParentNode.Data) is TFavoriteFolder then begin
 343                         FavType := Atts.getValue('favtype');
 344                         if FavType = 'board' then begin
 345                                 FavBoard := TFavoriteBoardItem.Create;
 346                                 FavBoard.BBSID := Atts.getValue('bbs');
 347                                 FavBoard.BoardName := Atts.getValue('boardname');
 348                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavBoard);
 349                                 CurrentNode.ImageIndex := 14;
 350                                 CurrentNode.SelectedIndex := 15;
 351                         end else if FavType = 'thread' then begin
 352                                 FavThread := TFavoriteThreadItem.Create;
 353                                 FavThread.BBSID := Atts.getValue('bbs');
 354                                 FavThread.ThreadID := Atts.getValue('thread');
 355                                 FavThread.ThreadName := Atts.getValue('threadname');
 356                                 CurrentNode := FTreeView.Items.AddChildObject(ParentNode, Atts.getValue('title'), FavThread);
 357                                 CurrentNode.ImageIndex := 16;
 358                                 CurrentNode.SelectedIndex := 17;
 359                         end;
 360                 end;
 361         end;
 362 end;
 363
 364 procedure TFavoriteDM.SAXEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
 365 begin
 366         if QName = 'folder' then begin
 367                 if FStack.Count <> 0 then
 368                         FStack.Pop;
 369         end;
 370 end;
 371
 372 procedure TFavoriteDM.SAXCharacters(Sender: TObject; const PCh: SAXString);
 373 begin
 374 //
 375 end;
 376 }
 377 end.