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.32 - (show annotations) (download) (as text)
Sat Feb 21 08:37:10 2004 UTC (20 years, 2 months ago) by h677
Branch: MAIN
Changes since 1.31: +45 -5 lines
File MIME type: text/x-pascal
板の取得日時の文字列におかしな形式がときたまある模様なので、
そのときでもきちんと日時を取得できるように修正

1 unit BoardGroup;
2
3 interface
4
5 uses
6 Windows, SysUtils, Classes, ComCtrls, IniFiles, {HTTPApp,} YofUtils, IdGlobal,
7 ExternalBoardManager, ExternalBoardPlugInMain;
8
9 type
10 //???鴻????;腓冴?≪?ゃ?????御??
11 TGikoViewType = (gvtAll, gvtLog, gvtNew, gvtUser);
12 //???鴻??????篁倶??/span>
13 //TGikoListCount = (glc50, glc100, glc200, glc500, glc1000, glcAll);
14 //綏≦?????/span>
15 //TGikoRoundNo = (grnNone, grn1, grn2, grn3, grn4, grn5, grnOnce);
16 //???鴻???????筝???
17 TGikoAgeSage = (gasNone, gasAge, gasSage, gasNew);
18
19 { TFolder = class
20 private
21 FItemList: TList; //絖??≪?ゃ???????鴻??
22 FLeaf: Boolean; //筝????????????????ゃ???????堺?ャ????
23 public
24 function Add(Item: TFolder): Integer;
25 procedure Clear;
26 procedure Delete(Index: Integer);
27 procedure Exchange(Index1, Index2: Integer);
28 procedure Insert(Index: Integer; Item: TFolder);
29 procedure Move(CurIndex, NewIndex: Integer);
30 function Remove(Item: TFolder): Integer;
31 procedure Sort(Compare: TListSortCompare);
32 property Capacity: Integer read FCapacity write SetCapacity;
33 property Count: Integer read FCount write SetCount;
34 property Items[Index: Integer]: TFolder read Get write Put; default;
35
36 property Leaf: Boolean read FLeaf;
37 end;
38
39 TBBS = class(TFolder)
40 end;
41 TCategory class(TFolder)
42 end;
43 TBoard = class(TFolder)
44 end;
45 TThreadItem = class(TFolder)
46 end;
47 }
48
49 {
50 TBBS = class(TBBS)
51 end;
52 TBoard2ch = class(TBoard)
53 end;
54 TThreadItem2ch = class(TThreadItem)
55 end;
56 }
57
58 // ITest = interface
59 // end;
60 // IBBS = interface
61 // end;
62 // ICategory = interface
63 // end;
64 // IBoard = interface
65 // end;
66 // IThreadItem = interface
67 // end;
68
69 TCategory = class;
70 TBoard = class;
71 TThreadItem = class;
72
73 //??????????鐚??<?????????????若??
74 TBBS = class(TList)
75 private
76 FTitle: string;
77 FLogFolder: string;
78 FExpand: Boolean;
79 FKubetsuChk: Boolean; //腟?莨若?炊??紊ф??絖?絨??絖??阪??/span>
80 FSelectText: string; //腟?莨若?炊??絖???
81 FShortSelectText: string;
82
83 function GetCategory(index: integer): TCategory;
84 procedure SetCategory(index: integer; value: TCategory);
85 procedure SetSelectText(s: string);
86 public
87 constructor Create(LogFolder: string);
88 destructor Destroy; override;
89
90 function Add(item: TCategory): integer;
91 procedure Delete(index: integer);
92 procedure Clear; override;
93 function Find(key: string): TCategory;
94 function FindBBSID(BBSID: string): TBoard;
95 function FindBoardFromTitle(Title: string): TBoard;
96 function FindBoardFromURL(inURL: string): TBoard;
97 function FindThreadFromURL( inURL : string ) : TThreadItem;
98 function FindThreadItem(BBSID: string; FileName: string): TThreadItem;
99 function FindCategoryFromTitle( inTitle : string ) : TCategory;
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 //?????眼??/span>
112 TCategory = class(TList)
113 private
114 FNo: Integer;
115 FTitle: string;
116 FParenTBBS: TBBS;
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 ParenTBBS: TBBS read FParenTBBS write FParenTBBS;
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 FindBoardFromURL(inURL: string): TBoard;
137 function FindThreadFromURL( inURL : string ) : TThreadItem;
138 function IsMidoku: Boolean;
139
140 property NodeExpand: Boolean read FExpand write FExpand;
141 end;
142
143 //??/span>
144 TBoard = class(TList)
145 private
146 FContext: DWORD; // ?????違?ゃ?潟?????宴??┃絎???????????筝祉???ゃ?潟?鴻?帥?潟?鴻???ャ??)
147
148 FNo: Integer; //???/span>
149 FTitle: string; //???若???帥?ゃ????/span>
150 FBBSID: string; //BBSID
151 FURL: string; //???若??URL
152 FRound: Boolean; //?鴻??????筝?荀у掘??篋?膣?
153 FRoundName: string; //綏≦????
154 FRoundDate: TDateTime; //?鴻??????筝?荀с????緇??????ユ??鐚?綏≦???ユ??鐚?
155 FLastModified: TDateTime; //?鴻??????筝?荀с???贋?違???????????ユ??鐚??泣?若???贋?ユ??鐚?
156 FLastGetTime: TDateTime; //?鴻???????障?????鴻??????筝?荀с????緇????贋?違?????ユ??鐚??泣?若???贋?ユ???紙?吾??莨若?炊????戎??????鐚?
157 FIsThreadDatRead: Boolean; //?鴻?????????鴻??????粋昭?障??????????鐚?
158 FUnRead: Integer; //?鴻???????????/span>
159 FParentCategory: TCategory; //荀??????眼??/span>
160 FModified: Boolean; //篆????????/span>
161 FBoolData: Boolean; //??????????????戎??yo
162 FSPID: string; //?吾??莨若?睡??PID
163 FPON: string; //?吾??莨若?睡??ON
164 FKotehanName: string; //?潟????喝????
165 FKotehanMail: string; //?潟????潟?<?若??/span>
166
167 FUpdate: Boolean;
168 FExpand: Boolean;
169
170 FBoardPlugIn : TBoardPlugIn; // ?????帥???泣???若???????????違?ゃ??/span>
171 FFilePath : string; // ?????鴻???荀с??篆?絖???????????????/span>
172 FIsLogFile : Boolean; // ???医?????????/span>
173 FIntData : Integer; // 絅純?????????c??????????????????????戎??yo
174 FListData : TList; // 絅純?????????c??????????????????????戎??yo
175
176 function GetThreadItem(index: integer): TThreadItem;
177 procedure SetThreadItem(index: integer; value: TThreadItem);
178 procedure SetRound(b: Boolean);
179 procedure SetRoundName(s: string);
180 procedure SetLastModified(d: TDateTime);
181 procedure SetLastGetTime(d: TDateTime);
182 procedure SetUnRead(i: Integer);
183 procedure SetKotehanName(s: string);
184 procedure SetKotehanMail(s: string);
185 procedure Init;
186 public
187 constructor Create( inPlugIn : TBoardPlugIn; inURL : string );
188 destructor Destroy; override;
189
190 property Context: DWORD read FContext write FContext;
191
192 property Items[index: integer]: TThreadItem read GetThreadItem write SetThreadItem;
193 property No: Integer read FNo write FNo;
194 property Title: string read FTitle write FTitle;
195 property BBSID: string read FBBSID write FBBSID;
196 property URL: string read FURL write FURL;
197 property Round: Boolean read FRound write SetRound;
198 property RoundName: string read FRoundName write SetRoundName;
199 property RoundDate: TDateTime read FRoundDate write FRoundDate;
200 property LastModified: TDateTime read FLastModified write SetLastModified;
201 property LastGetTime: TDateTime read FLastGetTime write SetLastGetTime;
202 property UnRead: Integer read FUnRead write SetUnRead;
203 property Modified: Boolean read FModified write FModified;
204 property IsThreadDatRead: Boolean read FIsThreadDatRead write FIsThreadDatRead;
205 property ParentCategory: TCategory read FParentCategory write FParentCategory;
206
207 property BoardPlugIn : TBoardPlugIn read FBoardPlugIn;
208 property FilePath : string read FFilePath write FFilePath;
209 property IsLogFile : Boolean read FIsLogFile write FIsLogFile;
210 property IntData : Integer read FIntData write FIntData;
211 property ListData : TList read FListData write FListData;
212 function IsBoardPlugInAvailable : Boolean;
213
214 function Add(item: TThreadItem): integer;
215 procedure Insert(Index: Integer; Item: TThreadItem);
216 procedure Delete(index: integer);
217 procedure DeleteList(index: integer);
218 procedure Clear; override;
219 function Find(ItemFileName: string): TThreadItem;
220 function FindThreadFromURL( inURL : string ) : TThreadItem;
221 function GetIndex(ItemFileName: string): Integer;
222 function GetIndexFromURL(URL: string): Integer;
223 procedure LoadSettings;
224 procedure SaveSettings;
225 function GetReadCgiURL: string;
226 function GetSubjectFileName: string;
227 function GetFolderIndexFileName: string;
228 function GetSendURL: string;
229
230 function GetNewThreadCount: Integer;
231 function GetLogThreadCount: Integer;
232 function GetUserThreadCount: Integer;
233 function GetNewThread(Index: Integer): TThreadItem;
234 function GetLogThread(Index: Integer): TThreadItem;
235 function GetUserThread(Index: Integer): TThreadItem;
236
237 procedure BeginUpdate;
238 procedure EndUpdate;
239 property NodeExpand: Boolean read FExpand write FExpand;
240 property BoolData: Boolean read FBoolData write FBoolData;
241 property SPID: string read FSPID write FSPID;
242 property PON: string read FPON write FPON;
243 property KotehanName: string read FKotehanName write SetKotehanName;
244 property KotehanMail: string read FKotehanMail write SetKotehanMail;
245 end;
246
247 //?鴻??/span>
248 TThreadItem = class(TObject)
249 private
250 FContext: DWORD; // ?????違?ゃ?潟?????宴??┃絎???????????筝祉???ゃ?潟?鴻?帥?潟?鴻???ャ??)
251
252 FNo: Integer; //???/span>
253 FFileName: string; //?鴻?????????<?ゃ????
254 FTitle: string; //?鴻???????帥?ゃ????/span>
255 FShortTitle: string; //?????鴻???????帥?ゃ?????罎?膣∝???
256 FRoundDate: TDateTime; //?鴻??????????緇??????ユ??鐚?綏≦???ユ??鐚?
257 FLastModified: TDateTime; //?鴻?????????贋?違???????????ユ??鐚??泣?若???贋?ユ??鐚?
258 FCount: Integer; //?鴻???????????潟??鐚????若?????
259 FAllResCount: Integer; //?鴻???????????潟??鐚??泣?若??鐚?
260 FNewResCount: Integer; //?鴻???????亥????/span>
261 FSize: Integer; //?鴻???????泣?ゃ??/span>
262 FRound: Boolean; //綏≦????????/span>
263 FRoundName: string; //綏≦????
264 FIsLogFile: Boolean; //???医?????????/span>
265 FParentBoard: TBoard; //荀????若??
266 FKokomade: Integer; //?潟?潟?障?ц????????/span>
267 FNewReceive: Integer; //?潟?潟?????域???篆?/span>
268 FNewArrival: Boolean; //?亥??
269 FUnRead: Boolean; //?????????/span>
270 FScrollTop: Integer; //?鴻?????若???臀?/span>
271 FDownloadHost: string; //篁??????鴻?????????翫???????鴻??
272 FAgeSage: TGikoAgeSage; //?≪?ゃ?????????筝???
273 // FSPID: string; //?吾??莨若?睡??PID
274
275 FUpdate: Boolean;
276 FExpand: Boolean;
277 FURL : string; // ?????鴻???????????吟?ц;腓冴??????? URL
278 FBoardPlugIn : TBoardPlugIn; // ?????鴻?????泣???若???????????違?ゃ??/span>
279 FFilePath : string; // ?????鴻????篆?絖???????????????/span>
280 FSizeByte : Integer; // CreateHTML2 ??絎?茵???????????筝???????????絖?????????/span>
281
282 procedure SetLastModified(d: TDateTime);
283 procedure SetRound(b: Boolean);
284 procedure SetRoundName(s: string);
285 procedure SetKokomade(i: Integer);
286 procedure SetUnRead(b: Boolean);
287 procedure SetScrollTop(i: Integer);
288 procedure Init;
289 public
290 constructor Create( inPlugIn : TBoardPlugIn; inURL : string );
291 destructor Destroy; override;
292
293 function GetDatURL: string;
294 function GetDatgzURL: string;
295 // function GetOldDatgzURL: string;
296 function GetOfflawCgiURL(SessionID: string): string;
297 function GetSendURL: string;
298 procedure DeleteLogFile;
299 function GetThreadFileName: string;
300 procedure BeginUpdate;
301 procedure EndUpdate;
302
303 property Context: DWORD read FContext write FContext;
304
305 property No: Integer read FNo write FNo;
306 property FileName: string read FFileName write FFileName;
307 property Title: string read FTitle write FTitle;
308 property ShortTitle: string read FShortTitle write FShortTitle;
309 property RoundDate: TDateTime read FRoundDate write FRoundDate;
310 property LastModified: TDateTime read FLastModified write SetLastModified;
311 property Count: Integer read FCount write FCount;
312 property AllResCount: Integer read FAllResCount write FAllResCount;
313 property NewResCount: Integer read FNewResCount write FNewResCount;
314 property Size: Integer read FSize write FSize;
315 property Round: Boolean read FRound write SetRound;
316 property RoundName: string read FRoundName write SetRoundName;
317
318 property IsLogFile: Boolean read FIsLogFile write FIsLogFile;
319 property ParentBoard: TBoard read FParentBoard write FParentBoard;
320 property Kokomade: Integer read FKokomade write SetKokomade;
321 property NewReceive: Integer read FNewReceive write FNewReceive;
322 property NewArrival: Boolean read FNewArrival write FNewArrival;
323 property UnRead: Boolean read FUnRead write SetUnRead;
324 property ScrollTop: Integer read FScrollTop write SetScrollTop;
325 property Expand: Boolean read FExpand write FExpand;
326 property DownloadHost: string read FDownloadHost write FDownloadHost;
327 property AgeSage: TGikoAgeSage read FAgeSage write FAgeSage;
328 // property SPID: string read FSPID write FSPID;
329
330 property URL : string read FURL write FURL;
331 property BoardPlugIn : TBoardPlugIn read FBoardPlugIn;
332 property FilePath : string read FFilePath write FFilePath;
333 property SizeByte : Integer read FSizeByte write FSizeByte;
334 function IsBoardPlugInAvailable : Boolean;
335 end;
336
337
338
339 //罎?膣∝??????鴻??
340 { TSearchList = class(TList)
341 private
342 function GetThreadItem(index: integer): TThreadItem;
343 procedure SetThreadItem(index: integer; value: TThreadItem);
344 public
345 constructor Create;
346 destructor Destroy; override;
347
348 property Items[index: integer]: TThreadItem read GetThreadItem write SetThreadItem;
349
350 function Add(item: TThreadItem): integer;
351 procedure Delete(index: integer);
352 procedure Clear; override;
353 end;}
354
355 function BBSsFindBoardFromBBSID( inBBSID : string ) : TBoard;
356 function BBSsFindBoardFromURL( inURL : string ) : TBoard;
357 function BBSsFindBoardFromTitle( inTitle : string ) : TBoard;
358 function BBSsFindThreadFromURL( inURL : string ) : TThreadItem;
359 function ConvertDateTimeString( inDateTimeString : string) : string;
360
361 var
362 BBSs : array of TBBS;
363
364 implementation
365
366 uses
367 GikoSystem, RoundData;
368
369 const
370 BBS2CH_NAME: string = '鐚??<????????';
371 BBS2CH_LOG_FOLDER: string = '2ch';
372 EXTERNAL_LOG_FOLDER: string = 'exboard';
373
374 FOLDER_INI_FILENAME: string = 'Folder.ini';
375 FOLDER_INDEX_FILENAME: string = 'Folder.idx';
376 SUBJECT_FILENAME: string = 'subject.txt';
377 PATH_DELIM: string = '\';
378 //DEFAULT_LIST_COUNT: Integer = 100;
379
380 // COLUMN_CATEGORY: array[0..0] of string = ('?????眼????');
381 // COLUMN_BOARD: array[0..3] of string = ('?水??', '??緇???#39;, '綏≦??篋?膣?', '????綏≦???ユ??');
382 // COLUMN_THREADITEM: array[0..3] of string = ('?鴻????????', '?????潟??', '綏≦??篋?膣?', '????綏≦???ユ??');
383
384 function BBSsFindBoardFromBBSID(
385 inBBSID : string
386 ) : TBoard;
387 var
388 i : Integer;
389 begin
390
391 for i := Length( BBSs ) - 1 downto 0 do begin
392 Result := BBSs[ i ].FindBBSID( inBBSID );
393 if Result <> nil then
394 Exit;
395 end;
396
397 Result := nil;
398
399 end;
400
401 function BBSsFindBoardFromURL(
402 inURL : string
403 ) : TBoard;
404 var
405 i : Integer;
406 begin
407
408 for i := Length( BBSs ) - 1 downto 0 do begin
409 Result := BBSs[ i ].FindBoardFromURL( inURL );
410 if Result <> nil then
411 Exit;
412 end;
413
414 Result := nil;
415
416 end;
417
418 function BBSsFindBoardFromTitle(
419 inTitle : string
420 ) : TBoard;
421 var
422 i : Integer;
423 begin
424
425 for i := Length( BBSs ) - 1 downto 0 do begin
426 Result := BBSs[ i ].FindBoardFromTitle( inTitle );
427 if Result <> nil then
428 Exit;
429 end;
430
431 Result := nil;
432
433 end;
434
435 function BBSsFindThreadFromURL(
436 inURL : string
437 ) : TThreadItem;
438 var
439 board : TBoard;
440 boardURL : string;
441 begin
442
443 boardURL := GikoSys.GetThreadURL2BoardURL( inURL );
444 board := BBSsFindBoardFromURL( boardURL );
445 if board = nil then
446 Result := nil
447 else
448 Result := board.FindThreadFromURL( inURL );
449
450 end;
451
452 (*************************************************************************
453 *罘??遵??鐚?TBBS?潟?潟?鴻????????/span>
454 *Public
455 *************************************************************************)
456 constructor TBBS.Create(LogFolder: string);
457 begin
458 inherited Create;
459 Title := BBS2CH_NAME;
460 FLogFolder := LogFolder;
461 end;
462
463 (*************************************************************************
464 *罘??遵??鐚?TBBS???鴻????????/span>
465 *Public
466 *************************************************************************)
467 destructor TBBS.Destroy;
468 begin
469 Clear;
470 inherited;
471 end;
472
473 (*************************************************************************
474 *罘??遵??鐚?
475 *Public
476 *************************************************************************)
477 function TBBS.GetCategory(index: integer): TCategory;
478 begin
479 Result := TCategory(inherited Items[index]);
480 end;
481
482 procedure TBBS.SetCategory(index: integer; value: TCategory);
483 begin
484 inherited Items[index] := value;
485 end;
486
487 function TBBS.Add(item: TCategory): integer;
488 begin
489 Item.ParenTBBS := self;
490 Result := inherited Add(item);
491 end;
492
493 procedure TBBS.Delete(index: integer);
494 begin
495 if Items[index] <> nil then
496 TCategory(Items[index]).Free;
497 Items[index] := nil;
498 inherited Delete(index);
499 end;
500
501 procedure TBBS.Clear;
502 var
503 i: integer;
504 begin
505 for i := Count - 1 downto 0 do
506 Delete(i);
507 end;
508
509 function TBBS.Find(key: string): TCategory;
510 begin
511 Result := nil;
512 end;
513
514 function TBBS.FindBBSID(BBSID: string): TBoard;
515 var
516 i : Integer;
517 begin
518 for i := Count - 1 downto 0 do begin
519 Result := Items[ i ].FindBBSID(BBSID);
520 if Result <> nil then
521 Exit;
522 end;
523 Result := nil;
524 end;
525
526 //*************************************************************************
527 // ?帥?ゃ????????眼?????帥???≪??
528 //*************************************************************************)
529 function TBBS.FindBoardFromTitle(Title: string): TBoard;
530 var
531 i: Integer;
532 begin
533 for i := Count - 1 downto 0 do begin
534 Result := Items[ i ].FindBoardFromTitle(Title);
535 if Result <> nil then
536 Exit;
537 end;
538 Result := nil;
539 end;
540
541 //*************************************************************************
542 // URL ??????篁??????帥???≪??
543 //*************************************************************************)
544 function TBBS.FindBoardFromURL(inURL: string): TBoard;
545 var
546 i : Integer;
547 begin
548 for i := Count - 1 downto 0 do begin
549 Result := Items[ i ].FindBoardFromURL( inURL );
550 if Result <> nil then
551 Exit;
552 end;
553 Result := nil;
554 end;
555
556 //*************************************************************************
557 // URL ??????篁??????鴻?????????≪??
558 //*************************************************************************)
559 function TBBS.FindThreadFromURL(inURL: string): TThreadItem;
560 var
561 board : TBoard;
562 boardURL : string;
563 begin
564
565 boardURL := GikoSys.GetThreadURL2BoardURL( inURL );
566 board := FindBoardFromURL( boardURL );
567 if board = nil then
568 Result := nil
569 else
570 Result := board.FindThreadFromURL( inURL );
571
572 end;
573
574 function TBBS.FindThreadItem(BBSID: string; FileName: string): TThreadItem;
575 var
576 Board: TBoard;
577 begin
578 Result := nil;
579 Board := FindBBSID(BBSID);
580 if Board = nil then
581 Exit;
582 Result := Board.Find(FileName);
583 end;
584
585 function TBBS.FindCategoryFromTitle( inTitle : string ) : TCategory;
586 var
587 i : Integer;
588 begin
589
590 for i := Count - 1 downto 0 do begin
591 if AnsiCompareStr(Items[ i ].Title, inTitle) = 0 then begin
592 Result := Items[ i ];
593 Exit;
594 end;
595 end;
596
597 Result := nil;
598
599 end;
600
601 (*************************************************************************
602 *???違??????????緇?
603 *
604 *************************************************************************)
605 function TBBS.GetLogFolder: string;
606 begin
607 Result := IncludeTrailingPathDelimiter(FLogFolder)
608 + BBS2CH_LOG_FOLDER + PATH_DELIM;
609 end;
610
611 procedure TBBS.SetSelectText(s: string);
612 begin
613 FSelectText := s;
614 ShortSelectText := GikoSys.ZenToHan(s);
615 end;
616
617 {class function TBBS.GetColumnName(Index: Integer): string;
618 begin
619 Result := COLUMN_CATEGORY[Index];
620 end;
621
622 class function TBBS.GetColumnCount: Integer;
623 begin
624 Result := Length(COLUMN_CATEGORY);
625 end;}
626
627 //===================
628 //TCategory
629 //===================
630 constructor TCategory.Create;
631 begin
632 inherited;
633 end;
634
635 destructor TCategory.Destroy;
636 begin
637 Clear;
638 inherited;
639 end;
640
641 function TCategory.GetBoard(index: integer): TBoard;
642 begin
643 Result := TBoard(inherited Items[index]);
644 end;
645
646 procedure TCategory.SetBoard(index: integer; value: TBoard);
647 begin
648 inherited Items[index] := value;
649 end;
650
651 function TCategory.Add(item: TBoard): integer;
652 begin
653 Item.ParentCategory := self;
654 Result := inherited Add(item);
655 end;
656
657 procedure TCategory.Delete(index: integer);
658 begin
659 if Items[index] <> nil then
660 TBoard(Items[index]).Free;
661 Items[index] := nil;
662 inherited Delete(index);
663 end;
664
665 procedure TCategory.Clear;
666 var
667 i: integer;
668 begin
669 for i := Count - 1 downto 0 do
670 Delete(i);
671 end;
672
673 function TCategory.FindName(key: string): TBoard;
674 begin
675 Result := nil;
676 end;
677
678 function TCategory.FindBBSID(BBSID: string): TBoard;
679 var
680 i : integer;
681 begin
682 for i := Count - 1 downto 0 do begin
683 if AnsiCompareStr(Items[i].FBBSID, BBSID) = 0 then begin
684 Result := Items[i];
685 Exit;
686 end;
687 end;
688 Result := nil;
689 end;
690
691 //*************************************************************************
692 // ?帥?ゃ????????眼?????帥???≪??
693 //*************************************************************************)
694 function TCategory.FindBoardFromTitle(Title: string): TBoard;
695 var
696 i : integer;
697 begin
698 for i := Count - 1 downto 0 do begin
699 if AnsiCompareStr(Items[i].FTitle, Title) = 0 then begin
700 Result := Items[i];
701 Exit;
702 end;
703 end;
704 Result := nil;
705 end;
706
707 //*************************************************************************
708 // URL ??????篁??????帥???≪??
709 //*************************************************************************)
710 function TCategory.FindBoardFromURL(inURL: string): TBoard;
711 var
712 i : Integer;
713 begin
714 for i := Count - 1 downto 0 do begin
715 if Pos( Items[i].URL, inURL ) = 1 then begin
716 Result := Items[i];
717 Exit;
718 end;
719 end;
720 Result := nil;
721 end;
722
723 //*************************************************************************
724 // URL ??????篁??????鴻?????????≪??
725 //*************************************************************************)
726 function TCategory.FindThreadFromURL(inURL: string): TThreadItem;
727 var
728 board : TBoard;
729 boardURL : string;
730 begin
731
732 boardURL := GikoSys.GetThreadURL2BoardURL( inURL );
733 board := FindBoardFromURL( boardURL );
734 if board = nil then
735 Result := nil
736 else
737 Result := board.FindThreadFromURL( inURL );
738
739 end;
740
741 function TCategory.IsMidoku: Boolean;
742 var
743 i: Integer;
744 j: Integer;
745 begin
746 Result := False;
747 for i := 0 to Count - 1 do begin
748 if Items[i] <> nil then begin
749 for j := 0 to Items[i].Count - 1 do begin
750 if Items[i].Items[j] <> nil then begin
751 // if (Items[i].Items[j].IsLogFile) and (Items[i].Items[j].Count > Items[i].Items[j].Kokomade) then begin
752 if (Items[i].Items[j].IsLogFile) and (Items[i].Items[j].UnRead) then begin
753 Result := True;
754 Exit;
755 end;
756 end;
757 end;
758 end;
759 end;
760 end;
761
762 {class function TCategory.GetColumnName(Index: Integer): string;
763 begin
764 Result := COLUMN_BOARD[Index];
765 end;
766
767 class function TCategory.GetColumnCount: Integer;
768 begin
769 Result := Length(COLUMN_BOARD);
770 end;}
771
772 //===================
773 //TBoard
774 //===================
775 procedure TBoard.Init;
776 begin
777 FNo := 0;
778 FTitle := '';
779 FBBSID := '';
780 FURL := '';
781 FRound := False;
782 FRoundDate := ZERO_DATE;
783 FLastModified := ZERO_DATE;
784 FLastGetTime := ZERO_DATE;
785 FIsThreadDatRead := False;
786 FUnRead := 0;
787 // FListStyle := vsReport;
788 // FItemNoVisible := True;
789
790 FUpdate := True;
791 end;
792
793 // *************************************************************************
794 // 紊????帥?????違?ゃ?潟????絎??????潟?潟?鴻????????/span>
795 // *************************************************************************
796 constructor TBoard.Create(
797 inPlugIn : TBoardPlugIn;
798 inURL : string
799 );
800 var
801 protocol, host, path, document, port, bookmark : string;
802 begin
803
804 inherited Create;
805 Init;
806
807 FBoardPlugIn := inPlugIn;
808 URL := inURL;
809 BBSID := GikoSys.UrlToID( inURL );
810
811 if inPlugIn = nil then begin
812 // subject.txt ???絖????鴻??荐??
813 GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
814 if GikoSys.Is2chHost( host ) then
815 FilePath :=
816 IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +
817 BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME
818 else
819 FilePath :=
820 IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +
821 EXTERNAL_LOG_FOLDER + PATH_DELIM + host + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME
822 end else begin
823 // ?????違?ゃ?潟? TBoardItem ??篏???????????????篌?????
824 inPlugIn.CreateBoardItem( DWORD( Self ) );
825 end;
826
827 end;
828
829 // *************************************************************************
830 // ???鴻????????/span>
831 // *************************************************************************
832 destructor TBoard.Destroy;
833 begin
834 if FModified then begin
835 GikoSys.WriteThreadDat(Self);
836 SaveSettings;
837 end;
838
839 // ?????違?ゃ?潟? TBoardItem ???贋?????????????篌?????
840 if IsBoardPlugInAvailable then
841 BoardPlugIn.DisposeBoardItem( DWORD( Self ) );
842
843 Clear;
844 inherited;
845 end;
846
847 // *************************************************************************
848 // 紊????帥?????違?ゃ?潟??篏睡????純??
849 // *************************************************************************
850 function TBoard.IsBoardPlugInAvailable : Boolean;
851 begin
852
853 repeat
854 if BoardPlugIn = nil then
855 Break;
856
857 if not Assigned( Pointer( BoardPlugIn.Module ) ) then
858 Break;
859
860 Result := True;
861 Exit;
862 until True;
863
864 Result := False;
865
866 end;
867
868 function TBoard.GetThreadItem(index: integer): TThreadItem;
869 begin
870 Result := TThreadItem(inherited Items[index]);
871 end;
872
873 procedure TBoard.SetThreadItem(index: integer; value: TThreadItem);
874 begin
875 inherited Items[index] := value;
876 end;
877
878 function TBoard.Add(Item: TThreadItem): Integer;
879 begin
880 Item.ParentBoard := Self;
881 Result := inherited Add(Item);
882 end;
883
884 procedure TBoard.Insert(Index: Integer; Item: TThreadItem);
885 begin
886 Item.ParentBoard := Self;
887 inherited Insert(Index, Item);
888 end;
889
890 //Index?ф??絎????????鴻???????????吾?с???????贋?
891 procedure TBoard.Delete(index: Integer);
892 begin
893 if Items[index] <> nil then
894 TThreadItem(Items[index]).Free;
895 Items[index] := nil;
896 inherited Delete(index);
897 end;
898
899 //Index?ф??絎????????鴻???????????鴻?????????わ??鴻???????吾?с????????????鐚?
900 procedure TBoard.DeleteList(index: integer);
901 begin
902 inherited Delete(index);
903 end;
904
905 procedure TBoard.Clear;
906 var
907 i: integer;
908 begin
909 // FUnRead := 0;
910 for i := Count - 1 downto 0 do
911 Delete(i);
912 end;
913
914 function TBoard.Find(ItemFileName: string): TThreadItem;
915 var
916 i: integer;
917 begin
918 Result := nil;
919 for i := 0 to Count - 1 do begin
920 if AnsiCompareStr(Items[i].FileName, ItemFileName) = 0 then begin
921 Result := Items[i];
922 Exit;
923 end;
924 end;
925 end;
926
927 function TBoard.GetIndex(ItemFileName: string): Integer;
928 var
929 i: integer;
930 begin
931 Result := -1;
932 for i := 0 to Count - 1 do begin
933 if Items[i].FileName = ItemFileName then begin
934 Result := i;
935 Exit;
936 end;
937 end;
938 end;
939
940 function TBoard.GetIndexFromURL(URL: string): Integer;
941 var
942 i: integer;
943 begin
944 Result := -1;
945 for i := 0 to Count - 1 do begin
946 if Pos( URL, Items[ i ].URL ) = 1 then begin
947 Result := i;
948 Exit;
949 end;
950 end;
951 end;
952
953 function TBoard.FindThreadFromURL( inURL : string ) : TThreadItem;
954 var
955 i : Integer;
956 begin
957
958 if not IsThreadDatRead then
959 GikoSys.ReadSubjectFile( Self );
960
961 for i := Count - 1 downto 0 do begin
962 if Pos( inURL, Items[ i ].URL ) = 1 then begin
963 Result := Items[ i ];
964 Exit;
965 end;
966 end;
967 Result := nil;
968
969 end;
970
971 {function TBoard.GetMidokuCount: Integer;
972 var
973 i: integer;
974 begin
975 Result := 0;
976 for i := 0 to Count- 1 do begin
977 if Items[i] <> nil then begin
978 if (Items[i].IsLogFile) and (Items[i].Count > Items[i].Kokomade) then
979 inc(Result);
980 end;
981 end;
982 end;
983 }
984
985 procedure TBoard.LoadSettings;
986 var
987 ini: TMemIniFile;
988 FileName: string;
989 tmp: string;
990 begin
991 if Length( FilePath ) > 0 then
992 FileName := ExtractFilePath( FilePath ) + FOLDER_INI_FILENAME
993 else
994 FileName := ParentCategory.ParenTBBS.GetLogFolder
995 + BBSID + PATH_DELIM + FOLDER_INI_FILENAME;
996
997 if not FileExists(FileName) then
998 Exit;
999 ini := TMemIniFile.Create(FileName);
1000 try
1001 // Round := ini.ReadBool('Status', 'Round', False);
1002 tmp := ini.ReadString('Status', 'RoundDate', DateTimeToStr(ZERO_DATE));
1003 FRoundDate := StrToDateTime(ConvertDateTimeString(tmp));
1004 tmp := ini.ReadString('Status', 'LastModified', DateTimeToStr(ZERO_DATE));
1005 FLastModified := StrToDateTime(ConvertDateTimeString(tmp));
1006 tmp := ini.ReadString('Status', 'LastGetTime', DateTimeToStr(ZERO_DATE));
1007 FLastGetTime := StrToDateTime(ConvertDateTimeString(tmp));
1008
1009 {
1010 try
1011 FRoundDate := ini.ReadDateTime('Status', 'RoundDate', ZERO_DATE);
1012 except
1013 tmp := ini.ReadString('Status', 'RoundDate', DateTimeToStr(ZERO_DATE));
1014 FRoundDate := StrToDateTime(ConvertDateTimeString(tmp));
1015 end;
1016 try
1017 FLastModified := ini.ReadDateTime('Status', 'LastModified', ZERO_DATE);
1018 except
1019 tmp := ini.ReadString('Status', 'LastModified', DateTimeToStr(ZERO_DATE));
1020 FLastModified := StrToDateTime(ConvertDateTimeString(tmp));
1021 end;
1022 try
1023 FLastGetTime := ini.ReadDateTime('Status', 'LastGetTime', ZERO_DATE);
1024 except
1025 tmp := ini.ReadString('Status', 'LastGetTime', DateTimeToStr(ZERO_DATE));
1026 FLastGetTime := StrToDateTime(ConvertDateTimeString(tmp));
1027 end;
1028 }
1029 FUnRead := ini.ReadInteger('Status', 'UnRead', 0);
1030 FSPID := ini.ReadString('Cookie', 'SPID', '');
1031 FPON := ini.ReadString('Cookie', 'PON', '');
1032 FKotehanName := ini.ReadString('Kotehan', 'Name', '');
1033 FKotehanMail := ini.ReadString('Kotehan', 'Mail', '');
1034 // ListStyle := TViewStyle(Ord(ini.ReadInteger('Status', 'ListStyle', 3)));
1035 // ItemNoVisible := ini.ReadBool('Status', 'ItemNoVisible', True);
1036 // ViewType := TGikoViewType(Ord(ini.ReadInteger('Status', 'ViewType', 0)));
1037 if UnRead < 0 then
1038 UnRead := 0;
1039 finally
1040 ini.Free;
1041 end;
1042 end;
1043
1044 procedure TBoard.SaveSettings;
1045 var
1046 ini: TMemIniFile;
1047 FileName: string;
1048 begin
1049 if Length( FilePath ) > 0 then
1050 FileName := ExtractFilePath( FilePath )
1051 else
1052 FileName := ParentCategory.ParenTBBS.GetLogFolder
1053 + BBSID + PATH_DELIM;
1054 if not GikoSys.DirectoryExistsEx(FileName) then
1055 GikoSys.ForceDirectoriesEx(FileName);
1056 FileName := FileName + FOLDER_INI_FILENAME;
1057 ini := TMemIniFile.Create(FileName);
1058 try
1059 if UnRead < 0 then
1060 UnRead := 0;
1061 // ini.WriteBool('Status', 'Round', Round);
1062 ini.WriteDateTime('Status', 'RoundDate', FRoundDate);
1063 ini.WriteDateTime('Status', 'LastModified', FLastModified);
1064 ini.WriteDateTime('Status', 'LastGetTime', FLastGetTime);
1065 ini.WriteInteger('Status', 'UnRead', FUnRead);
1066 ini.WriteString('Cookie', 'SPID', FSPID);
1067 ini.WriteString('Cookie', 'PON', FPON);
1068 ini.WriteString('Kotehan', 'Name', FKotehanName);
1069 ini.WriteString('Kotehan', 'Mail', FKotehanMail);
1070 // ini.WriteInteger('Status', 'ListStyle', Ord(ListStyle));
1071 // ini.WriteBool('Status', 'ItemNoVisible', ItemNoVisible);
1072 // ini.WriteInteger('Status', 'ViewType', Ord(ViewType));
1073 ini.UpdateFile;
1074 finally
1075 ini.Free;
1076 end;
1077 end;
1078 //????????003 02 08 0:32:13??????就綣???ヤ??????????с??????
1079 // 2003/02/08 0:32:13?????????
1080 function ConvertDateTimeString( inDateTimeString : string) : string;
1081 var
1082 i : Integer;
1083 begin
1084 if ( AnsiPos('/', inDateTimeString ) = 0 ) and
1085 ( AnsiCompareStr( DateTimeToStr(ZERO_DATE), inDateTimeString) <> 0 ) then begin
1086 for i := 0 to 1 do begin
1087 Insert('/',inDateTimeString, AnsiPos(' ', inDateTimeString) + 1 );
1088 Delete(inDateTimeString, AnsiPos(' ', inDateTimeString), 1);
1089 end;
1090 end;
1091 Result := inDateTimeString;
1092 end;
1093 // ?泣???吾?с????URL??緇?
1094 function TBoard.GetReadCgiURL: string;
1095 begin
1096 //Result := URL + SUBJECT_FILENAME;
1097 //Result := GikoSys.UrlToServer(URL)
1098 // + 'test/read.cgi/' + BBSID + '/?raw=0.0';
1099 Result := URL + SUBJECT_FILENAME;
1100
1101 end;
1102
1103 // ?泣???吾?с???????<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
1104 function TBoard.GetSubjectFileName: string;
1105 begin
1106 if Length( FilePath ) > 0 then
1107 Result := FilePath
1108 else
1109 Result := ParentCategory.ParenTBBS.GetLogFolder
1110 + BBSID + PATH_DELIM + SUBJECT_FILENAME;
1111 end;
1112
1113 // ?ゃ?潟???????鴻???<?ゃ????(folder.idx)??緇?鐚????刻????<?ゃ????鐚?
1114 function TBoard.GetFolderIndexFileName: string;
1115 begin
1116 if Length( FilePath ) > 0 then
1117 Result := ExtractFilePath( FilePath ) + FOLDER_INDEX_FILENAME
1118 else
1119 Result := ParentCategory.ParenTBBS.GetLogFolder
1120 + BBSID + PATH_DELIM + FOLDER_INDEX_FILENAME;
1121 end;
1122
1123 // ?鴻???????篆?RL
1124 function TBoard.GetSendURL: string;
1125 begin
1126 Result := GikoSys.UrlToServer(URL) + 'test/subbbs.cgi';
1127 end;
1128
1129 procedure TBoard.SetRound(b: Boolean);
1130 begin
1131 if b then
1132 RoundList.Add(Self)
1133 else
1134 RoundList.Delete(Self);
1135 if FRound = b then Exit;
1136 FRound := b;
1137 if FUpdate then
1138 FModified := True;
1139 end;
1140
1141 procedure TBoard.SetRoundName(s: string);
1142 begin
1143 if FRoundName = s then Exit;
1144 FRoundName := s;
1145 if FUpdate then
1146 FModified := True;
1147 end;
1148
1149 procedure TBoard.SetLastModified(d: TDateTime);
1150 begin
1151 if FLastModified = d then Exit;
1152 FLastModified := d;
1153 if FUpdate then
1154 FModified := True;
1155 end;
1156
1157 procedure TBoard.SetLastGetTime(d: TDateTime);
1158 begin
1159 if FLastGetTime = d then Exit;
1160 FLastGetTime := d;
1161 if FUpdate then
1162 FModified := True;
1163 end;
1164
1165 procedure TBoard.SetUnRead(i: Integer);
1166 begin
1167 if FUnRead = i then Exit;
1168 if i < 0 then i := 0;
1169 FUnRead := i;
1170 if FUpdate then
1171 FModified := True;
1172 end;
1173
1174 procedure TBoard.SetKotehanName(s: string);
1175 begin
1176 if FKotehanName = s then Exit;
1177 FKotehanName := s;
1178 if FUpdate then
1179 FModified := True;
1180 end;
1181
1182 procedure TBoard.SetKotehanMail(s: string);
1183 begin
1184 if FKotehanMail = s then Exit;
1185 FKotehanMail := s;
1186 if FUpdate then
1187 FModified := True;
1188 end;
1189
1190 function TBoard.GetNewThreadCount: Integer;
1191 var
1192 i: Integer;
1193 begin
1194 Result := 0;
1195 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1196 begin
1197 for i := 0 to Count - 1 do begin
1198 if Items[i].NewArrival then
1199 inc(Result);
1200 end;
1201 end else begin
1202 for i := 0 to Count - 1 do begin
1203 if Items[i].NewArrival then
1204 begin
1205 if Items[i].ShortTitle = '' then
1206 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1207 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1208 inc(Result);
1209 end;
1210 end;
1211 end;
1212 end;
1213
1214 function TBoard.GetLogThreadCount: Integer;
1215 var
1216 i: Integer;
1217 begin
1218 Result := 0;
1219 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1220 begin
1221 for i := 0 to Count - 1 do begin
1222 if Items[i].IsLogFile then
1223 inc(Result);
1224 end;
1225 end else begin
1226 for i := 0 to Count - 1 do begin
1227 if Items[i].IsLogFile then
1228 begin
1229 if Items[i].ShortTitle = '' then
1230 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1231 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1232 inc(Result);
1233 end;
1234 end;
1235 end;
1236 end;
1237
1238 function TBoard.GetUserThreadCount: Integer;
1239 var
1240 i: Integer;
1241 begin
1242 Result := 0;
1243 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1244 Result := Count
1245 else
1246 for i := 0 to Count - 1 do begin
1247 if Items[i].ShortTitle = '' then
1248 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1249 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1250 inc(Result);
1251 end;
1252 end;
1253
1254 function TBoard.GetNewThread(Index: Integer): TThreadItem;
1255 var
1256 i: Integer;
1257 Cnt: Integer;
1258 begin
1259 Result := nil;
1260 Cnt := 0;
1261 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1262 begin
1263 for i := 0 to Count - 1 do begin
1264 if Items[i].NewArrival then
1265 begin
1266 if Index = Cnt then begin
1267 Result := Items[i];
1268 Exit;
1269 end;
1270 inc(Cnt);
1271 end;
1272 end;
1273 end else begin
1274 for i := 0 to Count - 1 do begin
1275 if Items[i].NewArrival then
1276 begin
1277 if Items[i].ShortTitle = '' then
1278 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1279 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1280 if Index = Cnt then begin
1281 Result := Items[i];
1282 Exit;
1283 end;
1284 inc(Cnt);
1285 end;
1286 end;
1287 end;
1288 end;
1289 end;
1290
1291 function TBoard.GetLogThread(Index: Integer): TThreadItem;
1292 var
1293 i: Integer;
1294 Cnt: Integer;
1295 begin
1296 Cnt := 0;
1297 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1298 begin
1299 for i := 0 to Count - 1 do begin
1300 if Items[i].IsLogFile then
1301 begin
1302 if Index = Cnt then begin
1303 Result := Items[i];
1304 Exit;
1305 end;
1306 inc(Cnt);
1307 end;
1308 end;
1309 end else begin
1310 for i := 0 to Count - 1 do begin
1311 if Items[i].IsLogFile then
1312 begin
1313 if Items[i].ShortTitle = '' then
1314 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1315 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1316 if Index = Cnt then begin
1317 Result := Items[i];
1318 Exit;
1319 end;
1320 inc(Cnt);
1321 end;
1322 end;
1323 end;
1324 end;
1325 Result := nil;
1326 end;
1327
1328 function TBoard.GetUserThread(Index: Integer): TThreadItem;
1329 var
1330 i: Integer;
1331 Cnt: Integer;
1332 begin
1333 Result := nil;
1334 Cnt := 0;
1335 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1336 begin
1337 for i := 0 to Count - 1 do begin
1338 if Index = Cnt then
1339 begin
1340 Result := Items[ i ];
1341 Exit;
1342 end;
1343 inc( Cnt );
1344 end;
1345 end else begin
1346 for i := 0 to Count - 1 do begin
1347 if Items[i].ShortTitle = '' then
1348 Items[i].ShortTitle := GikoSys.ZenToHan(Items[i].Title);
1349 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1350 if Index = Cnt then begin
1351 Result := Items[i];
1352 Exit;
1353 end;
1354 inc(Cnt);
1355 end;
1356 end;
1357 end;
1358 end;
1359
1360 procedure TBoard.BeginUpdate;
1361 begin
1362 FUpdate := False;
1363 end;
1364
1365 procedure TBoard.EndUpdate;
1366 begin
1367 FUpdate := True;
1368 end;
1369
1370 {class function TBoard.GetColumnName(Index: Integer): string;
1371 begin
1372 Result := COLUMN_THREADITEM[Index];
1373 end;
1374
1375 class function TBoard.GetColumnCount: Integer;
1376 begin
1377 Result := Length(COLUMN_THREADITEM);
1378 end;}
1379
1380 //constructor TThreadItem.Create(AOwner: TComponent);
1381 procedure TThreadItem.Init;
1382 begin
1383 FNo := 0;
1384 FFileName := '';
1385 FTitle := '';
1386 FRoundDate := ZERO_DATE;
1387 FLastModified := ZERO_DATE;
1388 FCount := 0;
1389 FAllResCount := 0;
1390 FNewResCount := 0;
1391 FSize := 0;
1392 FRound := False;
1393 FIsLogFile := False;
1394 FParentBoard := nil;
1395 FKokomade := -1;
1396 FNewReceive := 0;
1397 FNewArrival := False;
1398
1399 FUpdate := True;
1400 FURL := '';
1401 FBoardPlugIn := nil;
1402 end;
1403
1404 // *************************************************************************
1405 // 紊????帥?????違?ゃ?潟????絎??????潟?潟?鴻????????/span>
1406 // *************************************************************************
1407 constructor TThreadItem.Create(
1408 inPlugIn : TBoardPlugIn;
1409 inURL : string
1410 );
1411 var
1412 foundPos : Integer;
1413 protocol, host, path, document, port, bookmark : string;
1414 BBSID, BBSKey : string;
1415 const
1416 READ_PATH = '/test/read.cgi';
1417 begin
1418
1419 inherited Create;
1420 Init;
1421
1422 FBoardPlugIn := inPlugIn;
1423 URL := inURL;
1424
1425 if inPlugIn = nil then begin
1426 foundPos := Pos( READ_PATH, inURL );
1427 if foundPos > 0 then begin
1428 // dat ???絖????鴻??荐??
1429 GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
1430 GikoSys.Parse2chURL( inURL, path, document, BBSID, BBSKey );
1431 if GikoSys.Is2chHost( host ) then
1432 FilePath :=
1433 IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +
1434 BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + BBSKey + '.dat'
1435 else
1436 FilePath :=
1437 IncludeTrailingPathDelimiter( GikoSys.Setting.LogFolder ) +
1438 EXTERNAL_LOG_FOLDER + PATH_DELIM + host + PATH_DELIM + BBSID + PATH_DELIM + BBSKey + '.dat';
1439 FileName := BBSKey + '.dat';
1440 IsLogFile := FileExists( FilePath );
1441 URL := GikoSys.Get2chBrowsableThreadURL( inURL );
1442 end;
1443 end else begin
1444 // ?????違?ゃ?潟? TThreadItem ??篏???????????????篌?????
1445 inPlugIn.CreateThreadItem( DWORD( Self ) );
1446 end;
1447
1448 end;
1449
1450 // *************************************************************************
1451 // ???鴻????????/span>
1452 // *************************************************************************
1453 destructor TThreadItem.Destroy;
1454 begin
1455
1456 // ?????違?ゃ?潟? TThreadItem ???贋?????????????篌?????
1457 if IsBoardPlugInAvailable then
1458 FBoardPlugIn.DisposeThreadItem( DWORD( Self ) );
1459
1460 inherited;
1461
1462 end;
1463
1464 // *************************************************************************
1465 // 紊????帥?????違?ゃ?潟??篏睡????純??
1466 // *************************************************************************
1467 function TThreadItem.IsBoardPlugInAvailable : Boolean;
1468 begin
1469
1470 repeat
1471 if BoardPlugIn = nil then
1472 Break;
1473
1474 if not Assigned( Pointer( BoardPlugIn.Module ) ) then
1475 Break;
1476
1477 Result := True;
1478 Exit;
1479 until True;
1480
1481 Result := False;
1482
1483 end;
1484
1485 function TThreadItem.GetDatURL: string;
1486 var
1487 Protocol, Host, Path, Document, Port, Bookmark: string;
1488 begin
1489 Result := ParentBoard.URL
1490 + 'dat/'
1491 + FileName;
1492 if FDownloadHost <> '' then begin
1493 GikoSys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1494 Result := Format('%s://%s%s%s', [Protocol,
1495 FDownloadHost,
1496 Path,
1497 Document]);
1498 end;
1499 // Result := GikoSys.UrlToServer(ParentBoard.URL)
1500 // + 'test/read.cgi/' + ParentBoard.BBSID + '/'
1501 // + ChangeFileExt(FileName, '') + '/?raw='
1502 // + IntToStr(ResNum) + '.' + IntToStr(ResSize);
1503 end;
1504
1505 function TThreadItem.GetDatgzURL: string;
1506 function isOldKako(s: string): Boolean;
1507 begin
1508 Result := False;
1509 if AnsiPos('piza.', s) <> 0 then
1510 Result := True
1511 else if AnsiPos('www.bbspink.', s) <> 0 then
1512 Result := True
1513 else if AnsiPos('tako.', s) <> 0 then
1514 Result := True;
1515 end;
1516 var
1517 Protocol, Host, Path, Document, Port, Bookmark: string;
1518 DatNo: string;
1519 begin
1520 if FDownloadHost = '' then begin
1521 DatNo := ChangeFileExt(FileName, '');
1522 if isOldKako(ParentBoard.URL) then begin
1523 Result := Format('%s%s/%.3s/%s.dat', [ParentBoard.URL, 'kako', DatNo, DatNo]);
1524 end else begin
1525 if Length(DatNo) > 9 then begin
1526 //http://xxx.2ch.net/xxx/kako/9999/99999/999999999.dat.gz
1527 Result := Format('%s%s/%.4s/%.5s/%s.dat.gz', [ParentBoard.URL, 'kako', DatNo, DatNo, DatNo]);
1528 end else begin
1529 //http://xxx.2ch.net/xxx/kako/999/999999999.dat.gz
1530 Result := Format('%s%s/%.3s/%s.dat.gz', [ParentBoard.URL, 'kako', DatNo, DatNo]);
1531 end;
1532 end;
1533 end else begin
1534 Gikosys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1535 DatNo := ChangeFileExt(Document, '');
1536 if isOldKako(DownloadHost) then begin
1537 Result := Format('%s://%s/%s/kako/%.3s/%s.dat', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo]);
1538 end else begin
1539 if Length(DatNo) > 9 then begin
1540 Result := Format('%s://%s/%s/kako/%.4s/%.5s/%s.dat.gz', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo, DatNo]);
1541 end else begin
1542 Result := Format('%s://%s/%s/kako/%.3s/%s.dat.gz', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo]);
1543 end;
1544 end;
1545 end;
1546 end;
1547
1548 {function TThreadItem.GetOldDatgzURL: string;
1549 var
1550 Protocol, Host, Path, Document, Port, Bookmark: string;
1551 begin
1552 Result := Format('%s%s/%.3s/%s.gz', [ParentBoard.URL,
1553 'kako',
1554 FileName,
1555 FileName]);
1556 if FDownloadHost <> '' then begin
1557 ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1558 Result := Format('%s://%s%s%s', [Protocol,
1559 DownloadHost,
1560 Path,
1561 Document]);
1562
1563 end;
1564 end;}
1565
1566 function TThreadItem.GetOfflawCgiURL(SessionID: string): string;
1567 //var
1568 // Protocol, Host, Path, Document, Port, Bookmark: string;
1569 begin
1570 // Result := GikoSys.UrlToServer(ParentBoard.URL)
1571 // + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1572 // + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1573 if FDownloadHost = '' then begin
1574 Result := GikoSys.UrlToServer(ParentBoard.URL)
1575 + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1576 + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1577 end else begin
1578 //http://news.2ch.net/test/offlaw.cgi/newsplus/1014038577/?raw=.196928&sid=
1579 //GikoSys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1580 Result := 'http://' + FDownloadHost
1581 + '/test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1582 + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1583 // Result := Format('%s://%s%s%s', [Protocol,
1584 // DownloadHost,
1585 // Path,
1586 // Document]);
1587 end;
1588 end;
1589
1590 function TThreadItem.GetSendURL: string;
1591 begin
1592 Result := GikoSys.UrlToServer(ParentBoard.URL)
1593 + 'test/bbs.cgi';
1594 end;
1595
1596 procedure TThreadItem.DeleteLogFile;
1597 begin
1598 ParentBoard.BeginUpdate;
1599
1600 DeleteFile(GetThreadFileName);
1601 if FileExists(ChangeFileExt(GetThreadFileName,'.NG')) = true then
1602 DeleteFile(ChangeFileExt(GetThreadFileName,'.NG'));
1603 FRoundDate := ZERO_DATE;
1604 FLastModified := ZERO_DATE;
1605 FSize := 0;
1606 FIsLogFile := False;
1607 FKokomade := -1;
1608 FNewReceive := 0;
1609 FNewArrival := False;
1610 FUnRead := False;
1611 FScrollTop := 0;
1612 FRound := False;
1613 FDownloadHost := '';
1614 FAgeSage := gasNone;
1615
1616 FCount := 0;
1617 FNewResCount := 0;
1618 FRoundName := '';
1619
1620 ParentBoard.EndUpdate;
1621 ParentBoard.Modified := True;
1622 end;
1623
1624 function TThreadItem.GetThreadFileName: string;
1625 begin
1626 if Length( FilePath ) > 0 then
1627 Result := FilePath
1628 else
1629 Result := ParentBoard.ParentCategory.ParenTBBS.GetLogFolder
1630 + ParentBoard.BBSID + PATH_DELIM + FileName;
1631 end;
1632
1633 procedure TThreadItem.SetLastModified(d: TDateTime);
1634 begin
1635 if FLastModified = d then Exit;
1636 FLastModified := d;
1637 if FUpdate and (ParentBoard <> nil) then
1638 ParentBoard.FModified := True;
1639 end;
1640
1641 {procedure TThreadItem.SetRoundNo(i: Integer);
1642 begin
1643 if FRoundNo = i then Exit;
1644 FRoundNo := i;
1645 if FUpdate and (ParentBoard <> nil) then
1646 ParentBoard.FModified := True;
1647 end;}
1648
1649 procedure TThreadItem.SetRound(b: Boolean);
1650 begin
1651 if b then
1652 RoundList.Add(Self)
1653 else
1654 RoundList.Delete(Self);
1655 if FRound = b then Exit;
1656 FRound := b;
1657 if FUpdate and (ParentBoard <> nil) then
1658 ParentBoard.FModified := True;
1659 end;
1660
1661 procedure TThreadItem.SetRoundName(s: string);
1662 begin
1663 if FRoundName = s then Exit;
1664 FRoundName := s;
1665 if FUpdate and (ParentBoard <> nil) then
1666 ParentBoard.FModified := True;
1667 end;
1668
1669 procedure TThreadItem.SetKokomade(i: Integer);
1670 begin
1671 if FKokomade = i then Exit;
1672 FKokomade := i;
1673 if FUpdate and (ParentBoard <> nil) then
1674 ParentBoard.FModified := True;
1675 end;
1676
1677 procedure TThreadItem.SetUnRead(b: Boolean);
1678 begin
1679 if FUnRead = b then Exit;
1680 FUnRead := b;
1681 if FUpdate and (ParentBoard <> nil) then
1682 ParentBoard.FModified := True;
1683 end;
1684
1685 procedure TThreadItem.SetScrollTop(i: Integer);
1686 begin
1687 if FScrollTop = i then Exit;
1688 FScrollTop := i;
1689 if FUpdate and (ParentBoard <> nil) then
1690 ParentBoard.FModified := True;
1691 end;
1692
1693 procedure TThreadItem.BeginUpdate;
1694 begin
1695 FUpdate := False;
1696 end;
1697
1698 procedure TThreadItem.EndUpdate;
1699 begin
1700 FUpdate := True;
1701 end;
1702
1703 {initialization
1704 BBS2ch := TBBS.Create;
1705
1706 finalization
1707 if BBS2ch <> nil then
1708 BBS2ch.Free;}
1709 end.
1710

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