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.48 - (show annotations) (download) (as text)
Sun Jul 11 15:11:50 2004 UTC (19 years, 9 months ago) by h677
Branch: MAIN
CVS Tags: b48, v1_49_0_540, v1_48_0_530, v1_48_0_535, v1_48_0_539, v1_48_0_538, v1_48_0_533, v1_48_0_537, v1_48_0_536
Changes since 1.47: +74 -29 lines
File MIME type: text/x-pascal
Setting.txt,head.txt, 板トップ画像をローカルに保存するようにした。

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

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