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.27 - (show annotations) (download) (as text)
Fri Nov 28 02:28:38 2003 UTC (20 years, 4 months ago) by yoffy
Branch: MAIN
Changes since 1.26: +140 -123 lines
File MIME type: text/x-pascal
。ヲネト、ャ、ハ、、セ?遉マ IE 、ヌウォ、ッ、隍ヲ、ヒハムケケ。」

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

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