Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/BoardGroup.pas

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


Revision 1.1 - (show annotations) (download) (as text)
Sat Aug 9 13:50:40 2003 UTC (20 years, 8 months ago) by hi_
Branch: MAIN
Branch point for: hi
File MIME type: text/x-pascal
Initial revision

1 unit BoardGroup;
2
3 interface
4
5 uses
6 SysUtils, Classes, ComCtrls, IniFiles, HTTPApp, IdGlobal;
7
8 type
9 //リストの表示アイテム選択
10 TGikoViewType = (gvtAll, gvtLog, gvtNew, gvtUser);
11 //リストの取得件数
12 //TGikoListCount = (glc50, glc100, glc200, glc500, glc1000, glcAll);
13 //巡回番号
14 //TGikoRoundNo = (grnNone, grn1, grn2, grn3, grn4, grn5, grnOnce);
15 //リストの上げ下げ
16 TGikoAgeSage = (gasNone, gasAge, gasSage, gasNew);
17
18 { TFolder = class
19 private
20 FItemList: TList; //子アイテムリスト
21 FLeaf: Boolean; //下にフォルダを持つことが出来るか
22 public
23 function Add(Item: TFolder): Integer;
24 procedure Clear;
25 procedure Delete(Index: Integer);
26 procedure Exchange(Index1, Index2: Integer);
27 procedure Insert(Index: Integer; Item: TFolder);
28 procedure Move(CurIndex, NewIndex: Integer);
29 function Remove(Item: TFolder): Integer;
30 procedure Sort(Compare: TListSortCompare);
31 property Capacity: Integer read FCapacity write SetCapacity;
32 property Count: Integer read FCount write SetCount;
33 property Items[Index: Integer]: TFolder read Get write Put; default;
34
35 property Leaf: Boolean read FLeaf;
36 end;
37
38 TBBS = class(TFolder)
39 end;
40 TCategory class(TFolder)
41 end;
42 TBoard = class(TFolder)
43 end;
44 TThreadItem = class(TFolder)
45 end;
46 }
47
48 {
49 TBBS2ch = class(TBBS)
50 end;
51 TBoard2ch = class(TBoard)
52 end;
53 TThreadItem2ch = class(TThreadItem)
54 end;
55 }
56
57 // ITest = interface
58 // end;
59 // IBBS = interface
60 // end;
61 // ICategory = interface
62 // end;
63 // IBoard = interface
64 // end;
65 // IThreadItem = interface
66 // end;
67
68 TCategory = class;
69 TBoard = class;
70 TThreadItem = class;
71
72 //とりあえず2ちゃんねるのルート
73 TBBS2ch = class(TList)
74 private
75 FTitle: string;
76 FLogFolder: string;
77 FExpand: Boolean;
78 FKubetsuChk: Boolean; //絞込み時大文字小文字区別
79 FSelectText: string; //絞込み文字列
80 FShortSelectText: string;
81
82 function GetCategory(index: integer): TCategory;
83 procedure SetCategory(index: integer; value: TCategory);
84 procedure SetSelectText(s: string);
85 public
86 constructor Create(LogFolder: string);
87 destructor Destroy; override;
88
89 procedure ReadBoardFile;
90
91 function GetBoardFromBBSID(BBSID: string): TBoard;
92
93 function Add(item: TCategory): integer;
94 procedure Delete(index: integer);
95 procedure Clear; override;
96 function Find(key: string): TCategory;
97 function FindBBSID(BBSID: string): TBoard;
98 function FindBoardFromTitle(Title: string): TBoard;
99 function FindThreadItem(BBSID: string; FileName: string): TThreadItem;
100 function GetLogFolder: string;
101
102 property Items[index: integer]: TCategory read GetCategory write SetCategory;
103 property Title: string read FTitle write FTitle;
104 property NodeExpand: Boolean read FExpand write FExpand;
105
106 property KubetsuChk: Boolean read FKubetsuChk write FKubetsuChk;
107 property SelectText: string read FSelectText write SetSelectText;
108 property ShortSelectText: string read FShortSelectText write FShortSelectText;
109 end;
110
111 //カテゴリ
112 TCategory = class(TList)
113 private
114 FNo: Integer;
115 FTitle: string;
116 FParentBBS2ch: TBBS2ch;
117 FExpand: Boolean;
118
119 function GetBoard(index: integer): TBoard;
120 procedure SetBoard(index: integer; value: TBoard);
121 public
122 constructor Create;
123 destructor Destroy; override;
124
125 property No: Integer read FNo write FNo;
126 property Title: string read FTitle write FTitle;
127 property Items[index: integer]: TBoard read GetBoard write SetBoard;
128 property ParentBBS2ch: TBBS2ch read FParentBBS2ch write FParentBBS2ch;
129
130 function Add(item: TBoard): integer;
131 procedure Delete(index: integer);
132 procedure Clear; override;
133 function FindName(key: string): TBoard;
134 function FindBBSID(BBSID: string): TBoard;
135 function FindBoardFromTitle(Title: string): TBoard;
136 function IsMidoku: Boolean;
137
138 property NodeExpand: Boolean read FExpand write FExpand;
139 end;
140
141 //板
142 TBoard = class(TList)
143 private
144 FNo: Integer; //番号
145 FTitle: string; //ボードタイトル
146 FBBSID: string; //BBSID
147 FURL: string; //ボードURL
148 FRound: Boolean; //スレッド一覧巡回予約
149 FRoundName: string; //巡回名
150 FRoundDate: TDateTime; //スレッド一覧を取得した日時(巡回日時)
151 FLastModified: TDateTime; //スレッド一覧が更新されている日時(サーバ側日時)
152 FLastGetTime: TDateTime; //スレッドまたはスレッド一覧を最後に更新した日時(サーバ側日時・書き込み時に使用する)
153 FIsThreadDatRead: Boolean; //スレッドリストは読み込まれているか?
154 FUnRead: Integer; //スレッド未読数
155 FParentCategory: TCategory; //親カテゴリ
156 FModified: Boolean; //修正フラグ
157 FBoolData: Boolean; //いろんな用途に使うyo
158 FSPID: string; //書き込み用SPID
159 FPON: string; //書き込み用PON
160 FKotehanName: string; //コテハン名前
161 FKotehanMail: string; //コテハンメール
162
163 FUpdate: Boolean;
164 FExpand: Boolean;
165
166 function GetThreadItem(index: integer): TThreadItem;
167 procedure SetThreadItem(index: integer; value: TThreadItem);
168 procedure SetRound(b: Boolean);
169 procedure SetRoundName(s: string);
170 procedure SetLastModified(d: TDateTime);
171 procedure SetLastGetTime(d: TDateTime);
172 procedure SetUnRead(i: Integer);
173 procedure SetKotehanName(s: string);
174 procedure SetKotehanMail(s: string);
175 public
176 constructor Create;
177 destructor Destroy; override;
178
179 property Items[index: integer]: TThreadItem read GetThreadItem write SetThreadItem;
180 property No: Integer read FNo write FNo;
181 property Title: string read FTitle write FTitle;
182 property BBSID: string read FBBSID write FBBSID;
183 property URL: string read FURL write FURL;
184 property Round: Boolean read FRound write SetRound;
185 property RoundName: string read FRoundName write SetRoundName;
186 property RoundDate: TDateTime read FRoundDate write FRoundDate;
187 property LastModified: TDateTime read FLastModified write SetLastModified;
188 property LastGetTime: TDateTime read FLastGetTime write SetLastGetTime;
189 property UnRead: Integer read FUnRead write SetUnRead;
190 property Modified: Boolean read FModified write FModified;
191 property IsThreadDatRead: Boolean read FIsThreadDatRead write FIsThreadDatRead;
192 property ParentCategory: TCategory read FParentCategory write FParentCategory;
193
194 function Add(item: TThreadItem): integer;
195 procedure Insert(Index: Integer; Item: TThreadItem);
196 procedure Delete(index: integer);
197 procedure DeleteList(index: integer);
198 procedure Clear; override;
199 function Find(ItemFileName: string): TThreadItem;
200 function GetIndex(ItemFileName: string): Integer;
201 procedure LoadSettings;
202 procedure SaveSettings;
203 function GetReadCgiURL: string;
204 function GetSubjectFileName: string;
205 function GetFolderIndexFileName: string;
206
207 function GetNewThreadCount: Integer;
208 function GetLogThreadCount: Integer;
209 function GetUserThreadCount: Integer;
210 function GetNewThread(Index: Integer): TThreadItem;
211 function GetLogThread(Index: Integer): TThreadItem;
212 function GetUserThread(Index: Integer): TThreadItem;
213
214 procedure BeginUpdate;
215 procedure EndUpdate;
216 property NodeExpand: Boolean read FExpand write FExpand;
217 property BoolData: Boolean read FBoolData write FBoolData;
218 property SPID: string read FSPID write FSPID;
219 property PON: string read FPON write FPON;
220 property KotehanName: string read FKotehanName write SetKotehanName;
221 property KotehanMail: string read FKotehanMail write SetKotehanMail;
222 end;
223
224 //スレ
225 TThreadItem = class(TObject)
226 private
227 FNo: Integer; //番号
228 FFileName: string; //スレッドファイル名
229 FTitle: string; //スレッドタイトル
230 FShortTitle: string; //短いスレッドタイトル(検索用)
231 FRoundDate: TDateTime; //スレッドを取得した日時(巡回日時)
232 FLastModified: TDateTime; //スレッドが更新されている日時(サーバ側日時)
233 FCount: Integer; //スレッドカウント(ローカル)
234 FAllResCount: Integer; //スレッドカウント(サーバ)
235 FNewResCount: Integer; //スレッド新着数
236 FSize: Integer; //スレッドサイズ
237 FRound: Boolean; //巡回フラグ
238 FRoundName: string; //巡回名
239 FIsLogFile: Boolean; //ログ存在フラグ
240 FParentBoard: TBoard; //親ボード
241 FKokomade: Integer; //ココまで読んだ番号
242 FNewReceive: Integer; //ココから新規受信
243 FNewArrival: Boolean; //新着
244 FUnRead: Boolean; //未読フラグ
245 FScrollTop: Integer; //スクロール位置
246 FDownloadHost: string; //今のホストと違う場合のホスト
247 FAgeSage: TGikoAgeSage; //アイテムの上げ下げ
248 // FSPID: string; //書き込み用SPID
249
250 FUpdate: Boolean;
251 FExpand: Boolean;
252
253 procedure SetLastModified(d: TDateTime);
254 procedure SetRound(b: Boolean);
255 procedure SetRoundName(s: string);
256 procedure SetKokomade(i: Integer);
257 procedure SetUnRead(b: Boolean);
258 procedure SetScrollTop(i: Integer);
259 public
260 constructor Create;
261 destructor Destroy; override;
262
263 function GetDatURL: string;
264 function GetDatgzURL: string;
265 // function GetOldDatgzURL: string;
266 function GetOfflawCgiURL(SessionID: string): string;
267 function GetSendURL: string;
268 procedure DeleteLogFile;
269 function GetThreadFileName: string;
270 procedure BeginUpdate;
271 procedure EndUpdate;
272
273 property No: Integer read FNo write FNo;
274 property FileName: string read FFileName write FFileName;
275 property Title: string read FTitle write FTitle;
276 property ShortTitle: string read FShortTitle write FShortTitle;
277 property RoundDate: TDateTime read FRoundDate write FRoundDate;
278 property LastModified: TDateTime read FLastModified write SetLastModified;
279 property Count: Integer read FCount write FCount;
280 property AllResCount: Integer read FAllResCount write FAllResCount;
281 property NewResCount: Integer read FNewResCount write FNewResCount;
282 property Size: Integer read FSize write FSize;
283 property Round: Boolean read FRound write SetRound;
284 property RoundName: string read FRoundName write SetRoundName;
285
286 property IsLogFile: Boolean read FIsLogFile write FIsLogFile;
287 property ParentBoard: TBoard read FParentBoard write FParentBoard;
288 property Kokomade: Integer read FKokomade write SetKokomade;
289 property NewReceive: Integer read FNewReceive write FNewReceive;
290 property NewArrival: Boolean read FNewArrival write FNewArrival;
291 property UnRead: Boolean read FUnRead write SetUnRead;
292 property ScrollTop: Integer read FScrollTop write SetScrollTop;
293 property Expand: Boolean read FExpand write FExpand;
294 property DownloadHost: string read FDownloadHost write FDownloadHost;
295 property AgeSage: TGikoAgeSage read FAgeSage write FAgeSage;
296 // property SPID: string read FSPID write FSPID;
297 end;
298
299
300
301 //検索結果リスト
302 { TSearchList = class(TList)
303 private
304 function GetThreadItem(index: integer): TThreadItem;
305 procedure SetThreadItem(index: integer; value: TThreadItem);
306 public
307 constructor Create;
308 destructor Destroy; override;
309
310 property Items[index: integer]: TThreadItem read GetThreadItem write SetThreadItem;
311
312 function Add(item: TThreadItem): integer;
313 procedure Delete(index: integer);
314 procedure Clear; override;
315 end;}
316
317 var
318 BBS2ch: TBBS2ch;
319
320 implementation
321
322 uses
323 GikoSystem, RoundData;
324
325 const
326 BBS2CH_NAME: string = '2ちゃんねる';
327 BBS2CH_LOG_FOLDER: string = '2ch';
328
329 FOLDER_INI_FILENAME: string = 'Folder.ini';
330 FOLDER_INDEX_FILENAME: string = 'Folder.idx';
331 SUBJECT_FILENAME: string = 'subject.txt';
332 PATH_DELIM: string = '\';
333 //DEFAULT_LIST_COUNT: Integer = 100;
334
335 // COLUMN_CATEGORY: array[0..0] of string = ('カテゴリ名');
336 // COLUMN_BOARD: array[0..3] of string = ('板名', '取得数', '巡回予約', '前回巡回日時');
337 // COLUMN_THREADITEM: array[0..3] of string = ('スレッド名', 'カウント', '巡回予約', '前回巡回日時');
338
339 (*************************************************************************
340 *機能名:TBBSコンストラクタ
341 *Public
342 *************************************************************************)
343 constructor TBBS2ch.Create(LogFolder: string);
344 begin
345 Title := BBS2CH_NAME;
346 FLogFolder := LogFolder;
347 end;
348
349 (*************************************************************************
350 *機能名:TBBSデストラクタ
351 *Public
352 *************************************************************************)
353 destructor TBBS2ch.Destroy;
354 begin
355 Clear;
356 inherited;
357 end;
358
359 (*************************************************************************
360 *機能名:
361 *Public
362 *************************************************************************)
363 function TBBS2ch.GetCategory(index: integer): TCategory;
364 begin
365 Result := TCategory(inherited Items[index]);
366 end;
367
368 procedure TBBS2ch.SetCategory(index: integer; value: TCategory);
369 begin
370 inherited Items[index] := value;
371 end;
372
373 function TBBS2ch.Add(item: TCategory): integer;
374 begin
375 Item.ParentBBS2ch := self;
376 Result := inherited Add(item);
377 end;
378
379 procedure TBBS2ch.Delete(index: integer);
380 begin
381 if Items[index] <> nil then
382 TCategory(Items[index]).Free;
383 Items[index] := nil;
384 inherited Delete(index);
385 end;
386
387 procedure TBBS2ch.Clear;
388 var
389 i: integer;
390 begin
391 for i := Count - 1 downto 0 do
392 Delete(i);
393 end;
394
395 function TBBS2ch.Find(key: string): TCategory;
396 begin
397 Result := nil;
398 end;
399
400 function TBBS2ch.FindBBSID(BBSID: string): TBoard;
401 var
402 i: Integer;
403 Category: TCategory;
404 Board: TBoard;
405 begin
406 Result := nil;
407 for i := 0 to Count - 1 do begin
408 Category := Items[i];
409 Board := Category.FindBBSID(BBSID);
410 if Board <> nil then begin
411 Result := Board;
412 Exit;
413 end;
414 end;
415 end;
416
417 function TBBS2ch.FindBoardFromTitle(Title: string): TBoard;
418 var
419 i: Integer;
420 Category: TCategory;
421 Board: TBoard;
422 begin
423 Result := nil;
424 for i := 0 to Count - 1 do begin
425 Category := Items[i];
426 Board := Category.FindBoardFromTitle(Title);
427 if Board <> nil then begin
428 Result := Board;
429 Exit;
430 end;
431 end;
432 end;
433
434 function TBBS2ch.FindThreadItem(BBSID: string; FileName: string): TThreadItem;
435 var
436 Board: TBoard;
437 begin
438 Result := nil;
439 Board := FindBBSID(BBSID);
440 if Board = nil then
441 Exit;
442 Result := Board.Find(FileName);
443 end;
444
445 (*************************************************************************
446 *機能名  :ボードファイル読み込み
447 *可視   :Public
448 *履歴1  :新規作成
449 *************************************************************************)
450 procedure TBBS2ch.ReadBoardFile;
451 var
452 i, j: integer;
453 idx: Integer;
454 ini: TMemIniFile;
455 CategoryList: TStringList;
456 BoardList: TStringList;
457 Category: TCategory;
458 Board: TBoard;
459 inistr: string;
460 RoundItem: TRoundItem;
461 BBSList: TStringList;
462 CustomList: TStringList;
463 begin
464 ini := TMemIniFile.Create('');
465 BBSList := TStringList.Create;
466 CustomList := TStringList.Create;
467 try
468 if FileExists(GikoSys.GetBoardFileName) then
469 BBSList.LoadFromFile(GikoSys.GetBoardFileName);
470 if FileExists(GikoSys.GetCustomBoardFileName) then
471 CustomList.LoadFromFile(GikoSys.GetCustomBoardFileName);
472 BBSList.AddStrings(CustomList);
473 ini.SetStrings(BBSList);
474
475 CategoryList := TStringList.Create;
476 BoardList := TStringList.Create;
477 try
478 ini.ReadSections(CategoryList);
479 for i := 0 to CategoryList.Count - 1 do begin
480
481 ini.ReadSection(CategoryList[i], BoardList);
482 Category := TCategory.Create;
483 Category.No := i + 1;
484 Category.Title := CategoryList[i];
485
486 for j := 0 to BoardList.Count - 1 do begin
487 inistr := ini.ReadString(CategoryList[i], BoardList[j], '');
488 Board := TBoard.Create;
489 Board.BeginUpdate;
490 Board.No := j + 1;
491 Board.Title := BoardList[j];
492 Board.BBSID := GikoSys.UrlToID(inistr);
493 Board.URL := inistr;
494 Board.RoundDate := ZERO_DATE;
495
496 idx := RoundList.Find(Board);
497 if idx <> -1 then begin
498 RoundItem := RoundList.Items[idx, grtBoard];
499 Board.Round := True;
500 Board.RoundName := RoundItem.RoundName;
501 end;
502 Category.Add(Board);
503 Board.EndUpdate;
504 end;
505 BBS2ch.Add(Category);
506 end;
507 finally
508 BoardList.Free;
509 CategoryList.Free;
510 end;
511 finally
512 BBSList.Free;
513 CustomList.Free;
514 ini.Free;
515 end;
516 end;
517
518 function TBBS2ch.GetBoardFromBBSID(BBSID: string): TBoard;
519 var
520 i: integer;
521 begin
522 Result := nil;
523 for i := 0 to BBS2ch.Count - 1 do begin
524 Result := BBS2ch.Items[i].FindBBSID(BBSID);
525 if Result <> nil then
526 Exit;
527 end;
528 end;
529
530 (*************************************************************************
531 *ログフォルダ取得
532 *
533 *************************************************************************)
534 function TBBS2ch.GetLogFolder: string;
535 begin
536 Result := IncludeTrailingPathDelimiter(FLogFolder)
537 + BBS2CH_LOG_FOLDER + PATH_DELIM;
538 end;
539
540 procedure TBBS2ch.SetSelectText(s: string);
541 begin
542 FSelectText := s;
543 ShortSelectText := GikoSys.ZenToHan(s);
544 end;
545
546 {class function TBBS2ch.GetColumnName(Index: Integer): string;
547 begin
548 Result := COLUMN_CATEGORY[Index];
549 end;
550
551 class function TBBS2ch.GetColumnCount: Integer;
552 begin
553 Result := Length(COLUMN_CATEGORY);
554 end;}
555
556 //===================
557 //TCategory
558 //===================
559 constructor TCategory.Create;
560 begin
561 end;
562
563 destructor TCategory.Destroy;
564 begin
565 Clear;
566 inherited;
567 end;
568
569 function TCategory.GetBoard(index: integer): TBoard;
570 begin
571 Result := TBoard(inherited Items[index]);
572 end;
573
574 procedure TCategory.SetBoard(index: integer; value: TBoard);
575 begin
576 inherited Items[index] := value;
577 end;
578
579 function TCategory.Add(item: TBoard): integer;
580 begin
581 Item.ParentCategory := self;
582 Result := inherited Add(item);
583 end;
584
585 procedure TCategory.Delete(index: integer);
586 begin
587 if Items[index] <> nil then
588 TBoard(Items[index]).Free;
589 Items[index] := nil;
590 inherited Delete(index);
591 end;
592
593 procedure TCategory.Clear;
594 var
595 i: integer;
596 begin
597 for i := Count - 1 downto 0 do
598 Delete(i);
599 end;
600
601 function TCategory.FindName(key: string): TBoard;
602 begin
603 Result := nil;
604 end;
605
606 function TCategory.FindBBSID(BBSID: string): TBoard;
607 var
608 i: integer;
609 begin
610 Result := nil;
611 for i := 0 to Count - 1 do begin
612 if Items[i].FBBSID = BBSID then begin
613 Result := Items[i];
614 Exit;
615 end;
616 end;
617 end;
618
619 function TCategory.FindBoardFromTitle(Title: string): TBoard;
620 var
621 i: integer;
622 begin
623 Result := nil;
624 for i := 0 to Count - 1 do begin
625 if Items[i].FTitle = Title then begin
626 Result := Items[i];
627 Exit;
628 end;
629 end;
630 end;
631
632 function TCategory.IsMidoku: Boolean;
633 var
634 i: Integer;
635 j: Integer;
636 begin
637 Result := False;
638 for i := 0 to Count - 1 do begin
639 if Items[i] <> nil then begin
640 for j := 0 to Items[i].Count - 1 do begin
641 if Items[i].Items[j] <> nil then begin
642 // if (Items[i].Items[j].IsLogFile) and (Items[i].Items[j].Count > Items[i].Items[j].Kokomade) then begin
643 if (Items[i].Items[j].IsLogFile) and (Items[i].Items[j].UnRead) then begin
644 Result := True;
645 Exit;
646 end;
647 end;
648 end;
649 end;
650 end;
651 end;
652
653 {class function TCategory.GetColumnName(Index: Integer): string;
654 begin
655 Result := COLUMN_BOARD[Index];
656 end;
657
658 class function TCategory.GetColumnCount: Integer;
659 begin
660 Result := Length(COLUMN_BOARD);
661 end;}
662
663 //===================
664 //TBoard
665 //===================
666 constructor TBoard.Create;
667 begin
668 FNo := 0;
669 FTitle := '';
670 FBBSID := '';
671 FURL := '';
672 FRound := False;
673 FRoundDate := ZERO_DATE;
674 FLastModified := ZERO_DATE;
675 FLastGetTime := ZERO_DATE;
676 FIsThreadDatRead := False;
677 FUnRead := 0;
678 // FListStyle := vsReport;
679 // FItemNoVisible := True;
680
681 FUpdate := True;
682 end;
683
684 destructor TBoard.Destroy;
685 begin
686 if FModified then begin
687 GikoSys.WriteThreadDat(Self);
688 SaveSettings;
689 end;
690
691 Clear;
692 inherited;
693 end;
694
695 function TBoard.GetThreadItem(index: integer): TThreadItem;
696 begin
697 Result := TThreadItem(inherited Items[index]);
698 end;
699
700 procedure TBoard.SetThreadItem(index: integer; value: TThreadItem);
701 begin
702 inherited Items[index] := value;
703 end;
704
705 function TBoard.Add(Item: TThreadItem): Integer;
706 begin
707 Item.ParentBoard := Self;
708 Result := inherited Add(Item);
709 end;
710
711 procedure TBoard.Insert(Index: Integer; Item: TThreadItem);
712 begin
713 Item.ParentBoard := Self;
714 inherited Insert(Index, Item);
715 end;
716
717 //Indexで指定されたスレッドオブジェクトを破棄
718 procedure TBoard.Delete(index: Integer);
719 begin
720 if Items[index] <> nil then
721 TThreadItem(Items[index]).Free;
722 Items[index] := nil;
723 inherited Delete(index);
724 end;
725
726 //Indexで指定されたスレッドをリストから削除(スレオブジェクトはのこす)
727 procedure TBoard.DeleteList(index: integer);
728 begin
729 inherited Delete(index);
730 end;
731
732 procedure TBoard.Clear;
733 var
734 i: integer;
735 begin
736 // FUnRead := 0;
737 for i := Count - 1 downto 0 do
738 Delete(i);
739 end;
740
741 function TBoard.Find(ItemFileName: string): TThreadItem;
742 var
743 i: integer;
744 begin
745 Result := nil;
746 for i := 0 to Count - 1 do begin
747 if Items[i].FileName = ItemFileName then begin
748 Result := Items[i];
749 Exit;
750 end;
751 end;
752 end;
753
754 function TBoard.GetIndex(ItemFileName: string): Integer;
755 var
756 i: integer;
757 begin
758 Result := -1;
759 for i := 0 to Count - 1 do begin
760 if Items[i].FileName = ItemFileName then begin
761 Result := i;
762 Exit;
763 end;
764 end;
765 end;
766
767 {function TBoard.GetMidokuCount: Integer;
768 var
769 i: integer;
770 begin
771 Result := 0;
772 for i := 0 to Count- 1 do begin
773 if Items[i] <> nil then begin
774 if (Items[i].IsLogFile) and (Items[i].Count > Items[i].Kokomade) then
775 inc(Result);
776 end;
777 end;
778 end;
779 }
780
781 procedure TBoard.LoadSettings;
782 var
783 ini: TMemIniFile;
784 FileName: string;
785 begin
786 FileName := ParentCategory.ParentBBS2ch.GetLogFolder
787 + BBSID + PATH_DELIM + FOLDER_INI_FILENAME;
788
789 if not FileExists(FileName) then
790 Exit;
791 ini := TMemIniFile.Create(FileName);
792 try
793 // Round := ini.ReadBool('Status', 'Round', False);
794 FRoundDate := ini.ReadDateTime('Status', 'RoundDate', ZERO_DATE);
795 FLastModified := ini.ReadDateTime('Status', 'LastModified', ZERO_DATE);
796 FLastGetTime := ini.ReadDateTime('Status', 'LastGetTime', ZERO_DATE);
797 FUnRead := ini.ReadInteger('Status', 'UnRead', 0);
798 FSPID := ini.ReadString('Cookie', 'SPID', '');
799 FPON := ini.ReadString('Cookie', 'PON', '');
800 FKotehanName := ini.ReadString('Kotehan', 'Name', '');
801 FKotehanMail := ini.ReadString('Kotehan', 'Mail', '');
802 // ListStyle := TViewStyle(Ord(ini.ReadInteger('Status', 'ListStyle', 3)));
803 // ItemNoVisible := ini.ReadBool('Status', 'ItemNoVisible', True);
804 // ViewType := TGikoViewType(Ord(ini.ReadInteger('Status', 'ViewType', 0)));
805 if UnRead < 0 then
806 UnRead := 0;
807 finally
808 ini.Free;
809 end;
810 end;
811
812 procedure TBoard.SaveSettings;
813 var
814 ini: TMemIniFile;
815 FileName: string;
816 begin
817 FileName := ParentCategory.ParentBBS2ch.GetLogFolder
818 + BBSID + PATH_DELIM;
819 if not GikoSys.DirectoryExistsEx(FileName) then
820 GikoSys.ForceDirectoriesEx(FileName);
821 FileName := FileName + FOLDER_INI_FILENAME;
822 ini := TMemIniFile.Create(FileName);
823 try
824 if UnRead < 0 then
825 UnRead := 0;
826 // ini.WriteBool('Status', 'Round', Round);
827 ini.WriteDateTime('Status', 'RoundDate', FRoundDate);
828 ini.WriteDateTime('Status', 'LastModified', FLastModified);
829 ini.WriteDateTime('Status', 'LastGetTime', FLastGetTime);
830 ini.WriteInteger('Status', 'UnRead', FUnRead);
831 ini.WriteString('Cookie', 'SPID', FSPID);
832 ini.WriteString('Cookie', 'PON', FPON);
833 ini.WriteString('Kotehan', 'Name', FKotehanName);
834 ini.WriteString('Kotehan', 'Mail', FKotehanMail);
835 // ini.WriteInteger('Status', 'ListStyle', Ord(ListStyle));
836 // ini.WriteBool('Status', 'ItemNoVisible', ItemNoVisible);
837 // ini.WriteInteger('Status', 'ViewType', Ord(ViewType));
838 ini.UpdateFile;
839 finally
840 ini.Free;
841 end;
842 end;
843
844 // サブジェクトURL取得
845 function TBoard.GetReadCgiURL: string;
846 begin
847 //Result := URL + SUBJECT_FILENAME;
848 //Result := GikoSys.UrlToServer(URL)
849 // + 'test/read.cgi/' + BBSID + '/?raw=0.0';
850 Result := URL + SUBJECT_FILENAME;
851
852 end;
853
854 // サブジェクトファイル名取得(パス+ファイル名)
855 function TBoard.GetSubjectFileName: string;
856 begin
857 Result := ParentCategory.ParentBBS2ch.GetLogFolder
858 + BBSID + PATH_DELIM + SUBJECT_FILENAME;
859 end;
860
861 // インデックスファイル名(folder.idx)取得(パス+ファイル名)
862 function TBoard.GetFolderIndexFileName: string;
863 begin
864 Result := ParentCategory.ParentBBS2ch.GetLogFolder
865 + BBSID + PATH_DELIM + FOLDER_INDEX_FILENAME;
866 end;
867
868 procedure TBoard.SetRound(b: Boolean);
869 begin
870 if b then
871 RoundList.Add(Self)
872 else
873 RoundList.Delete(Self);
874 if FRound = b then Exit;
875 FRound := b;
876 if FUpdate then
877 FModified := True;
878 end;
879
880 procedure TBoard.SetRoundName(s: string);
881 begin
882 if FRoundName = s then Exit;
883 FRoundName := s;
884 if FUpdate then
885 FModified := True;
886 end;
887
888 procedure TBoard.SetLastModified(d: TDateTime);
889 begin
890 if FLastModified = d then Exit;
891 FLastModified := d;
892 if FUpdate then
893 FModified := True;
894 end;
895
896 procedure TBoard.SetLastGetTime(d: TDateTime);
897 begin
898 if FLastGetTime = d then Exit;
899 FLastGetTime := d;
900 if FUpdate then
901 FModified := True;
902 end;
903
904 procedure TBoard.SetUnRead(i: Integer);
905 begin
906 if FUnRead = i then Exit;
907 if i < 0 then i := 0;
908 FUnRead := i;
909 if FUpdate then
910 FModified := True;
911 end;
912
913 procedure TBoard.SetKotehanName(s: string);
914 begin
915 if FKotehanName = s then Exit;
916 FKotehanName := s;
917 if FUpdate then
918 FModified := True;
919 end;
920
921 procedure TBoard.SetKotehanMail(s: string);
922 begin
923 if FKotehanMail = s then Exit;
924 FKotehanMail := s;
925 if FUpdate then
926 FModified := True;
927 end;
928
929 function TBoard.GetNewThreadCount: Integer;
930 var
931 i: Integer;
932 begin
933 Result := 0;
934 for i := 0 to Count - 1 do begin
935 if Items[i].NewArrival then
936 inc(Result);
937 end;
938 end;
939
940 function TBoard.GetLogThreadCount: Integer;
941 var
942 i: Integer;
943 begin
944 Result := 0;
945 for i := 0 to Count - 1 do begin
946 if Items[i].IsLogFile then
947 inc(Result);
948 end;
949 end;
950
951 function TBoard.GetUserThreadCount: Integer;
952 var
953 i: Integer;
954 begin
955 Result := 0;
956 for i := 0 to Count - 1 do begin
957 if Items[i].ShortTitle = '' then
958 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
959 if AnsiPos(ParentCategory.ParentBBS2ch.ShortSelectText, Items[i].ShortTitle) <> 0 then
960 inc(Result);
961 end;
962 end;
963
964 function TBoard.GetNewThread(Index: Integer): TThreadItem;
965 var
966 i: Integer;
967 Cnt: Integer;
968 begin
969 Result := nil;
970 Cnt := 0;
971 for i := 0 to Count - 1 do begin
972 if Items[i].NewArrival then begin
973 if Index = Cnt then begin
974 Result := Items[i];
975 Exit;
976 end;
977 inc(Cnt);
978 end;
979 end;
980 end;
981
982 function TBoard.GetLogThread(Index: Integer): TThreadItem;
983 var
984 i: Integer;
985 Cnt: Integer;
986 begin
987 Result := nil;
988 Cnt := 0;
989 for i := 0 to Count - 1 do begin
990 if Items[i].IsLogFile then begin
991 if Index = Cnt then begin
992 Result := Items[i];
993 Exit;
994 end;
995 inc(Cnt);
996 end;
997 end;
998 end;
999
1000 function TBoard.GetUserThread(Index: Integer): TThreadItem;
1001 var
1002 i: Integer;
1003 Cnt: Integer;
1004 begin
1005 Result := nil;
1006 Cnt := 0;
1007 for i := 0 to Count - 1 do begin
1008 if Items[i].ShortTitle = '' then
1009 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1010 if AnsiPos(ParentCategory.ParentBBS2ch.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1011 if Index = Cnt then begin
1012 Result := Items[i];
1013 Exit;
1014 end;
1015 inc(Cnt);
1016 end;
1017 end;
1018 end;
1019
1020 procedure TBoard.BeginUpdate;
1021 begin
1022 FUpdate := False;
1023 end;
1024
1025 procedure TBoard.EndUpdate;
1026 begin
1027 FUpdate := True;
1028 end;
1029
1030 {class function TBoard.GetColumnName(Index: Integer): string;
1031 begin
1032 Result := COLUMN_THREADITEM[Index];
1033 end;
1034
1035 class function TBoard.GetColumnCount: Integer;
1036 begin
1037 Result := Length(COLUMN_THREADITEM);
1038 end;}
1039
1040 //constructor TThreadItem.Create(AOwner: TComponent);
1041 constructor TThreadItem.Create;
1042 begin
1043 FNo := 0;
1044 FFileName := '';
1045 FTitle := '';
1046 FRoundDate := ZERO_DATE;
1047 FLastModified := ZERO_DATE;
1048 FCount := 0;
1049 FAllResCount := 0;
1050 FNewResCount := 0;
1051 FSize := 0;
1052 FRound := False;
1053 FIsLogFile := False;
1054 FParentBoard := nil;
1055 FKokomade := -1;
1056 FNewReceive := 0;
1057 FNewArrival := False;
1058
1059 FUpdate := True;
1060 end;
1061
1062 destructor TThreadItem.Destroy;
1063 begin
1064 inherited;
1065 end;
1066
1067 function TThreadItem.GetDatURL: string;
1068 var
1069 Protocol, Host, Path, Document, Port, Bookmark: string;
1070 begin
1071 Result := ParentBoard.URL
1072 + 'dat/'
1073 + FileName;
1074 if FDownloadHost <> '' then begin
1075 GikoSys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1076 Result := Format('%s://%s%s%s', [Protocol,
1077 FDownloadHost,
1078 Path,
1079 Document]);
1080 end;
1081 // Result := GikoSys.UrlToServer(ParentBoard.URL)
1082 // + 'test/read.cgi/' + ParentBoard.BBSID + '/'
1083 // + ChangeFileExt(FileName, '') + '/?raw='
1084 // + IntToStr(ResNum) + '.' + IntToStr(ResSize);
1085 end;
1086
1087 function TThreadItem.GetDatgzURL: string;
1088 function isOldKako(s: string): Boolean;
1089 begin
1090 Result := False;
1091 if AnsiPos('piza.', s) <> 0 then
1092 Result := True
1093 else if AnsiPos('www.bbspink.', s) <> 0 then
1094 Result := True
1095 else if AnsiPos('tako.', s) <> 0 then
1096 Result := True;
1097 end;
1098 var
1099 Protocol, Host, Path, Document, Port, Bookmark: string;
1100 DatNo: string;
1101 begin
1102 if FDownloadHost = '' then begin
1103 DatNo := ChangeFileExt(FileName, '');
1104 if isOldKako(ParentBoard.URL) then begin
1105 Result := Format('%s%s/%.3s/%s.dat', [ParentBoard.URL, 'kako', DatNo, DatNo]);
1106 end else begin
1107 if Length(DatNo) > 9 then begin
1108 //http://xxx.2ch.net/xxx/kako/9999/99999/999999999.dat.gz
1109 Result := Format('%s%s/%.4s/%.5s/%s.dat.gz', [ParentBoard.URL, 'kako', DatNo, DatNo, DatNo]);
1110 end else begin
1111 //http://xxx.2ch.net/xxx/kako/999/999999999.dat.gz
1112 Result := Format('%s%s/%.3s/%s.dat.gz', [ParentBoard.URL, 'kako', DatNo, DatNo]);
1113 end;
1114 end;
1115 end else begin
1116 Gikosys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1117 DatNo := ChangeFileExt(Document, '');
1118 if isOldKako(DownloadHost) then begin
1119 Result := Format('%s://%s/%s/kako/%.3s/%s.dat', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo]);
1120 end else begin
1121 if Length(DatNo) > 9 then begin
1122 Result := Format('%s://%s/%s/kako/%.4s/%.5s/%s.dat.gz', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo, DatNo]);
1123 end else begin
1124 Result := Format('%s://%s/%s/kako/%.3s/%s.dat.gz', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo]);
1125 end;
1126 end;
1127 end;
1128 end;
1129
1130 {function TThreadItem.GetOldDatgzURL: string;
1131 var
1132 Protocol, Host, Path, Document, Port, Bookmark: string;
1133 begin
1134 Result := Format('%s%s/%.3s/%s.gz', [ParentBoard.URL,
1135 'kako',
1136 FileName,
1137 FileName]);
1138 if FDownloadHost <> '' then begin
1139 ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1140 Result := Format('%s://%s%s%s', [Protocol,
1141 DownloadHost,
1142 Path,
1143 Document]);
1144
1145 end;
1146 end;}
1147
1148 function TThreadItem.GetOfflawCgiURL(SessionID: string): string;
1149 //var
1150 // Protocol, Host, Path, Document, Port, Bookmark: string;
1151 begin
1152 // Result := GikoSys.UrlToServer(ParentBoard.URL)
1153 // + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1154 // + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1155 if FDownloadHost = '' then begin
1156 Result := GikoSys.UrlToServer(ParentBoard.URL)
1157 + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1158 + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1159 end else begin
1160 //http://news.2ch.net/test/offlaw.cgi/newsplus/1014038577/?raw=.196928&sid=
1161 //GikoSys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1162 Result := 'http://' + FDownloadHost
1163 + '/test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1164 + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1165 // Result := Format('%s://%s%s%s', [Protocol,
1166 // DownloadHost,
1167 // Path,
1168 // Document]);
1169 end;
1170 end;
1171
1172 function TThreadItem.GetSendURL: string;
1173 begin
1174 Result := GikoSys.UrlToServer(ParentBoard.URL)
1175 + 'test/bbs.cgi';
1176 end;
1177
1178 procedure TThreadItem.DeleteLogFile;
1179 begin
1180 DeleteFile(GetThreadFileName);
1181
1182 FRoundDate := ZERO_DATE;
1183 FLastModified := ZERO_DATE;
1184 FSize := 0;
1185 FIsLogFile := False;
1186 FKokomade := -1;
1187 FNewReceive := 0;
1188 FNewArrival := False;
1189 FUnRead := False;
1190 FScrollTop := 0;
1191 FRound := False;
1192 FDownloadHost := '';
1193 FAgeSage := gasNone;
1194
1195 FCount := 0;
1196 FNewResCount := 0;
1197 FRoundName := '';
1198 end;
1199
1200 function TThreadItem.GetThreadFileName: string;
1201 begin
1202 Result := ParentBoard.ParentCategory.ParentBBS2ch.GetLogFolder
1203 + ParentBoard.BBSID + PATH_DELIM + FileName;
1204 end;
1205
1206 procedure TThreadItem.SetLastModified(d: TDateTime);
1207 begin
1208 if FLastModified = d then Exit;
1209 FLastModified := d;
1210 if FUpdate and (ParentBoard <> nil) then
1211 ParentBoard.FModified := True;
1212 end;
1213
1214 {procedure TThreadItem.SetRoundNo(i: Integer);
1215 begin
1216 if FRoundNo = i then Exit;
1217 FRoundNo := i;
1218 if FUpdate and (ParentBoard <> nil) then
1219 ParentBoard.FModified := True;
1220 end;}
1221
1222 procedure TThreadItem.SetRound(b: Boolean);
1223 begin
1224 if b then
1225 RoundList.Add(Self)
1226 else
1227 RoundList.Delete(Self);
1228 if FRound = b then Exit;
1229 FRound := b;
1230 if FUpdate and (ParentBoard <> nil) then
1231 ParentBoard.FModified := True;
1232 end;
1233
1234 procedure TThreadItem.SetRoundName(s: string);
1235 begin
1236 if FRoundName = s then Exit;
1237 FRoundName := s;
1238 if FUpdate and (ParentBoard <> nil) then
1239 ParentBoard.FModified := True;
1240 end;
1241
1242 procedure TThreadItem.SetKokomade(i: Integer);
1243 begin
1244 if FKokomade = i then Exit;
1245 FKokomade := i;
1246 if FUpdate and (ParentBoard <> nil) then
1247 ParentBoard.FModified := True;
1248 end;
1249
1250 procedure TThreadItem.SetUnRead(b: Boolean);
1251 begin
1252 if FUnRead = b then Exit;
1253 FUnRead := b;
1254 if FUpdate and (ParentBoard <> nil) then
1255 ParentBoard.FModified := True;
1256 end;
1257
1258 procedure TThreadItem.SetScrollTop(i: Integer);
1259 begin
1260 if FScrollTop = i then Exit;
1261 FScrollTop := i;
1262 if FUpdate and (ParentBoard <> nil) then
1263 ParentBoard.FModified := True;
1264 end;
1265
1266 procedure TThreadItem.BeginUpdate;
1267 begin
1268 FUpdate := False;
1269 end;
1270
1271 procedure TThreadItem.EndUpdate;
1272 begin
1273 FUpdate := True;
1274 end;
1275
1276 {initialization
1277 BBS2ch := TBBS2ch.Create;
1278
1279 finalization
1280 if BBS2ch <> nil then
1281 BBS2ch.Free;}
1282 end.
1283

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