RoundData.pas

   1 unit RoundData;
   2
   3 interface
   4
   5 uses
   6         Windows, Messages, SysUtils, Classes,
   7         GikoSystem, BoardGroup;
   8
   9 type
  10         TGikoRoundType = (grtBoard, grtItem);
  11         TRoundItem = class;
  12
  13         TRoundList = class(TObject)
  14         private
  15         FOldFileRead: Boolean;
  16                 FBoardList: TList;
  17                 FItemList: TList;
  18                 function GetCount(RoundType: TGikoRoundType): Integer;
  19                 function GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
  20                 function ParseRoundBoardLine(Line: string): TRoundItem;
  21         function ParseRoundThreadLine(Line: string): TRoundItem;
  22         function ParseOldRoundBoardLine(Line: string): TRoundItem;
  23         function ParseOldRoundThreadLine(Line: string): TRoundItem;
  24         public
  25                 RoundNameList: TStringList;
  26
  27                 constructor Create;
  28                 destructor Destroy; override;
  29                 function Add(Board: TBoard): Integer; overload;
  30                 function Add(ThreadItem: TThreadItem): Integer; overload;
  31                 procedure Delete(Board: TBoard); overload;
  32                 procedure Delete(ThreadItem: TThreadItem); overload;
  33         procedure Delete(URL: string; RoundType: TGikoRoundType); overload;
  34                 procedure Clear;
  35                 function Find(Board: TBoard): Integer; overload;
  36                 function Find(ThreadItem: TThreadItem): Integer; overload;
  37         function Find(URL: string; RoundType: TGikoRoundType): Integer; overload;
  38                 property Count[RoundType: TGikoRoundType]: Integer read GetCount;
  39         property OldFileRead: Boolean read FOldFileRead;
  40                 property Items[Index: integer; RoundType: TGikoRoundType]: TRoundItem read GetRoundItem;
  41                 procedure SetRoundName(Board: TBoard; RoundName: string); overload;
  42                 procedure SetRoundName(ThreadItem: TThreadItem; RoundName: string); overload;
  43
  44                 procedure LoadRoundBoardFile;
  45         procedure LoadRoundThreadFile;
  46                 procedure SaveRoundFile;
  47         end;
  48
  49         TRoundItem = class(TObject)
  50         private
  51 //              FBBSType: TGikoBBSType;
  52                 FRoundName: string;
  53                 FRoundType: TGikoRoundType;
  54     //Item                      : TObject;
  55     FURL                        : string;
  56                 FBoardTitle: string;
  57                 FThreadTitle: string;
  58                 FFileName: string;
  59                 FBoolData: Boolean;             //\82¢\82ë\82¢\82ë\8eg\82¤\82å\82£
  60         public
  61
  62         constructor Create;
  63     //property BBSType: TGikoBBSType read FBBSType write FBBSType;
  64                 property RoundName: string read FRoundName write FRoundName;
  65                 property RoundType: TGikoRoundType read FRoundType write FRoundType;
  66     //property Item : TObject read FItem write FItem;
  67     property URL : string read FURL write FURL;
  68                 property BoardTitle: string read FBoardTitle write FBoardTitle;
  69                 property ThreadTitle: string read FThreadTitle write FThreadTitle;
  70                 property FileName: string read FFileName write FFileName;
  71                 property BoolData: Boolean read FBoolData write FBoolData;
  72         end;
  73
  74 var
  75         RoundList: TRoundList;
  76
  77 implementation
  78 const
  79         ROUND_BOARD_FILENAME: string = 'RoundBoard.2ch';        //\82 \82Æ\82ÅBoardGroup\82Ö\88Ú\93®
  80         ROUND_ITEM_FILENAME: string  = 'RoundItem.2ch';         //\93¯\8fã
  81         ROUND_INDEX_VERSION: string = '2.00';
  82     ERROR_BOARD_FILENAME: string = 'ErrorBoard.2ch'; //Error\8ds\82ð\95Û\8aÇ\82·\82é
  83     ERROR_ITEM_FILENAME: string = 'ErrorItem.2ch'; //Error\8ds\82ð\95Û\8aÇ\82·\82é
  84 constructor TRoundItem.Create;
  85 begin
  86         inherited Create;
  87 end;
  88 constructor TRoundList.Create;
  89 begin
  90         inherited;
  91         FBoardList := TList.Create;
  92         FItemList := TList.Create;
  93         RoundNameList := TStringList.Create;
  94         RoundNameList.Sorted := True;
  95         RoundNameList.Duplicates := dupIgnore;
  96     FOldFileRead := false;
  97 end;
  98
  99 destructor TRoundList.Destroy;
 100 begin
 101         RoundNameList.Free;
 102         Clear;
 103         FBoardList.Free;
 104         FItemList.Free;
 105         //inherited;
 106 end;
 107
 108 function TRoundList.Add(Board: TBoard): Integer;
 109 var
 110         idx: Integer;
 111         Item: TRoundItem;
 112 begin
 113     Result := -1;
 114         idx := Find(Board);
 115         if idx = -1 then begin
 116                 Item := TRoundItem.Create;
 117 //              Item.BBSType := gbt2ch; //\82Æ\82è\82 \82¦\82¸
 118                 Item.RoundType := grtBoard;
 119 //      Item.Item := Board;
 120         Item.URL := Board.URL;
 121                 Item.BoardTitle := Board.Title;
 122                 Item.ThreadTitle := '';
 123                 Item.FileName := '';
 124                 Item.RoundName := Board.RoundName;
 125                 Result := FBoardList.Add(Item);
 126         end;
 127 end;
 128
 129 function TRoundList.Add(ThreadItem: TThreadItem): Integer;
 130 var
 131         idx: Integer;
 132         Item: TRoundItem;
 133 begin
 134     Result := -1;
 135         idx := Find(ThreadItem);
 136         if idx = -1 then begin
 137                 Item := TRoundItem.Create;
 138 //              Item.BBSType := gbt2ch; //\82Æ\82è\82 \82¦\82¸
 139                 Item.RoundType := grtItem;
 140 //              Item.Item := ThreadItem;
 141         Item.URL := Threaditem.URL;
 142                 Item.BoardTitle := ThreadItem.ParentBoard.Title;
 143                 Item.ThreadTitle := ThreadItem.Title;
 144                 Item.FileName := ThreadItem.FileName;
 145                 Item.RoundName := ThreadItem.RoundName;
 146                 Result := FItemList.Add(Item);
 147         end;
 148 end;
 149
 150 procedure TRoundList.Delete(Board: TBoard);
 151 var
 152         idx: Integer;
 153 //      Item: TRoundItem;
 154 begin
 155         idx := Find(Board);
 156         if idx <> -1 then begin
 157                 TRoundItem(FBoardList[idx]).Free;
 158                 FBoardList.Delete(idx);
 159         end;
 160 end;
 161
 162 procedure TRoundList.Delete(ThreadItem: TThreadItem);
 163 var
 164         idx: Integer;
 165 //      Item: TRoundItem;
 166 begin
 167         idx := Find(ThreadItem);
 168         if idx <> -1 then begin
 169                 TRoundItem(FItemList[idx]).Free;
 170                 FItemList.Delete(idx);
 171         end;
 172 end;
 173
 174 procedure TRoundList.Clear;
 175 var
 176         i: Integer;
 177 begin
 178         for i := FBoardList.Count - 1 downto 0 do begin
 179         if FBoardList[i] <> nil then
 180                         TRoundItem(FBoardList[i]).Free;
 181                 FBoardList.Delete(i);
 182         end;
 183         for i := FItemList.Count - 1 downto 0 do begin
 184         if FItemList[i] <> nil then
 185                         TRoundItem(FItemList[i]).Free;
 186                 FItemList.Delete(i);
 187         end;
 188 end;
 189
 190 function TRoundList.Find(Board: TBoard): Integer;
 191 var
 192         i: Integer;
 193         Item: TRoundItem;
 194 begin
 195         Result := -1;
 196         for i := 0 to FBoardList.Count - 1 do begin
 197                 Item := TRoundItem(FBoardList[i]);
 198                 if Item.FRoundType <> grtBoard then Continue;
 199                 if Item.FURL = Board.URL then begin
 200                         Result := i;
 201                         Exit;
 202                 end;
 203         end;
 204 end;
 205
 206 function TRoundList.Find(ThreadItem: TThreadItem): Integer;
 207 var
 208         i: Integer;
 209         Item: TRoundItem;
 210 begin
 211         Result := -1;
 212         for i := 0 to FItemList.Count - 1 do begin
 213                 Item := TRoundItem(FItemList[i]);
 214                 if Item.FRoundType <> grtItem then Continue;
 215                 if Item.FURL = ThreadItem.URL then begin
 216                         Result := i;
 217                         Exit;
 218                 end;
 219         end;
 220 end;
 221 function TRoundList.Find(URL: string; RoundType: TGikoRoundType): Integer;
 222 var
 223         i: Integer;
 224         Item: TRoundItem;
 225 begin
 226         Result := -1;
 227     if RoundType = grtItem then begin
 228                 for i := 0 to FItemList.Count - 1 do begin
 229                         Item := TRoundItem(FItemList[i]);
 230                         if Item.FRoundType <> RoundType then Continue;
 231                         if Item.FURL = URL then begin
 232                                 Result := i;
 233                                 Exit;
 234                         end;
 235                 end;
 236     end else begin
 237         for i := 0 to FBoardList.Count - 1 do begin
 238                         Item := TRoundItem(FBoardList[i]);
 239                         if Item.FRoundType <> RoundType then Continue;
 240                         if Item.FURL = URL then begin
 241                                 Result := i;
 242                                 Exit;
 243                         end;
 244                 end;
 245     end;
 246 end;
 247 procedure TRoundList.Delete(URL: string; RoundType: TGikoRoundType);
 248 var
 249         idx: Integer;
 250         Item: TRoundItem;
 251     board: TBoard;
 252     threadItem: TThreadItem;
 253 begin
 254         idx := Find(URL, RoundType);
 255         if idx <> -1 then begin
 256
 257         if RoundType = grtBoard then begin
 258                         Item := TRoundItem(FBoardList[idx]);
 259                         Item.Free;
 260                         FBoardList.Delete(idx);
 261                 board := BBSsFindBoardFromURL(URL);
 262             if board <> nil then begin
 263                 board.Round := False;
 264                 board.RoundName := '';
 265             end;
 266         end else begin
 267                         Item := TRoundItem(FItemList[idx]);
 268                         Item.Free;
 269                         FItemList.Delete(idx);
 270
 271             threadItem := BBSsFindThreadFromURL(URL);
 272             if threadItem <> nil then begin
 273                     threadItem.Round := false;
 274                 threadItem.RoundName := '';
 275             end;
 276         end;
 277         end;
 278 end;
 279
 280 procedure TRoundList.SetRoundName(Board: TBoard; RoundName: string);
 281 var
 282         idx: Integer;
 283         Item: TRoundItem;
 284 begin
 285         idx := Find(Board);
 286         if idx <> -1 then begin
 287                 Item := TRoundItem(FBoardList[idx]);
 288                 Item.RoundName := RoundName;
 289         end;
 290 end;
 291
 292 procedure TRoundList.SetRoundName(ThreadItem: TThreadItem; RoundName: string);
 293 var
 294         idx: Integer;
 295         Item: TRoundItem;
 296 begin
 297         idx := Find(ThreadItem);
 298         if idx <> -1 then begin
 299                 Item := TRoundItem(FItemList[idx]);
 300                 Item.RoundName := RoundName;
 301         end;
 302 end;
 303
 304 function TRoundList.GetCount(RoundType: TGikoRoundType): Integer;
 305 begin
 306         Result := 0;
 307         if RoundType = grtBoard then
 308                 Result := FBoardList.Count
 309         else if RoundType = grtItem then
 310                 Result := FItemList.Count;
 311 end;
 312
 313 function TRoundList.GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
 314 begin
 315         Result := nil;
 316         if RoundType = grtBoard then begin
 317                 if (Index >= 0) and (Index < FBoardList.Count) then
 318                         Result := TRoundItem(FBoardList[Index]);
 319         end else if RoundType = grtItem then begin
 320                 if (Index >= 0) and (Index < FItemList.Count) then
 321                         Result := TRoundItem(FItemList[Index]);
 322         end;
 323 end;
 324 procedure TRoundList.LoadRoundBoardFile;
 325 var
 326         i: Integer;
 327         sl: TStringList;
 328         FileName: string;
 329     errorSl: TStringList;
 330     errorFileName: string;
 331         Item: TRoundItem;
 332     delCount: Integer;
 333 begin
 334         sl := TStringList.Create;
 335     errorSl := TStringList.Create;
 336         errorSl.Duplicates := dupIgnore;
 337         try
 338                 //\83{\81[\83h\8f\84\89ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 339                 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
 340         //\83G\83\89\81[\8ds\95Û\91¶\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 341         errorFileName := GikoSys.GetConfigDir + ERROR_BOARD_FILENAME;
 342                 if FileExists(FileName) then begin
 343                         sl.LoadFromFile(FileName);
 344             if FileExists(errorFileName) then begin
 345                 try
 346                         errorSl.LoadFromFile(errorFileName);
 347                 except
 348                 end;
 349             end;
 350             //Item := TRoundItem.Create;
 351             delCount := 0;
 352             //\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93
 353                         if sl[0] = ROUND_INDEX_VERSION then begin
 354                                 for i := 1 to sl.Count - 1 do begin
 355                                         Item := ParseRoundBoardLine(sl[i - delCount]);
 356                     if Item <> nil then begin
 357                                                 FBoardList.Add(Item);
 358                                                 RoundNameList.Add(Item.RoundName);
 359                     end else begin
 360                         errorSl.Add( sl[i - delCount] );
 361                         sl.Delete(i- delCount);
 362                         Inc(delCount);
 363                     end;
 364                                 end;
 365             end else begin
 366                 if FOldFileRead then begin  //\83M\83R\83i\83r\96{\91Ì\82ª\83{\81[\83h\83t\83@\83C\83\8b\82ð\82æ\82Ý\82Æ\82Á\82½\8cã\82¶\82á\82È\82¢\82Æ\83N\83\89\83b\83V\83\85\82·\82é\82Ì\82Å
 367                                         for i := 1 to sl.Count - 1 do begin
 368                                                 Item := ParseOldRoundBoardLine(sl[i - delCount]);
 369                         if Item <> nil then begin
 370                                                         FBoardList.Add(Item);
 371                                                         RoundNameList.Add(Item.RoundName);
 372                         end else begin
 373                                 errorSl.Add( sl[i- delCount] );
 374                                 sl.Delete(i- delCount);
 375                             Inc(delCount);
 376                         end;
 377                                         end;
 378                 end else
 379                         FOldFileRead := true;
 380             end;
 381                 end;
 382         if errorSl.Count > 0 then
 383                 errorSl.SaveToFile(errorFileName);
 384         finally
 385         errorSl.Free;
 386                 sl.Free;
 387         end;
 388 end;
 389 procedure TRoundList.LoadRoundThreadFile;
 390 var
 391         i: Integer;
 392 //    j: Integer;
 393         sl: TStringList;
 394         FileName: string;
 395     errorSl: TStringList;
 396     errorFileName: string;
 397         Item: TRoundItem;
 398     delCount: Integer;
 399 //    boardList : TStringList;
 400 begin
 401 //    boardList := TStringList.Create;
 402 //    boardList.Duplicates := dupIgnore;
 403     errorSl := TStringList.Create;
 404         errorSl.Duplicates := dupIgnore;
 405         sl := TStringList.Create;
 406         try
 407                 //\83X\83\8c\8f\84\89ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 408                 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
 409         //\83G\83\89\81[\8ds\95Û\91¶\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 410         errorFileName := GikoSys.GetConfigDir + ERROR_ITEM_FILENAME;
 411                 if FileExists(FileName) then begin
 412                         sl.LoadFromFile(FileName);
 413             if FileExists(errorFileName) then begin
 414                 try
 415                         errorSl.LoadFromFile(errorFileName);
 416                 except
 417                 end;
 418             end;
 419             //Item := TRoundItem.Create;
 420             delCount := 0;
 421                         //\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93
 422             if sl[0] = ROUND_INDEX_VERSION then begin
 423                                 for i := 1 to sl.Count - 1 do begin
 424                                         Item := ParseRoundThreadLine(sl[i - delCount]);
 425                     if Item <> nil then begin
 426                                                 FItemList.Add(Item);
 427                                                 RoundNameList.Add(Item.RoundName);
 428                                         end else begin
 429                         errorSl.Add(sl[i - delCount]);
 430                         sl.Delete(i - delCount);
 431                         Inc(delCount);
 432                     end;
 433                 end;
 434             end else begin
 435                 LoadRoundBoardFile;
 436                 for i := 1 to sl.Count - 1 do begin
 437                                         Item := ParseOldRoundThreadLine(sl[i - delCount]);
 438                     if Item <> nil then begin
 439                                                 FItemList.Add(Item);
 440                                                 RoundNameList.Add(Item.RoundName);
 441                     end else begin
 442                                                 errorSl.Add(sl[i - delCount]);
 443                         sl.Delete(i - delCount);
 444                         Inc(delCount);
 445                     end;
 446                                 end;
 447             end;
 448 //              j := boardList.Count - 1;
 449 //          while j >= 0 do begin
 450 //                      GikoSys.ReadSubjectFile( BBSsFindBoardFromURL( boardList[j] ) );
 451 //                  boardList.Delete(j);
 452 //              Dec(j);
 453 //              end;
 454             if errorSl.Count > 0 then
 455                 errorSl.SaveToFile(errorFileName);
 456                 end;
 457         finally
 458                 sl.Free;
 459 //        boardList.Free;
 460         end;
 461 end;
 462 procedure TRoundList.SaveRoundFile;
 463 var
 464         i: integer;
 465         FileName: string;
 466         sl: TStringList;
 467         s: string;
 468         Item: TRoundItem;
 469 begin
 470         GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
 471
 472         sl := TStringList.Create;
 473         try
 474                 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
 475                 sl.Add(ROUND_INDEX_VERSION);
 476                 for i := 0 to FBoardList.Count - 1 do begin
 477                         Item := TRoundItem(FBoardList[i]);
 478                         s := Item.URL + #1
 479                                  + Item.BoardTitle + #1
 480                                  + Item.RoundName;
 481                         sl.Add(s);
 482                 end;
 483                 sl.SaveToFile(FileName);
 484                 sl.Clear;
 485                 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
 486                 sl.Add(ROUND_INDEX_VERSION);
 487                 for i := 0 to FItemList.Count - 1 do begin
 488                         Item := TRoundItem(FItemList[i]);
 489                         s := Item.URL + #1
 490                                  + Item.BoardTitle + #1
 491                                  + Item.FileName + #1
 492                                  + Item.ThreadTitle + #1
 493                                  + Item.RoundName;
 494                         sl.Add(s);
 495                 end;
 496                 sl.SaveToFile(FileName);
 497         finally
 498                 sl.Free;
 499         end;
 500 end;
 501 function TRoundList.ParseRoundBoardLine(Line: string): TRoundItem;
 502 var
 503         s: string;
 504         i: Integer;
 505 begin
 506         Result := TRoundItem.Create;
 507     Result.ThreadTitle := '';
 508     Result.FileName := '';
 509     Result.RoundType := grtBoard;
 510     for i := 0 to 2 do begin
 511         s := GikoSys.GetTokenIndex(Line, #1, i);
 512         try
 513                 case i of
 514                 0:
 515                 begin
 516                                 Result.URL := s;
 517                         end;
 518                 1: Result.BoardTitle := s;
 519                 2: Result.RoundName := s;
 520                 end;
 521         except
 522                 Result := nil;
 523             Exit;
 524         end;
 525     end;
 526 end;
 527
 528 function TRoundList.ParseRoundThreadLine(Line: string): TRoundItem;
 529 var
 530         s: string;
 531         i: Integer;
 532 //    threadItem: TThreadItem;
 533 begin
 534     Result := TRoundItem.Create;
 535         Result.RoundType := grtItem;
 536     for i := 0 to 4 do begin
 537         s := GikoSys.GetTokenIndex(Line, #1, i);
 538         try
 539             case i of
 540                 0:
 541                 begin
 542                     Result.URL := s;
 543                     //threadItem := BBSsFindThreadFromURL( s );
 544                     //if threadItem <> nil then begin
 545                     //    BoardList.Add( threadItem.ParentBoard.URL );
 546                     //end;
 547                 end;
 548                 1: Result.BoardTitle := s;
 549                 2: Result.FileName := s;
 550                 3: Result.ThreadTitle := s;
 551                 4: Result.RoundName := s;
 552             end;
 553         except
 554                 Result := nil;
 555             Exit;
 556         end;
 557     end;
 558 end;
 559
 560 function TRoundList.ParseOldRoundBoardLine(Line: string): TRoundItem;
 561     var
 562     i: Integer;
 563         s: string;
 564     board: TBoard;
 565 begin
 566         Result := TRoundItem.Create;
 567     Result.ThreadTitle := '';
 568     Result.FileName := '';
 569     Result.RoundType := grtBoard;
 570     for i := 0 to 2 do begin
 571         s := GikoSys.GetTokenIndex(Line, #1, i);
 572         try
 573                 case i of
 574                         0:
 575                         begin
 576                         board := BBSs[ 0 ].FindBBSID( s );
 577                     if board <> nil then begin
 578                                         Result.URL := board.URL;
 579                     end else begin
 580                         raise Exception.Create('\82±\82Ì\8f\84\89ñ\82Í\93Ç\82Ý\8d\9e\82ß\82È\82¢\82æ\81i\91½\95ª\8aO\95\94\94Â\81j');
 581                     end;
 582                         end;
 583                 1: Result.FBoardTitle := s;
 584                 2: Result.RoundName := s;
 585                 end;
 586         except
 587                 Result := nil;
 588             Exit;
 589         end;
 590     end;
 591 end;
 592
 593 function TRoundList.ParseOldRoundThreadLine(Line: string): TRoundItem;
 594     var
 595     i: Integer;
 596         s: string;
 597         buf: string;
 598     board: TBoard;
 599 //    threadItem: TThreadItem;
 600     bbsID: string;
 601 begin
 602         Result := TRoundItem.Create;
 603     Result.RoundType := grtItem;
 604     for i := 0 to 4 do begin
 605         s := GikoSys.GetTokenIndex(Line, #1, i);
 606         try
 607                 case i of
 608                 0: bbsID := s;
 609                     1: Result.BoardTitle := s;
 610                 2:
 611                         begin
 612                         Result.FileName := s;
 613                         board := BBSs[ 0 ].FindBBSID(bbsID);
 614                     if board <> nil then begin
 615                         buf := Copy(board.GetSendURL,1,LastDelimiter('/', board.GetSendURL)-1);
 616                                                 Result.URL := buf + '/read.cgi/'+ board.BBSID+ '/' +ChangeFileExt(s,'') + '/l50';
 617                     end else begin
 618                         raise Exception.Create('\82±\82Ì\8f\84\89ñ\82Í\93Ç\82Ý\8d\9e\82ß\82È\82¢\82æ');
 619                     end;
 620                     end;
 621                 3: Result.ThreadTitle := s;
 622                     4: Result.RoundName := s;
 623                 end;
 624         except
 625                 Result := nil;
 626             break;
 627         end;
 628     end;
 629 end;
 630
 631 end.