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.19 - (show annotations) (download) (as text)
Sat Nov 22 16:34:23 2003 UTC (20 years, 5 months ago) by yoffy
Branch: MAIN
Changes since 1.18: +42 -3 lines
File MIME type: text/x-pascal
・TBoard および TThreadItem の作成時にプラグインを使用していなくてもパスを生成するようになった。
 また、2ちゃんねる以外は exboard\<ホスト名>\ の位置からパスを生成するようになった。

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

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