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     FBoardList.Capacity := FBoardList.Count;
 184         for i := FItemList.Count - 1 downto 0 do begin
 185         if FItemList[i] <> nil then
 186                         TRoundItem(FItemList[i]).Free;
 187                 FItemList.Delete(i);
 188         end;
 189     FItemList.Capacity := FItemList.Count;
 190 end;
 191
 192 function TRoundList.Find(Board: TBoard): Integer;
 193 var
 194         i: Integer;
 195         Item: TRoundItem;
 196 begin
 197         Result := -1;
 198         for i := 0 to FBoardList.Count - 1 do begin
 199                 Item := TRoundItem(FBoardList[i]);
 200                 if Item.FRoundType <> grtBoard then Continue;
 201                 if Item.FURL = Board.URL then begin
 202                         Result := i;
 203                         Exit;
 204                 end;
 205         end;
 206 end;
 207
 208 function TRoundList.Find(ThreadItem: TThreadItem): Integer;
 209 var
 210         i: Integer;
 211         Item: TRoundItem;
 212 begin
 213         Result := -1;
 214         for i := 0 to FItemList.Count - 1 do begin
 215                 Item := TRoundItem(FItemList[i]);
 216                 if Item.FRoundType <> grtItem then Continue;
 217                 if Item.FURL = ThreadItem.URL then begin
 218                         Result := i;
 219                         Exit;
 220                 end;
 221         end;
 222 end;
 223 function TRoundList.Find(URL: string; RoundType: TGikoRoundType): Integer;
 224 var
 225         i: Integer;
 226         Item: TRoundItem;
 227 begin
 228         Result := -1;
 229     if RoundType = grtItem then begin
 230                 for i := 0 to FItemList.Count - 1 do begin
 231                         Item := TRoundItem(FItemList[i]);
 232                         if Item.FRoundType <> RoundType then Continue;
 233                         if Item.FURL = URL then begin
 234                                 Result := i;
 235                                 Exit;
 236                         end;
 237                 end;
 238     end else begin
 239         for i := 0 to FBoardList.Count - 1 do begin
 240                         Item := TRoundItem(FBoardList[i]);
 241                         if Item.FRoundType <> RoundType then Continue;
 242                         if Item.FURL = URL then begin
 243                                 Result := i;
 244                                 Exit;
 245                         end;
 246                 end;
 247     end;
 248 end;
 249 procedure TRoundList.Delete(URL: string; RoundType: TGikoRoundType);
 250 var
 251         idx: Integer;
 252         Item: TRoundItem;
 253     board: TBoard;
 254     threadItem: TThreadItem;
 255 begin
 256         idx := Find(URL, RoundType);
 257         if idx <> -1 then begin
 258
 259         if RoundType = grtBoard then begin
 260                         Item := TRoundItem(FBoardList[idx]);
 261                         Item.Free;
 262                         FBoardList.Delete(idx);
 263                 board := BBSsFindBoardFromURL(URL);
 264             if board <> nil then begin
 265                 board.Round := False;
 266                 board.RoundName := '';
 267             end;
 268         end else begin
 269                         Item := TRoundItem(FItemList[idx]);
 270                         Item.Free;
 271                         FItemList.Delete(idx);
 272
 273             threadItem := BBSsFindThreadFromURL(URL);
 274             if threadItem <> nil then begin
 275                     threadItem.Round := false;
 276                 threadItem.RoundName := '';
 277             end;
 278         end;
 279         end;
 280 end;
 281
 282 procedure TRoundList.SetRoundName(Board: TBoard; RoundName: string);
 283 var
 284         idx: Integer;
 285         Item: TRoundItem;
 286 begin
 287         idx := Find(Board);
 288         if idx <> -1 then begin
 289                 Item := TRoundItem(FBoardList[idx]);
 290                 Item.RoundName := RoundName;
 291         end;
 292 end;
 293
 294 procedure TRoundList.SetRoundName(ThreadItem: TThreadItem; RoundName: string);
 295 var
 296         idx: Integer;
 297         Item: TRoundItem;
 298 begin
 299         idx := Find(ThreadItem);
 300         if idx <> -1 then begin
 301                 Item := TRoundItem(FItemList[idx]);
 302                 Item.RoundName := RoundName;
 303         end;
 304 end;
 305
 306 function TRoundList.GetCount(RoundType: TGikoRoundType): Integer;
 307 begin
 308         Result := 0;
 309         if RoundType = grtBoard then
 310                 Result := FBoardList.Count
 311         else if RoundType = grtItem then
 312                 Result := FItemList.Count;
 313 end;
 314
 315 function TRoundList.GetRoundItem(Index: Integer; RoundType: TGikoRoundType): TRoundItem;
 316 begin
 317         Result := nil;
 318         if RoundType = grtBoard then begin
 319                 if (Index >= 0) and (Index < FBoardList.Count) then
 320                         Result := TRoundItem(FBoardList[Index]);
 321         end else if RoundType = grtItem then begin
 322                 if (Index >= 0) and (Index < FItemList.Count) then
 323                         Result := TRoundItem(FItemList[Index]);
 324         end;
 325 end;
 326 procedure TRoundList.LoadRoundBoardFile;
 327 var
 328         i: Integer;
 329         sl: TStringList;
 330         FileName: string;
 331     errorSl: TStringList;
 332     errorFileName: string;
 333         Item: TRoundItem;
 334     delCount: Integer;
 335 begin
 336         sl := TStringList.Create;
 337     errorSl := TStringList.Create;
 338         errorSl.Duplicates := dupIgnore;
 339         try
 340                 //\83{\81[\83h\8f\84\89ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 341                 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
 342         //\83G\83\89\81[\8ds\95Û\91¶\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 343         errorFileName := GikoSys.GetConfigDir + ERROR_BOARD_FILENAME;
 344                 if FileExists(FileName) then begin
 345                         sl.LoadFromFile(FileName);
 346             if FileExists(errorFileName) then begin
 347                 try
 348                         errorSl.LoadFromFile(errorFileName);
 349                 except
 350                 end;
 351             end;
 352             //Item := TRoundItem.Create;
 353             delCount := 0;
 354             //\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93
 355                         if sl[0] = ROUND_INDEX_VERSION then begin
 356                                 for i := 1 to sl.Count - 1 do begin
 357                                         Item := ParseRoundBoardLine(sl[i - delCount]);
 358                     if Item <> nil then begin
 359                                                 FBoardList.Add(Item);
 360                                                 RoundNameList.Add(Item.RoundName);
 361                     end else begin
 362                         errorSl.Add( sl[i - delCount] );
 363                         sl.Delete(i- delCount);
 364                         Inc(delCount);
 365                     end;
 366                                 end;
 367             end else begin
 368                 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Å
 369                                         for i := 1 to sl.Count - 1 do begin
 370                                                 Item := ParseOldRoundBoardLine(sl[i - delCount]);
 371                         if Item <> nil then begin
 372                                                         FBoardList.Add(Item);
 373                                                         RoundNameList.Add(Item.RoundName);
 374                         end else begin
 375                                 errorSl.Add( sl[i- delCount] );
 376                                 sl.Delete(i- delCount);
 377                             Inc(delCount);
 378                         end;
 379                                         end;
 380                 end else
 381                         FOldFileRead := true;
 382             end;
 383                 end;
 384         if errorSl.Count > 0 then
 385                 errorSl.SaveToFile(errorFileName);
 386         finally
 387         errorSl.Free;
 388                 sl.Free;
 389         end;
 390 end;
 391 procedure TRoundList.LoadRoundThreadFile;
 392 var
 393         i: Integer;
 394 //    j: Integer;
 395         sl: TStringList;
 396         FileName: string;
 397     errorSl: TStringList;
 398     errorFileName: string;
 399         Item: TRoundItem;
 400     delCount: Integer;
 401 //    boardList : TStringList;
 402 begin
 403 //    boardList := TStringList.Create;
 404 //    boardList.Duplicates := dupIgnore;
 405     errorSl := TStringList.Create;
 406         errorSl.Duplicates := dupIgnore;
 407         sl := TStringList.Create;
 408         try
 409                 //\83X\83\8c\8f\84\89ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 410                 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
 411         //\83G\83\89\81[\8ds\95Û\91¶\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
 412         errorFileName := GikoSys.GetConfigDir + ERROR_ITEM_FILENAME;
 413                 if FileExists(FileName) then begin
 414                         sl.LoadFromFile(FileName);
 415             if FileExists(errorFileName) then begin
 416                 try
 417                         errorSl.LoadFromFile(errorFileName);
 418                 except
 419                 end;
 420             end;
 421             //Item := TRoundItem.Create;
 422             delCount := 0;
 423                         //\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93
 424             if sl[0] = ROUND_INDEX_VERSION then begin
 425                                 for i := 1 to sl.Count - 1 do begin
 426                                         Item := ParseRoundThreadLine(sl[i - delCount]);
 427                     if Item <> nil then begin
 428                                                 FItemList.Add(Item);
 429                                                 RoundNameList.Add(Item.RoundName);
 430                                         end else begin
 431                         errorSl.Add(sl[i - delCount]);
 432                         sl.Delete(i - delCount);
 433                         Inc(delCount);
 434                     end;
 435                 end;
 436             end else begin
 437                 LoadRoundBoardFile;
 438                 for i := 1 to sl.Count - 1 do begin
 439                                         Item := ParseOldRoundThreadLine(sl[i - delCount]);
 440                     if Item <> nil then begin
 441                                                 FItemList.Add(Item);
 442                                                 RoundNameList.Add(Item.RoundName);
 443                     end else begin
 444                                                 errorSl.Add(sl[i - delCount]);
 445                         sl.Delete(i - delCount);
 446                         Inc(delCount);
 447                     end;
 448                                 end;
 449             end;
 450 //              j := boardList.Count - 1;
 451 //          while j >= 0 do begin
 452 //                      GikoSys.ReadSubjectFile( BBSsFindBoardFromURL( boardList[j] ) );
 453 //                  boardList.Delete(j);
 454 //              Dec(j);
 455 //              end;
 456             if errorSl.Count > 0 then
 457                 errorSl.SaveToFile(errorFileName);
 458                 end;
 459         finally
 460         errorSl.Free;
 461                 sl.Free;
 462 //        boardList.Free;
 463         end;
 464 end;
 465 procedure TRoundList.SaveRoundFile;
 466 var
 467         i: integer;
 468         FileName: string;
 469         sl: TStringList;
 470         s: string;
 471         Item: TRoundItem;
 472 begin
 473         GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
 474
 475         sl := TStringList.Create;
 476         try
 477                 FileName := GikoSys.GetConfigDir + ROUND_BOARD_FILENAME;
 478                 sl.Add(ROUND_INDEX_VERSION);
 479                 for i := 0 to FBoardList.Count - 1 do begin
 480                         Item := TRoundItem(FBoardList[i]);
 481                         s := Item.URL + #1
 482                                  + Item.BoardTitle + #1
 483                                  + Item.RoundName;
 484                         sl.Add(s);
 485                 end;
 486                 sl.SaveToFile(FileName);
 487                 sl.Clear;
 488                 FileName := GikoSys.GetConfigDir + ROUND_ITEM_FILENAME;
 489                 sl.Add(ROUND_INDEX_VERSION);
 490                 for i := 0 to FItemList.Count - 1 do begin
 491                         Item := TRoundItem(FItemList[i]);
 492                         s := Item.URL + #1
 493                                  + Item.BoardTitle + #1
 494                                  + Item.FileName + #1
 495                                  + Item.ThreadTitle + #1
 496                                  + Item.RoundName;
 497                         sl.Add(s);
 498                 end;
 499                 sl.SaveToFile(FileName);
 500         finally
 501                 sl.Free;
 502         end;
 503 end;
 504 function TRoundList.ParseRoundBoardLine(Line: string): TRoundItem;
 505 var
 506         s: string;
 507         i: Integer;
 508 begin
 509         Result := TRoundItem.Create;
 510     Result.ThreadTitle := '';
 511     Result.FileName := '';
 512     Result.RoundType := grtBoard;
 513     for i := 0 to 2 do begin
 514         s := GikoSys.GetTokenIndex(Line, #1, i);
 515         try
 516                 case i of
 517                 0:
 518                 begin
 519                                 Result.URL := s;
 520                         end;
 521                 1: Result.BoardTitle := s;
 522                 2: Result.RoundName := s;
 523                 end;
 524         except
 525                 Result := nil;
 526             Exit;
 527         end;
 528     end;
 529 end;
 530
 531 function TRoundList.ParseRoundThreadLine(Line: string): TRoundItem;
 532 var
 533         s: string;
 534         i: Integer;
 535 //    threadItem: TThreadItem;
 536 begin
 537     Result := TRoundItem.Create;
 538         Result.RoundType := grtItem;
 539     for i := 0 to 4 do begin
 540         s := GikoSys.GetTokenIndex(Line, #1, i);
 541         try
 542             case i of
 543                 0:
 544                 begin
 545                     Result.URL := s;
 546                     //threadItem := BBSsFindThreadFromURL( s );
 547                     //if threadItem <> nil then begin
 548                     //    BoardList.Add( threadItem.ParentBoard.URL );
 549                     //end;
 550                 end;
 551                 1: Result.BoardTitle := s;
 552                 2: Result.FileName := s;
 553                 3: Result.ThreadTitle := s;
 554                 4: Result.RoundName := s;
 555             end;
 556         except
 557                 Result := nil;
 558             Exit;
 559         end;
 560     end;
 561 end;
 562
 563 function TRoundList.ParseOldRoundBoardLine(Line: string): TRoundItem;
 564     var
 565     i: Integer;
 566         s: string;
 567     board: TBoard;
 568 begin
 569         Result := TRoundItem.Create;
 570     Result.ThreadTitle := '';
 571     Result.FileName := '';
 572     Result.RoundType := grtBoard;
 573     for i := 0 to 2 do begin
 574         s := GikoSys.GetTokenIndex(Line, #1, i);
 575         try
 576                 case i of
 577                         0:
 578                         begin
 579                         board := BBSs[ 0 ].FindBBSID( s );
 580                     if board <> nil then begin
 581                                         Result.URL := board.URL;
 582                     end else begin
 583                         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');
 584                     end;
 585                         end;
 586                 1: Result.FBoardTitle := s;
 587                 2: Result.RoundName := s;
 588                 end;
 589         except
 590                 Result := nil;
 591             Exit;
 592         end;
 593     end;
 594 end;
 595
 596 function TRoundList.ParseOldRoundThreadLine(Line: string): TRoundItem;
 597     var
 598     i: Integer;
 599         s: string;
 600         buf: string;
 601     board: TBoard;
 602 //    threadItem: TThreadItem;
 603     bbsID: string;
 604 begin
 605         Result := TRoundItem.Create;
 606     Result.RoundType := grtItem;
 607     for i := 0 to 4 do begin
 608         s := GikoSys.GetTokenIndex(Line, #1, i);
 609         try
 610                 case i of
 611                 0: bbsID := s;
 612                     1: Result.BoardTitle := s;
 613                 2:
 614                         begin
 615                         Result.FileName := s;
 616                         board := BBSs[ 0 ].FindBBSID(bbsID);
 617                     if board <> nil then begin
 618                         buf := Copy(board.GetSendURL,1,LastDelimiter('/', board.GetSendURL)-1);
 619                                                 Result.URL := buf + '/read.cgi/'+ board.BBSID+ '/' +ChangeFileExt(s,'') + '/l50';
 620                     end else begin
 621                         raise Exception.Create('\82±\82Ì\8f\84\89ñ\82Í\93Ç\82Ý\8d\9e\82ß\82È\82¢\82æ');
 622                     end;
 623                     end;
 624                 3: Result.ThreadTitle := s;
 625                     4: Result.RoundName := s;
 626                 end;
 627         except
 628                 Result := nil;
 629             break;
 630         end;
 631     end;
 632 end;
 633
 634 end.