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.77 - (show annotations) (download) (as text)
Sat Jan 31 15:48:36 2009 UTC (15 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_63_1_819, v1_62_0_812, v1_60_0_788, v1_60_0_789, v1_60_0_781, v1_60_0_782, v1_60_0_784, v1_60_0_786, v1_60_0_787, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_61_0_798, v1_61_0_799, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_62_0_803, v1_62_0_802, v1_62_0_809, v1_60_0_780, v1_60_0_779, v1_62_0_810, v1_62_0_811, v1_60_0_783, v1_60_1_793, v1_62_1_813, v1_61_0_800, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb62, Bb63, Bb60, Bb61
Changes since 1.76: +3 -3 lines
File MIME type: text/x-pascal
スレッド一覧読み込み時に利用するTThreadItemのコンストラクタで、
余分なURLの処理をなくした。

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

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