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.70 - (show annotations) (download) (as text)
Wed Feb 22 17:21:22 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_52_0_647, v1_52_0_648, v1_52_0_650, v1_52_0_649
Changes since 1.69: +128 -2 lines
File MIME type: text/x-pascal
dat落ちスレの区別を追加したので、スレッド一覧をそれで絞り込めるようにした

1 unit BoardGroup;
2
3 interface
4
5 uses
6 Windows, SysUtils, Classes, ComCtrls, IniFiles, {HTTPApp,} YofUtils, IdGlobal,
7 ExternalBoardManager, ExternalBoardPlugInMain, StrUtils, DateUtils;
8
9 type
10 //???鴻????;腓冴?≪?ゃ?????御??
11 TGikoViewType = (gvtAll, gvtLog, gvtNew, gvtLive, gvtArch, gvtUser);
12 //???鴻???????筝???
13 TGikoAgeSage = (gasNone, gasAge, gasSage, gasNew, gasArch, gasNull);
14
15 TCategory = class;
16 TBoard = class;
17 TThreadItem = class;
18
19 // BBS ?????若??
20 TBBS = class(TList)
21 private
22 FTitle: string;
23 FFilePath : string; // ?帥???鴻????????/span>
24 FExpand: Boolean;
25 FKubetsuChk: Boolean; //腟?莨若?炊??紊ф??絖?絨??絖??阪??/span>
26 FSelectText: string; //腟?莨若?炊??絖???
27 FShortSelectText: string;
28 FIsBoardFileRead : Boolean; // ?帥???鴻??????粋昭?障??????????鐚?
29
30 function GetCategory(index: integer): TCategory;
31 procedure SetCategory(index: integer; value: TCategory);
32 procedure SetSelectText(s: string);
33 public
34 constructor Create( boardFilePath : string );
35 destructor Destroy; override;
36
37 function Add(item: TCategory): integer;
38 procedure Delete(index: integer);
39 procedure Clear; override;
40 function Find(key: string): TCategory;
41 function FindBBSID(const BBSID: string): TBoard;
42 function FindBoardFromTitle(const Title: string): TBoard;
43 function FindBoardFromURL(const inURL: string): TBoard;
44 function FindThreadFromURL(const inURL : string ) : TThreadItem;
45 function FindThreadItem(const BBSID, FileName: string): TThreadItem;
46 function FindCategoryFromTitle(const inTitle : string ) : TCategory;
47 property FilePath : string read FFilePath write FFilePath;
48
49 property Items[index: integer]: TCategory read GetCategory write SetCategory;
50 property Title: string read FTitle write FTitle;
51 property NodeExpand: Boolean read FExpand write FExpand;
52
53 property KubetsuChk: Boolean read FKubetsuChk write FKubetsuChk;
54 property SelectText: string read FSelectText write SetSelectText;
55 property ShortSelectText: string read FShortSelectText write FShortSelectText;
56
57 property IsBoardFileRead : Boolean read FIsBoardFileRead write FIsBoardFileRead;
58 end;
59
60 // ?????眼??? URL ?????鴻??)
61 // TCategory = class(THashedStringList)
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 // ???鴻?????? URL ?????鴻??)
95 // TBoard = class(THashedStringList)
96 TBoard = class(TStringList)
97 private
98 FContext: DWORD; // ?????違?ゃ?潟?????宴??┃絎???????????筝祉???ゃ?潟?鴻?帥?潟?鴻???ャ??)
99
100 FNo: Integer; //???/span>
101 FTitle: string; //???若???帥?ゃ????/span>
102 FBBSID: string; //BBSID
103 FURL: string; //???若??URL
104 FRound: Boolean; //?鴻??????筝?荀у掘??篋?膣?
105 FRoundName: string; //綏≦????
106 //FRoundName: PChar; //綏≦????
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 GetLogThread(Index: Integer; Base: Integer): TThreadItem; overload;
210 function GetArchiveThread(Index: Integer): TThreadItem;
211 function GetLiveThread(Index: Integer): TThreadItem;
212 function GetUserThread(Index: Integer): TThreadItem;
213
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 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
338 function BBSsFindBoardFromBBSID( inBBSID : string ) : TBoard;
339 function BBSsFindBoardFromURL( inURL : string ) : TBoard;
340 function BBSsFindBoardFromTitle( inTitle : string ) : TBoard;
341 function BBSsFindThreadFromURL(const inURL : string ) : TThreadItem;
342 function ConvertDateTimeString( inDateTimeString : string) : TDateTime;
343
344 var
345 BBSs : array of TBBS;
346 BoardGroups : array of TBoardGroup;
347
348 implementation
349
350 uses
351 GikoSystem, RoundData, MojuUtils;
352
353 const
354 BBS2CH_NAME: string = '鐚??<????????';
355 BBS2CH_LOG_FOLDER: string = '2ch';
356 EXTERNAL_LOG_FOLDER: string = 'exboard';
357
358 FOLDER_INI_FILENAME: string = 'Folder.ini';
359 FOLDER_INDEX_FILENAME: string = 'Folder.idx';
360 SUBJECT_FILENAME: string = 'subject.txt';
361 PATH_DELIM: string = '\';
362 SETTINGTXT_FILENAME: string = 'SETTING.TXT';
363 HEADTXT_FILENAME: string = 'head.html';
364 //DEFAULT_LIST_COUNT: Integer = 100;
365
366 // COLUMN_CATEGORY: array[0..0] of string = ('?????眼????');
367 // COLUMN_BOARD: array[0..3] of string = ('?水??', '??緇???#39;, '綏≦??篋?膣?', '????綏≦???ユ??');
368 // COLUMN_THREADITEM: array[0..3] of string = ('?鴻????????', '?????潟??', '綏≦??篋?膣?', '????綏≦???ユ??');
369
370 // BBSID ???????? 2 ?<???????????炊「???冴???障??
371 // BBSID ??戎????サ???帥?????????????
372 // ???純???翫??? URL ??篏睡???????????????
373 function BBSsFindBoardFromBBSID(
374 inBBSID : string
375 ) : TBoard;
376 var
377 i : Integer;
378 tmpBoard : TBoard;
379 begin
380
381 // Result := BBSs[ 0 ].FindBBSID( inBBSID );
382 Result := nil;
383 if Length(BoardGroups) > 0 then begin
384 for i := BoardGroups[0].Count - 1 downto 0 do begin
385 tmpBoard := TBoard(BoardGroups[0].Objects[i]);
386 if tmpBoard.Is2ch then begin
387 if AnsiCompareStr(tmpBoard.BBSID, inBBSID) = 0 then begin
388 Result := tmpBoard;
389 EXIT;
390 end;
391 end;
392 end;
393 end;
394
395 end;
396 {**********************************************
397 ?????∽?違??????帥??RL??就綣?ф検?????????????
398 plugin??篏睡???????????違??ExtractBoardURL( inURL )
399 2ch?????違??GikoSys.Get2chThreadURL2BoardURL( inURL );
400 ?у????????????若?喝?冴?????????????
401 **********************************************}
402 function BBSsFindBoardFromURL(
403 inURL : string
404 ) : TBoard;
405 var
406 i,p : Integer;
407 accept : TAcceptType;
408 protocol, host, path, document, port, bookmark : string;
409 begin
410 Result := nil;
411 for i := Length(BoardGroups) - 1 downto 1 do begin
412 accept := BoardGroups[i].BoardPlugIn.AcceptURL(inURL);
413 if (accept = atBoard) or (accept = atThread) then begin
414 if BoardGroups[i].Find(inURL, p) then begin
415 Result := TBoard(BoardGroups[i].Objects[p]);
416 Exit;
417 end else begin
418 inURL := BoardGroups[i].BoardPlugIn.ExtractBoardURL(inURL);
419 if BoardGroups[i].Find(inURL, p) then begin
420 Result := TBoard(BoardGroups[i].Objects[p]);
421 Exit;
422 end;
423 end;
424 end;
425 end;
426 //??????????????plugin??篏帥????????ゃ????茯帥?鴻??
427 if BoardGroups[0].Find(inURL, p) then
428 Result := TBoard(BoardGroups[0].Objects[p]);
429
430 if (Result = nil) then begin
431 GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
432 //???鴻????2ch????BBSID?ц??鴻??
433 if GikoSys.Is2chHost(host) then begin
434 Result := BBSsFindBoardFromBBSID(GikoSys.URLToID( inURL ));
435 end;
436 end;
437
438 end;
439
440 function BBSsFindBoardFromTitle(
441 inTitle : string
442 ) : TBoard;
443 var
444 i,j : Integer;
445 tmpBoard : TBoard;
446 begin
447 Result := nil;
448 for i := Length( BBSs ) - 1 downto 0 do begin
449 for j := BoardGroups[i].Count - 1 downto 0 do begin
450 tmpBoard := TBoard(BoardGroups[i].Objects[j]);
451 if ( AnsiCompareStr(tmpBoard.Title, inTitle) = 0) then begin
452 Result := tmpBoard;
453 Exit;
454 end;
455 end;
456 end;
457
458 end;
459
460 function BBSsFindThreadFromURL(
461 const inURL : string
462 ) : TThreadItem;
463 var
464 board : TBoard;
465 tmpThread : TThreadItem;
466 boardURL : string;
467 protocol, host, path, document, port, bookmark : string;
468 BBSID, BBSKey : string;
469 i, bi : Integer;
470 begin
471
472 boardURL := GikoSys.GetThreadURL2BoardURL( inURL );
473 board := BBSsFindBoardFromURL( boardURL );
474 if board = nil then
475 Result := nil
476 else begin
477 Result := board.FindThreadFromURL( inURL );
478 //??????2ch???帥????
479 if (Result = nil) and (board.Is2ch) then begin
480 GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
481 GikoSys.Parse2chURL( inURL, path, document, BBSID, BBSKey );
482 Result := board.FindThreadFromFileName(BBSKey + '.dat');
483 end else if (Result = nil) and not (board.Is2ch) then begin
484 //?????違?ゃ?括鎧??「膣??筝祉??RL????筝??у??眼?????c??蕁?)
485 try
486 bi := Length(BoardGroups) - 1;
487 for i := 1 to bi do begin
488 if (BoardGroups[i].BoardPlugIn <> nil) and (Assigned(Pointer(BoardGroups[i].BoardPlugIn.Module))) then begin
489 if BoardGroups[i].BoardPlugIn.AcceptURL( inURL ) = atThread then begin
490 tmpThread := TThreadItem.Create( BoardGroups[i].BoardPlugIn, Board, inURL );
491 if not board.IsThreadDatRead then begin
492 GikoSys.ReadSubjectFile( board );
493 end;
494 Result := Board.FindThreadFromFileName( tmpThread.FileName );
495 tmpThread.Free;
496 Break;
497 end;
498 end;
499 end;
500 except
501 Result := nil;
502 end;
503 end;
504 end;
505
506 end;
507
508 (*************************************************************************
509 *罘??遵??鐚?TBBS?潟?潟?鴻????????/span>
510 *Public
511 *************************************************************************)
512 constructor TBBS.Create( boardFilePath : string );
513 begin
514 inherited Create;
515 Title := BBS2CH_NAME;
516 FFilePath := boardFilePath;
517 end;
518
519 (*************************************************************************
520 *罘??遵??鐚?TBBS???鴻????????/span>
521 *Public
522 *************************************************************************)
523 destructor TBBS.Destroy;
524 begin
525 Clear;
526 inherited;
527 end;
528
529 (*************************************************************************
530 *罘??遵??鐚?
531 *Public
532 *************************************************************************)
533 function TBBS.GetCategory(index: integer): TCategory;
534 begin
535 Result := TCategory(inherited Items[index]);
536 end;
537
538 procedure TBBS.SetCategory(index: integer; value: TCategory);
539 begin
540 inherited Items[index] := value;
541 end;
542
543 function TBBS.Add(item: TCategory): integer;
544 begin
545 Item.ParenTBBS := self;
546 Result := inherited Add(item);
547 end;
548
549 procedure TBBS.Delete(index: integer);
550 begin
551 if Items[index] <> nil then
552 TCategory(Items[index]).Free;
553 Items[index] := nil;
554 inherited Delete(index);
555 end;
556
557 procedure TBBS.Clear;
558 var
559 i: integer;
560 begin
561 for i := Count - 1 downto 0 do
562 Delete(i);
563 Capacity := Count;
564 end;
565
566 function TBBS.Find(key: string): TCategory;
567 begin
568 Result := nil;
569 end;
570
571 function TBBS.FindBBSID(const BBSID: string): TBoard;
572 var
573 i : Integer;
574 begin
575 if not IsBoardFileRead then
576 GikoSys.ReadBoardFile( Self );
577 for i := Count - 1 downto 0 do begin
578 Result := Items[ i ].FindBBSID(BBSID);
579 if Result <> nil then
580 Exit;
581 end;
582 Result := nil;
583 end;
584
585 //*************************************************************************
586 // ?帥?ゃ????????眼?????帥???≪??
587 //*************************************************************************)
588 function TBBS.FindBoardFromTitle(const Title: string): TBoard;
589 var
590 i: Integer;
591 begin
592 if not IsBoardFileRead then
593 GikoSys.ReadBoardFile( Self );
594 for i := Count - 1 downto 0 do begin
595 Result := Items[ i ].FindBoardFromTitle(Title);
596 if Result <> nil then
597 Exit;
598 end;
599 Result := nil;
600 end;
601
602 //*************************************************************************
603 // URL ??????篁??????帥???≪??
604 //*************************************************************************)
605 function TBBS.FindBoardFromURL(const inURL: string): TBoard;
606 var
607 i : Integer;
608 begin
609 if not IsBoardFileRead then
610 GikoSys.ReadBoardFile( Self );
611 for i := Count - 1 downto 0 do begin
612 Result := Items[ i ].FindBoardFromURL( inURL );
613 if Result <> nil then
614 Exit;
615 end;
616 Result := nil;
617 end;
618
619 //*************************************************************************
620 // URL ??????篁??????鴻?????????≪??
621 //*************************************************************************)
622 function TBBS.FindThreadFromURL(const inURL: string): TThreadItem;
623 var
624 board : TBoard;
625 boardURL : string;
626 begin
627
628 boardURL := GikoSys.GetThreadURL2BoardURL( inURL );
629 board := FindBoardFromURL( boardURL );
630 if board = nil then
631 Result := nil
632 else
633 Result := board.FindThreadFromURL( inURL );
634
635 end;
636
637 function TBBS.FindThreadItem(const BBSID, FileName: string): TThreadItem;
638 var
639 Board: TBoard;
640 begin
641 Result := nil;
642 Board := FindBBSID(BBSID);
643 if Board = nil then
644 Exit;
645 Result := Board.FindThreadFromFileName(FileName);
646 end;
647
648 function TBBS.FindCategoryFromTitle(const inTitle : string ) : TCategory;
649 var
650 i : Integer;
651 begin
652
653 for i := Count - 1 downto 0 do begin
654 if AnsiCompareStr(Items[ i ].Title, inTitle) = 0 then begin
655 Result := Items[ i ];
656 Exit;
657 end;
658 end;
659
660 Result := nil;
661
662 end;
663
664 procedure TBBS.SetSelectText(s: string);
665 begin
666 FSelectText := s;
667 ShortSelectText := CustomStringReplace(ZenToHan(s), ' ', '');
668 end;
669
670 {class function TBBS.GetColumnName(Index: Integer): string;
671 begin
672 Result := COLUMN_CATEGORY[Index];
673 end;
674
675 class function TBBS.GetColumnCount: Integer;
676 begin
677 Result := Length(COLUMN_CATEGORY);
678 end;}
679
680 //===================
681 //TCategory
682 //===================
683 constructor TCategory.Create;
684 begin
685 inherited;
686
687 Duplicates := dupIgnore;
688 CaseSensitive := False;
689 //Sorted := True;
690 end;
691
692 destructor TCategory.Destroy;
693 begin
694 Clear;
695 inherited;
696 end;
697
698 function TCategory.GetBoard(index: integer): TBoard;
699 begin
700 Result := TBoard( Objects[index] );
701 end;
702
703 procedure TCategory.SetBoard(index: integer; value: TBoard);
704 begin
705 Objects[index] := value;
706 Strings[index] := value.URL
707 end;
708
709 function TCategory.Add(item: TBoard): integer;
710 begin
711 Item.ParentCategory := self;
712 Result := AddObject( item.URL, item );
713 end;
714
715 procedure TCategory.Delete(index: integer);
716 begin
717 inherited Delete(index);
718 end;
719
720 procedure TCategory.Clear;
721 var
722 i: integer;
723 begin
724 for i := Count - 1 downto 0 do
725 Delete(i);
726 Capacity := Count;
727 end;
728
729 function TCategory.FindName(const key: string): TBoard;
730 begin
731 Result := nil;
732 end;
733
734 function TCategory.FindBBSID(const BBSID: string): TBoard;
735 var
736 i : integer;
737 begin
738 for i := Count - 1 downto 0 do begin
739 if AnsiCompareStr(Items[i].FBBSID, BBSID) = 0 then begin
740 Result := Items[i];
741 Exit;
742 end;
743 end;
744 Result := nil;
745 end;
746
747 //*************************************************************************
748 // ?帥?ゃ????????眼?????帥???≪??
749 //*************************************************************************)
750 function TCategory.FindBoardFromTitle(const Title: string): TBoard;
751 var
752 i : integer;
753 begin
754 for i := Count - 1 downto 0 do begin
755 if AnsiCompareStr(Items[i].FTitle, Title) = 0 then begin
756 Result := Items[i];
757 Exit;
758 end;
759 end;
760 Result := nil;
761 end;
762
763 //*************************************************************************
764 // URL ??????篁??????帥???≪??
765 //*************************************************************************)
766 function TCategory.FindBoardFromURL(const inURL: string): TBoard;
767 var
768 i : Integer;
769 begin
770 i := IndexOf( inURL );
771 if i >= 0 then
772 Result := TBoard( Objects[ i ] )
773 else
774 Result := nil;
775 end;
776
777 //*************************************************************************
778 // URL ??????篁??????鴻?????????≪??
779 //*************************************************************************)
780 function TCategory.FindThreadFromURL(const inURL: string): TThreadItem;
781 var
782 board : TBoard;
783 boardURL : string;
784 begin
785
786 boardURL := GikoSys.GetThreadURL2BoardURL( inURL );
787 board := FindBoardFromURL( boardURL );
788 if board = nil then
789 Result := nil
790 else
791 Result := board.FindThreadFromURL( inURL );
792
793 end;
794
795 function TCategory.IsMidoku: Boolean;
796 var
797 i: Integer;
798 j: Integer;
799 begin
800 Result := False;
801 for i := 0 to Count - 1 do begin
802 if Items[i] <> nil then begin
803 for j := 0 to Items[i].Count - 1 do begin
804 if Items[i].Items[j] <> nil then begin
805 // if (Items[i].Items[j].IsLogFile) and (Items[i].Items[j].Count > Items[i].Items[j].Kokomade) then begin
806 if (Items[i].Items[j].IsLogFile) and (Items[i].Items[j].UnRead) then begin
807 Result := True;
808 Exit;
809 end;
810 end;
811 end;
812 end;
813 end;
814 end;
815
816 {class function TCategory.GetColumnName(Index: Integer): string;
817 begin
818 Result := COLUMN_BOARD[Index];
819 end;
820
821 class function TCategory.GetColumnCount: Integer;
822 begin
823 Result := Length(COLUMN_BOARD);
824 end;}
825
826 //===================
827 //TBoard
828 //===================
829 procedure TBoard.Init;
830 begin
831 Duplicates := dupIgnore;
832 CaseSensitive := False;
833 //Sorted := True;
834
835 FNo := 0;
836 FTitle := '';
837 FBBSID := '';
838 FURL := '';
839 FRound := False;
840 FRoundDate := ZERO_DATE;
841 FLastModified := ZERO_DATE;
842 FLastGetTime := ZERO_DATE;
843 FIsThreadDatRead := False;
844 FUnRead := 0;
845 FMultiplicity := 0;
846 // FListStyle := vsReport;
847 // FItemNoVisible := True;
848
849 FUpdate := True;
850 end;
851
852 // *************************************************************************
853 // 紊????帥?????違?ゃ?潟????絎??????潟?潟?鴻????????/span>
854 // *************************************************************************
855 constructor TBoard.Create(
856 inPlugIn : TBoardPlugIn;
857 inURL : string
858 );
859 var
860 protocol, host, path, document, port, bookmark : string;
861 begin
862
863 inherited Create;
864 Init;
865
866 FBoardPlugIn := inPlugIn;
867 URL := inURL;
868 BBSID := GikoSys.UrlToID( inURL );
869
870 if inPlugIn = nil then begin
871 // subject.txt ???絖????鴻??荐??
872 GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
873 if GikoSys.Is2chHost( host ) then begin
874 Self.Is2ch := True;
875 FilePath :=
876 GikoSys.Setting.LogFolderP +
877 BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME
878 end else begin
879 Self.Is2ch := False;
880 FilePath :=
881 GikoSys.Setting.LogFolderP +
882 EXTERNAL_LOG_FOLDER + PATH_DELIM + host + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME
883 end;
884 end else begin
885 // ?????違?ゃ?潟? TBoardItem ??篏???????????????篌?????
886 inPlugIn.CreateBoardItem( DWORD( Self ) );
887 //Self.Is2ch := False; //plugin?眼?ц┃絎?????
888 end;
889
890 end;
891
892 // *************************************************************************
893 // ???鴻????????/span>
894 // *************************************************************************
895 destructor TBoard.Destroy;
896 begin
897 if FModified then begin
898 GikoSys.WriteThreadDat(Self);
899 SaveSettings;
900 end;
901
902 // ?????違?ゃ?潟? TBoardItem ???贋?????????????篌?????
903 if IsBoardPlugInAvailable then
904 BoardPlugIn.DisposeBoardItem( DWORD( Self ) );
905
906 Clear;
907 inherited;
908 end;
909
910 // *************************************************************************
911 // 紊????帥?????違?ゃ?潟??篏睡????純??
912 // *************************************************************************
913 function TBoard.IsBoardPlugInAvailable : Boolean;
914 begin
915
916 repeat
917 if BoardPlugIn = nil then
918 Break;
919
920 if not Assigned( Pointer( BoardPlugIn.Module ) ) then
921 Break;
922
923 Result := True;
924 Exit;
925 until True;
926
927 Result := False;
928
929 end;
930
931 function TBoard.GetThreadItem(index: integer): TThreadItem;
932 begin
933 Result := TThreadItem( Objects[index] );
934 end;
935
936 procedure TBoard.SetThreadItem(index: integer; value: TThreadItem);
937 begin
938 Objects[index] := value;
939 Strings[index] := value.URL;
940 end;
941
942 function TBoard.Add(Item: TThreadItem): Integer;
943 begin
944 Item.ParentBoard := Self;
945 Result := inherited AddObject(Item.URL, Item);
946 end;
947
948 procedure TBoard.Insert(Index: Integer; Item: TThreadItem);
949 begin
950 Item.ParentBoard := Self;
951 inherited InsertObject(Index, Item.URL, Item);
952
953 end;
954
955 //Index?ф??絎????????鴻???????????吾?с???????贋?
956 procedure TBoard.Delete(index: Integer);
957 begin
958 if Items[index] <> nil then
959 TThreadItem(Items[index]).Free;
960 inherited Delete(index);
961 end;
962
963 //Index?ф??絎????????鴻???????????鴻?????????わ??鴻???????吾?с????????????鐚?
964 procedure TBoard.DeleteList(index: integer);
965 begin
966 inherited Delete(index);
967 end;
968
969 procedure TBoard.Clear;
970 var
971 i: integer;
972 begin
973 // FUnRead := 0;
974 for i := Count - 1 downto 0 do
975 Delete(i);
976 Capacity := Count;
977 end;
978
979 function TBoard.FindThreadFromFileName(const ItemFileName: string): TThreadItem;
980 var
981 i: integer;
982 begin
983 Result := nil;
984 for i := 0 to Count - 1 do begin
985 if AnsiCompareStr(Items[i].FileName, ItemFileName) = 0 then begin
986 Result := Items[i];
987 Exit;
988 end;
989 end;
990 end;
991
992 function TBoard.GetIndexFromFileName(const ItemFileName: string): Integer;
993 var
994 i: integer;
995 begin
996 Result := -1;
997 for i := 0 to Count - 1 do begin
998 if Items[i].FileName = ItemFileName then begin
999 Result := i;
1000 Exit;
1001 end;
1002 end;
1003 end;
1004
1005 function TBoard.GetIndexFromURL(const URL: string; reverse : Boolean = False): Integer;
1006 var
1007 i : Integer;
1008 begin
1009 if not reverse then
1010 Result := IndexOf( URL )
1011 else begin
1012 Result := -1;
1013 for i := Self.Count - 1 downto 0 do begin
1014 if Strings[i] = URL then begin
1015 Result := i;
1016 break;
1017 end;
1018 end;
1019 end;
1020 end;
1021
1022 function TBoard.FindThreadFromURL(const inURL : string ) : TThreadItem;
1023 var
1024 i : Integer;
1025 begin
1026
1027 if not IsThreadDatRead then
1028 GikoSys.ReadSubjectFile( Self );
1029
1030 i := IndexOf( inURL );
1031 if i >= 0 then
1032 Result := TThreadItem( Objects[ i ] )
1033 else
1034 Result := nil;
1035
1036 end;
1037
1038 {function TBoard.GetMidokuCount: Integer;
1039 var
1040 i: integer;
1041 begin
1042 Result := 0;
1043 for i := 0 to Count- 1 do begin
1044 if Items[i] <> nil then begin
1045 if (Items[i].IsLogFile) and (Items[i].Count > Items[i].Kokomade) then
1046 inc(Result);
1047 end;
1048 end;
1049 end;
1050 }
1051
1052 procedure TBoard.LoadSettings;
1053 var
1054 ini: TMemIniFile;
1055 FileName: string;
1056 tmp: string;
1057 begin
1058 if Length( FilePath ) > 0 then
1059 FileName := ExtractFilePath( FilePath ) + FOLDER_INI_FILENAME
1060 else
1061 FileName := GikoSys.Setting.LogFolderP
1062 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + FOLDER_INI_FILENAME;
1063
1064 if not FileExists(FileName) then
1065 Exit;
1066 ini := TMemIniFile.Create(FileName);
1067 try
1068 // Round := ini.ReadBool('Status', 'Round', False);
1069 tmp := ini.ReadString('Status', 'RoundDate', DateTimeToStr(ZERO_DATE));
1070 FRoundDate := ConvertDateTimeString(tmp);
1071 tmp := ini.ReadString('Status', 'LastModified', DateTimeToStr(ZERO_DATE));
1072 FLastModified := ConvertDateTimeString(tmp);
1073 tmp := ini.ReadString('Status', 'LastGetTime', DateTimeToStr(ZERO_DATE));
1074 FLastGetTime := ConvertDateTimeString(tmp);
1075
1076 tmp := ini.ReadString('BoardInformation', 'SETTINGTXTTime', DateTimeToStr(ZERO_DATE));
1077 FSETTINGTXTTime := ConvertDateTimeString(tmp);
1078 tmp := ini.ReadString('BoardInformation', 'HEADTXTTime', DateTimeToStr(ZERO_DATE));
1079 FHEADTXTTime := ConvertDateTimeString(tmp);
1080
1081 FIsSETTINGTXT := ini.ReadBool('BoardInformation', 'IsSETTINGTXT', false);
1082 FIsHEADTXT := ini.ReadBool('BoardInformation', 'IsHEADTXT', false);
1083 FTitlePictureURL := ini.ReadString('BoardInformation', 'TitlePictureURL', '');
1084
1085 FUnRead := ini.ReadInteger('Status', 'UnRead', 0);
1086 FSPID := ini.ReadString('Cookie', 'SPID', '');
1087 FPON := ini.ReadString('Cookie', 'PON', '');
1088 FCookie := ini.ReadString('Cookie', 'Cookie', '');
1089 tmp := ini.ReadString('Cookie', 'Expires', DateTimeToStr(ZERO_DATE));
1090 FExpires := ConvertDateTimeString(tmp);
1091 FKotehanName := ini.ReadString('Kotehan', 'Name', '');
1092 FKotehanMail := ini.ReadString('Kotehan', 'Mail', '');
1093
1094 if UnRead < 0 then
1095 UnRead := 0;
1096 finally
1097 ini.Free;
1098 end;
1099 end;
1100
1101 procedure TBoard.SaveSettings;
1102 var
1103 ini: TMemIniFile;
1104 FileName: string;
1105 begin
1106 if Length( FilePath ) > 0 then
1107 FileName := ExtractFilePath( FilePath )
1108 else
1109 FileName := GikoSys.Setting.LogFolderP
1110 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM;
1111 if not GikoSys.DirectoryExistsEx(FileName) then
1112 GikoSys.ForceDirectoriesEx(FileName);
1113 FileName := FileName + FOLDER_INI_FILENAME;
1114 ini := TMemIniFile.Create(FileName);
1115 try
1116 if UnRead < 0 then
1117 UnRead := 0;
1118 // ini.WriteBool('Status', 'Round', Round);
1119 ini.WriteDateTime('Status', 'RoundDate', FRoundDate);
1120 ini.WriteDateTime('Status', 'LastModified', FLastModified);
1121 ini.WriteDateTime('Status', 'LastGetTime', FLastGetTime);
1122 ini.WriteInteger('Status', 'UnRead', FUnRead);
1123 ini.WriteString('Cookie', 'SPID', FSPID);
1124 ini.WriteString('Cookie', 'PON', FPON);
1125 ini.WriteString('Cookie', 'Cookie', FCookie);
1126 ini.WriteDateTime('Cookie', 'Expires', FExpires);
1127 ini.WriteString('Kotehan', 'Name', FKotehanName);
1128 ini.WriteString('Kotehan', 'Mail', FKotehanMail);
1129
1130 ini.WriteDateTime('BoardInformation', 'SETTINGTXTTime', FSETTINGTXTTime);
1131 ini.WriteDateTime('BoardInformation', 'HEADTXTTime', FHEADTXTTime);
1132
1133 ini.WriteBool('BoardInformation', 'IsSETTINGTXT', FIsSETTINGTXT);
1134 ini.WriteBool('BoardInformation', 'IsHEADTXT', FIsHEADTXT);
1135 ini.WriteString('BoardInformation', 'TitlePictureURL', FTitlePictureURL);
1136 // ini.WriteInteger('Status', 'ListStyle', Ord(ListStyle));
1137 // ini.WriteBool('Status', 'ItemNoVisible', ItemNoVisible);
1138 // ini.WriteInteger('Status', 'ViewType', Ord(ViewType));
1139 ini.UpdateFile;
1140 finally
1141 ini.Free;
1142 end;
1143 end;
1144 //????????003 02 08 0:32:13??????就綣???ヤ??????????с??????
1145 // 2003/02/08 0:32:13?????????
1146 function ConvertDateTimeString( inDateTimeString : string) : TDateTime;
1147 const
1148 ZERO_DATE_STRING : string = '1970/01/01 0:00:00';
1149 var
1150 i : Integer;
1151 y: Integer;
1152 m: Integer;
1153 d: Integer;
1154 hour: Integer;
1155 min: Integer;
1156 sec: Integer;
1157 begin
1158 if inDateTimeString = '' then
1159 inDateTimeString := ZERO_DATE_STRING;
1160
1161 if ( AnsiPos('/', inDateTimeString ) = 0 ) and
1162 ( AnsiCompareStr( DateTimeToStr(ZERO_DATE), inDateTimeString) <> 0 ) then begin
1163 for i := 0 to 1 do begin
1164 Insert('/',inDateTimeString, AnsiPos(' ', inDateTimeString) + 1 );
1165 Delete(inDateTimeString, AnsiPos(' ', inDateTimeString), 1);
1166 end;
1167 end;
1168 try
1169 Result := StrToDateTime( inDateTimeString );
1170 except
1171 if( inDateTimeString[5] = '/' ) and ( inDateTimeString[8] = '/' ) then begin
1172 y := StrToIntDef( Copy(inDateTimeString, 1, 4), 1970 );
1173 m := StrToIntDef( Copy(inDateTimeString, 6, 2), 1 );
1174 d := StrToIntDef( Copy(inDateTimeString, 9, 2), 1 );
1175 hour := 0; min := 0; sec := 0;
1176
1177 if Length(inDateTimeString) > 11 then begin
1178 if( inDateTimeString[13] = ':' ) and ( inDateTimeString[16] = ':' ) then begin
1179 hour := StrToIntDef( Copy(inDateTimeString, 12, 1), 0 );
1180 min := StrToIntDef( Copy(inDateTimeString, 14, 2), 0 );
1181 sec := StrToIntDef( Copy(inDateTimeString, 17, 2), 0 );
1182 end else if( inDateTimeString[14] = ':' ) and ( inDateTimeString[17] = ':' ) then begin
1183 hour := StrToIntDef( Copy(inDateTimeString, 12, 2), 0 );
1184 min := StrToIntDef( Copy(inDateTimeString, 15, 2), 0 );
1185 sec := StrToIntDef( Copy(inDateTimeString, 18, 2), 0 );
1186 end;
1187 end;
1188 try
1189 Result := EncodeDateTime(y ,m, d, hour, min, sec, 0);
1190 except
1191 Result := ZERO_DATE;
1192 end;
1193 end else
1194 Result := ZERO_DATE;
1195 end;
1196
1197
1198 // Result := inDateTimeString;
1199 end;
1200 // ?泣???吾?с????URL??緇?
1201 function TBoard.GetReadCgiURL: string;
1202 begin
1203 //Result := URL + SUBJECT_FILENAME;
1204 //Result := GikoSys.UrlToServer(URL)
1205 // + 'test/read.cgi/' + BBSID + '/?raw=0.0';
1206 Result := URL + SUBJECT_FILENAME;
1207
1208 end;
1209
1210 // ?泣???吾?с???????<?ゃ??????緇?鐚????刻????<?ゃ????鐚?
1211 function TBoard.GetSubjectFileName: string;
1212 begin
1213 if Length( FilePath ) > 0 then
1214 Result := FilePath
1215 else
1216 Result := GikoSys.Setting.LogFolderP
1217 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SUBJECT_FILENAME;
1218 end;
1219
1220 // ?ゃ?潟???????鴻???<?ゃ????(folder.idx)??緇?鐚????刻????<?ゃ????鐚?
1221 function TBoard.GetFolderIndexFileName: string;
1222 begin
1223 if Length( FilePath ) > 0 then
1224 Result := ExtractFilePath( FilePath ) + FOLDER_INDEX_FILENAME
1225 else
1226 Result := GikoSys.Setting.LogFolderP
1227 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + FOLDER_INDEX_FILENAME;
1228 end;
1229 //SETTING.TXT?????<?ゃ??????緇?
1230 function TBoard.GetSETTINGTXTFileName: string;
1231 begin
1232 if Length( FilePath ) > 0 then
1233 Result := ExtractFilePath( FilePath ) + SETTINGTXT_FILENAME
1234 else
1235 Result := GikoSys.Setting.LogFolderP
1236 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + SETTINGTXT_FILENAME;
1237 end;
1238
1239 function TBoard.GETHEADTXTFileName: string;
1240 begin
1241 if Length( FilePath ) > 0 then
1242 Result := ExtractFilePath( FilePath ) + HEADTXT_FILENAME
1243 else
1244 Result := GikoSys.Setting.LogFolderP
1245 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + HEADTXT_FILENAME;
1246 end;
1247 function TBoard.GetTitlePictureFileName: string;
1248 var
1249 tmpName: string;
1250 begin
1251 if FTitlePictureURL = '' then
1252 Result := ''
1253 else begin
1254 tmpName := Copy(FTitlePictureURL, LastDelimiter('/', FTitlePictureURL) + 1, Length(FTitlePictureURL));
1255 if Length( FilePath ) > 0 then
1256 Result := ExtractFilePath( FilePath ) + tmpName
1257 else
1258 Result := GikoSys.Setting.LogFolderP
1259 + BBS2CH_LOG_FOLDER + PATH_DELIM + BBSID + PATH_DELIM + tmpName;
1260 end;
1261 end;
1262
1263 // ?鴻???????篆?RL
1264 function TBoard.GetSendURL: string;
1265 //var
1266 // Protocol, Host, Path, Document, Port, Bookmark : string;
1267 begin
1268 Result := GikoSys.UrlToServer(URL);
1269 //GikoSys.ParseURI( URL, Protocol,Host, Path, Document, Port, Bookmark );
1270 //if GikoSys.Is2chHost(Host) then
1271 if Self.Is2ch then
1272 Result := Result + 'test/bbs.cgi'
1273 else
1274 Result := Result + 'test/subbbs.cgi';
1275
1276 end;
1277
1278 procedure TBoard.SetRound(b: Boolean);
1279 begin
1280 if b then
1281 RoundList.Add(Self)
1282 else
1283 RoundList.Delete(Self);
1284 if FRound = b then Exit;
1285 FRound := b;
1286 if FUpdate then
1287 FModified := True;
1288 end;
1289
1290 procedure TBoard.SetRoundName(s: string);
1291 begin
1292 if FRoundName = s then Exit;
1293 FRoundName := s;
1294 if FUpdate then
1295 FModified := True;
1296 end;
1297 {
1298 procedure TBoard.SetRoundName(s: PChar);
1299 begin
1300 if FRoundName = s then Exit;
1301 FRoundName := s;
1302 if FUpdate then
1303 FModified := True;
1304 end;
1305 }
1306 procedure TBoard.SetLastModified(d: TDateTime);
1307 begin
1308 if FLastModified = d then Exit;
1309 FLastModified := d;
1310 if FUpdate then
1311 FModified := True;
1312 end;
1313
1314 procedure TBoard.SetLastGetTime(d: TDateTime);
1315 begin
1316 if FLastGetTime = d then Exit;
1317 FLastGetTime := d;
1318 if FUpdate then
1319 FModified := True;
1320 end;
1321
1322 procedure TBoard.SetUnRead(i: Integer);
1323 begin
1324 if FUnRead = i then Exit;
1325 if i < 0 then i := 0;
1326 FUnRead := i;
1327 if FUpdate then
1328 FModified := True;
1329 end;
1330
1331 procedure TBoard.SetKotehanName(s: string);
1332 begin
1333 if FKotehanName = s then Exit;
1334 FKotehanName := s;
1335 if FUpdate then
1336 FModified := True;
1337 end;
1338
1339 procedure TBoard.SetKotehanMail(s: string);
1340 begin
1341 if FKotehanMail = s then Exit;
1342 FKotehanMail := s;
1343 if FUpdate then
1344 FModified := True;
1345 end;
1346
1347 function TBoard.GetNewThreadCount: Integer;
1348 var
1349 i: Integer;
1350 begin
1351 Result := 0;
1352 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1353 begin
1354 for i := 0 to Count - 1 do begin
1355 if Items[i].NewArrival then
1356 inc(Result);
1357 end;
1358 end else begin
1359 for i := 0 to Count - 1 do begin
1360 if Items[i].NewArrival then
1361 begin
1362 if Items[i].ShortTitle = '' then
1363 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1364 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1365 inc(Result);
1366 end;
1367 end;
1368 end;
1369 end;
1370
1371 function TBoard.GetLogThreadCount: Integer;
1372 var
1373 i: Integer;
1374 begin
1375 Result := 0;
1376 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1377 begin
1378 for i := 0 to Count - 1 do begin
1379 if Items[i].IsLogFile then
1380 inc(Result);
1381 end;
1382 end else begin
1383 for i := 0 to Count - 1 do begin
1384 if Items[i].IsLogFile then
1385 begin
1386 if Items[i].ShortTitle = '' then
1387 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1388 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1389 inc(Result);
1390 end;
1391 end;
1392 end;
1393 end;
1394
1395 function TBoard.GetUserThreadCount: Integer;
1396 var
1397 i: Integer;
1398 begin
1399 Result := 0;
1400 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1401 Result := Count
1402 else
1403 for i := 0 to Count - 1 do 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 function TBoard.GetArchiveThreadCount: Integer;
1411 var
1412 i: Integer;
1413 begin
1414 Result := 0;
1415 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1416 begin
1417 for i := 0 to Count - 1 do begin
1418 if Items[i].AgeSage = gasArch then
1419 inc(Result);
1420 end;
1421 end else begin
1422 for i := 0 to Count - 1 do begin
1423 if Items[i].AgeSage = gasArch then
1424 begin
1425 if Items[i].ShortTitle = '' then
1426 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1427 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1428 inc(Result);
1429 end;
1430 end;
1431 end;
1432 end;
1433
1434 function TBoard.GetLiveThreadCount: Integer;
1435 var
1436 i: Integer;
1437 begin
1438 Result := 0;
1439 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1440 begin
1441 for i := 0 to Count - 1 do begin
1442 if Items[i].AgeSage <> gasArch then
1443 inc(Result);
1444 end;
1445 end else begin
1446 for i := 0 to Count - 1 do begin
1447 if Items[i].AgeSage <> gasArch then
1448 begin
1449 if Items[i].ShortTitle = '' then
1450 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1451 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then
1452 inc(Result);
1453 end;
1454 end;
1455 end;
1456 end;
1457 function TBoard.GetArchiveThread(Index: Integer): TThreadItem;
1458 var
1459 i: Integer;
1460 Cnt: Integer;
1461 begin
1462 Result := nil;
1463 Cnt := 0;
1464 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1465 begin
1466 for i := 0 to Count - 1 do begin
1467 if Items[i].AgeSage = gasArch then
1468 begin
1469 if Index = Cnt then begin
1470 Result := Items[i];
1471 Exit;
1472 end;
1473 inc(Cnt);
1474 end;
1475 end;
1476 end else begin
1477 for i := 0 to Count - 1 do begin
1478 if Items[i].AgeSage = gasArch then
1479 begin
1480 if Items[i].ShortTitle = '' then
1481 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1482 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1483 if Index = Cnt then begin
1484 Result := Items[i];
1485 Exit;
1486 end;
1487 inc(Cnt);
1488 end;
1489 end;
1490 end;
1491 end;
1492 end;
1493 function TBoard.GetLiveThread(Index: Integer): TThreadItem;
1494 var
1495 i: Integer;
1496 Cnt: Integer;
1497 begin
1498 Result := nil;
1499 Cnt := 0;
1500 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1501 begin
1502 for i := 0 to Count - 1 do begin
1503 if Items[i].AgeSage <> gasArch then
1504 begin
1505 if Index = Cnt then begin
1506 Result := Items[i];
1507 Exit;
1508 end;
1509 inc(Cnt);
1510 end;
1511 end;
1512 end else begin
1513 for i := 0 to Count - 1 do begin
1514 if Items[i].AgeSage <> gasArch then
1515 begin
1516 if Items[i].ShortTitle = '' then
1517 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1518 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1519 if Index = Cnt then begin
1520 Result := Items[i];
1521 Exit;
1522 end;
1523 inc(Cnt);
1524 end;
1525 end;
1526 end;
1527 end;
1528 end;
1529 function TBoard.GetNewThread(Index: Integer): TThreadItem;
1530 var
1531 i: Integer;
1532 Cnt: Integer;
1533 begin
1534 Result := nil;
1535 Cnt := 0;
1536 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1537 begin
1538 for i := 0 to Count - 1 do begin
1539 if Items[i].NewArrival then
1540 begin
1541 if Index = Cnt then begin
1542 Result := Items[i];
1543 Exit;
1544 end;
1545 inc(Cnt);
1546 end;
1547 end;
1548 end else begin
1549 for i := 0 to Count - 1 do begin
1550 if Items[i].NewArrival then
1551 begin
1552 if Items[i].ShortTitle = '' then
1553 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1554 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1555 if Index = Cnt then begin
1556 Result := Items[i];
1557 Exit;
1558 end;
1559 inc(Cnt);
1560 end;
1561 end;
1562 end;
1563 end;
1564 end;
1565
1566 function TBoard.GetLogThread(Index: Integer): TThreadItem;
1567 var
1568 i: Integer;
1569 Cnt: Integer;
1570 begin
1571 Cnt := 0;
1572 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1573 begin
1574 for i := 0 to Count - 1 do begin
1575 if Items[i].IsLogFile then
1576 begin
1577 if Index = Cnt then begin
1578 Result := Items[i];
1579 Exit;
1580 end;
1581 inc(Cnt);
1582 end;
1583 end;
1584 end else begin
1585 for i := 0 to Count - 1 do begin
1586 if Items[i].IsLogFile then
1587 begin
1588 if Items[i].ShortTitle = '' then
1589 Items[i].ShortTitle := ZenToHan(Items[i].Title);
1590 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1591 if Index = Cnt then begin
1592 Result := Items[i];
1593 Exit;
1594 end;
1595 inc(Cnt);
1596 end;
1597 end;
1598 end;
1599 end;
1600 Result := nil;
1601 end;
1602 function TBoard.GetLogThread(Index: Integer; Base: Integer): TThreadItem;
1603 var
1604 i: Integer;
1605 Cnt: Integer;
1606 begin
1607 Cnt := 0;
1608 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1609 begin
1610 for i := Base to Count - 1 do begin
1611 if Items[i].IsLogFile then
1612 begin
1613 if Index = Cnt then begin
1614 Result := Items[i];
1615 Exit;
1616 end;
1617 inc(Cnt);
1618 end;
1619 end;
1620 end else begin
1621 for i := Base to Count - 1 do begin
1622 if Items[i].IsLogFile then
1623 begin
1624 if Items[i].ShortTitle = '' then
1625 Items[i].ShortTitle := ZenToHan(Items[i].Title);
1626 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1627 if Index = Cnt then begin
1628 Result := Items[i];
1629 Exit;
1630 end;
1631 inc(Cnt);
1632 end;
1633 end;
1634 end;
1635 end;
1636 Result := nil;
1637 end;
1638 function TBoard.GetUserThread(Index: Integer): TThreadItem;
1639 var
1640 i: Integer;
1641 Cnt: Integer;
1642 begin
1643 Result := nil;
1644 Cnt := 0;
1645 if Length( ParentCategory.ParenTBBS.ShortSelectText ) = 0 then
1646 begin
1647 for i := 0 to Count - 1 do begin
1648 if Index = Cnt then
1649 begin
1650 Result := Items[ i ];
1651 Exit;
1652 end;
1653 inc( Cnt );
1654 end;
1655 end else begin
1656 for i := 0 to Count - 1 do begin
1657 if Items[i].ShortTitle = '' then
1658 Items[i].ShortTitle := CustomStringReplace(ZenToHan(Items[i].Title), ' ', '');
1659 if AnsiPos(ParentCategory.ParenTBBS.ShortSelectText, Items[i].ShortTitle) <> 0 then begin
1660 if Index = Cnt then begin
1661 Result := Items[i];
1662 Exit;
1663 end;
1664 inc(Cnt);
1665 end;
1666 end;
1667 end;
1668 end;
1669
1670 procedure TBoard.BeginUpdate;
1671 begin
1672 FUpdate := False;
1673 end;
1674
1675 procedure TBoard.EndUpdate;
1676 begin
1677 FUpdate := True;
1678 end;
1679
1680 {class function TBoard.GetColumnName(Index: Integer): string;
1681 begin
1682 Result := COLUMN_THREADITEM[Index];
1683 end;
1684
1685 class function TBoard.GetColumnCount: Integer;
1686 begin
1687 Result := Length(COLUMN_THREADITEM);
1688 end;}
1689
1690 //constructor TThreadItem.Create(AOwner: TComponent);
1691 procedure TThreadItem.Init;
1692 begin
1693 FNo := 0;
1694 FFileName := '';
1695 FTitle := '';
1696 FRoundDate := ZERO_DATE;
1697 FLastModified := ZERO_DATE;
1698 FCount := 0;
1699 FAllResCount := 0;
1700 FNewResCount := 0;
1701 FSize := 0;
1702 FRound := False;
1703 FIsLogFile := False;
1704 FParentBoard := nil;
1705 FKokomade := -1;
1706 FNewReceive := 0;
1707 FNewArrival := False;
1708
1709 FUpdate := True;
1710 FURL := '';
1711 FJumpAddress := 0;
1712 end;
1713
1714 // *************************************************************************
1715 // 紊????帥?????違?ゃ?潟????絎??????潟?潟?鴻????????/span>
1716 // *************************************************************************
1717 constructor TThreadItem.Create(
1718 const inPlugIn : TBoardPlugIn;
1719 const inBoard : TBoard;
1720 inURL : string
1721 );
1722 var
1723 foundPos : Integer;
1724 protocol, host, path, document, port, bookmark : string;
1725 BBSID, BBSKey : string;
1726 const
1727 READ_PATH = '/test/read.cgi';
1728 begin
1729
1730 inherited Create;
1731 Init;
1732 FParentBoard := inBoard;
1733 //FBoardPlugIn := inPlugIn;
1734 URL := inURL;
1735
1736 if inPlugIn = nil then begin
1737 foundPos := Pos( READ_PATH, inURL );
1738 if foundPos > 0 then begin
1739 // dat ???絖????鴻??荐??
1740 GikoSys.ParseURI( inURL, protocol, host, path, document, port, bookmark );
1741 GikoSys.Parse2chURL( inURL, path, document, BBSID, BBSKey );
1742 FileName := BBSKey + '.dat';
1743 IsLogFile := FileExists( FilePath );
1744 URL := GikoSys.Get2chBrowsableThreadURL( inURL );
1745 end;
1746 end else begin
1747 // ?????違?ゃ?潟? TThreadItem ??篏???????????????篌?????
1748 inPlugIn.CreateThreadItem( DWORD( Self ) );
1749 end;
1750
1751 end;
1752 // *************************************************************************
1753 // 紊????帥?????違?ゃ?潟????絎??????潟?潟?鴻??????? Log?????????????ゆ?????/span>
1754 // FileName????緇?羝??帥??????ReadSubject??/span>
1755 // *************************************************************************
1756 constructor TThreadItem.Create(
1757 const inPlugIn : TBoardPlugIn;
1758 const inBoard : TBoard;
1759 inURL : string;
1760 inExist: Boolean;
1761 const inFilename: string
1762 );
1763 begin
1764
1765 inherited Create;
1766 Init;
1767 FParentBoard := inBoard;
1768 URL := inURL;
1769
1770 if inPlugIn = nil then begin
1771 // dat ???絖????鴻??荐??
1772 FileName := inFilename;
1773 IsLogFile := inExist;
1774 URL := GikoSys.Get2chBrowsableThreadURL( inURL );
1775 end else begin
1776 // ?????違?ゃ?潟? TThreadItem ??篏???????????????篌?????
1777 inPlugIn.CreateThreadItem( DWORD( Self ) );
1778 end;
1779
1780 end;
1781 // *************************************************************************
1782 // ???鴻????????/span>
1783 // *************************************************************************
1784 destructor TThreadItem.Destroy;
1785 begin
1786
1787 // ?????違?ゃ?潟? TThreadItem ???贋?????????????篌?????
1788 if Self.ParentBoard.IsBoardPlugInAvailable then
1789 Self.ParentBoard.BoardPlugIn.DisposeThreadItem( DWORD( Self ) );
1790
1791 inherited;
1792
1793 end;
1794
1795 // *************************************************************************
1796 // 紊????帥?????違?ゃ?潟??篏睡????純??
1797 // *************************************************************************
1798 {
1799 function TThreadItem.IsBoardPlugInAvailable : Boolean;
1800 begin
1801
1802 repeat
1803 if BoardPlugIn = nil then
1804 Break;
1805
1806 if not Assigned( Pointer( BoardPlugIn.Module ) ) then
1807 Break;
1808
1809 Result := True;
1810 Exit;
1811 until True;
1812
1813 Result := False;
1814
1815 end;
1816 }
1817 function TThreadItem.GetDatURL: string;
1818 var
1819 Protocol, Host, Path, Document, Port, Bookmark: string;
1820 begin
1821 Result := ParentBoard.URL
1822 + 'dat/'
1823 + FileName;
1824 if FDownloadHost <> '' then begin
1825 GikoSys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1826 Result := Format('%s://%s%s%s', [Protocol,
1827 FDownloadHost,
1828 Path,
1829 Document]);
1830 end;
1831 // Result := GikoSys.UrlToServer(ParentBoard.URL)
1832 // + 'test/read.cgi/' + ParentBoard.BBSID + '/'
1833 // + ChangeFileExt(FileName, '') + '/?raw='
1834 // + IntToStr(ResNum) + '.' + IntToStr(ResSize);
1835 end;
1836
1837 function TThreadItem.GetDatgzURL: string;
1838 function isOldKako(s: string): Boolean;
1839 begin
1840 Result := False;
1841 if AnsiPos('piza.', s) <> 0 then
1842 Result := True
1843 else if AnsiPos('www.bbspink.', s) <> 0 then
1844 Result := True
1845 else if AnsiPos('tako.', s) <> 0 then
1846 Result := True;
1847 end;
1848 var
1849 Protocol, Host, Path, Document, Port, Bookmark: string;
1850 DatNo: string;
1851 begin
1852 if FDownloadHost = '' then begin
1853 DatNo := ChangeFileExt(FileName, '');
1854 if isOldKako(ParentBoard.URL) then begin
1855 Result := Format('%s%s/%.3s/%s.dat', [ParentBoard.URL, 'kako', DatNo, DatNo]);
1856 end else begin
1857 if Length(DatNo) > 9 then begin
1858 //http://xxx.2ch.net/xxx/kako/9999/99999/999999999.dat.gz
1859 Result := Format('%s%s/%.4s/%.5s/%s.dat.gz', [ParentBoard.URL, 'kako', DatNo, DatNo, DatNo]);
1860 end else begin
1861 //http://xxx.2ch.net/xxx/kako/999/999999999.dat.gz
1862 Result := Format('%s%s/%.3s/%s.dat.gz', [ParentBoard.URL, 'kako', DatNo, DatNo]);
1863 end;
1864 end;
1865 end else begin
1866 Gikosys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1867 DatNo := ChangeFileExt(Document, '');
1868 if isOldKako(DownloadHost) then begin
1869 Result := Format('%s://%s/%s/kako/%.3s/%s.dat', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo]);
1870 end else begin
1871 if Length(DatNo) > 9 then begin
1872 Result := Format('%s://%s/%s/kako/%.4s/%.5s/%s.dat.gz', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo, DatNo]);
1873 end else begin
1874 Result := Format('%s://%s/%s/kako/%.3s/%s.dat.gz', [Protocol, DownloadHost, ParentBoard.FBBSID, DatNo, DatNo]);
1875 end;
1876 end;
1877 end;
1878 end;
1879
1880 {function TThreadItem.GetOldDatgzURL: string;
1881 var
1882 Protocol, Host, Path, Document, Port, Bookmark: string;
1883 begin
1884 Result := Format('%s%s/%.3s/%s.gz', [ParentBoard.URL,
1885 'kako',
1886 FileName,
1887 FileName]);
1888 if FDownloadHost <> '' then begin
1889 ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1890 Result := Format('%s://%s%s%s', [Protocol,
1891 DownloadHost,
1892 Path,
1893 Document]);
1894
1895 end;
1896 end;}
1897
1898 function TThreadItem.GetOfflawCgiURL(const SessionID: string): string;
1899 //var
1900 // Protocol, Host, Path, Document, Port, Bookmark: string;
1901 begin
1902 // Result := GikoSys.UrlToServer(ParentBoard.URL)
1903 // + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1904 // + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1905 if FDownloadHost = '' then begin
1906 Result := GikoSys.UrlToServer(ParentBoard.URL)
1907 + 'test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1908 + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1909 end else begin
1910 //http://news.2ch.net/test/offlaw.cgi/newsplus/1014038577/?raw=.196928&sid=
1911 //GikoSys.ParseURI(Result, Protocol, Host, Path, Document, Port, Bookmark);
1912 Result := 'http://' + FDownloadHost
1913 + '/test/offlaw.cgi/' + ParentBoard.BBSID + '/'
1914 + ChangeFileExt(FileName, '') + '/?raw=.0&sid=' + HttpEncode(SessionID);
1915 // Result := Format('%s://%s%s%s', [Protocol,
1916 // DownloadHost,
1917 // Path,
1918 // Document]);
1919 end;
1920 end;
1921
1922 function TThreadItem.GetSendURL: string;
1923 begin
1924 Result := GikoSys.UrlToServer(ParentBoard.URL)
1925 + 'test/bbs.cgi';
1926 end;
1927
1928 procedure TThreadItem.DeleteLogFile;
1929 var
1930 tmpFileName: String;
1931 begin
1932 ParentBoard.BeginUpdate;
1933
1934 if FUnRead then
1935 ParentBoard.UnRead := ParentBoard.UnRead - 1;
1936 DeleteFile(GetThreadFileName);
1937 //荅??????mp?????ゃ?????帥??
1938 tmpFileName := StringReplace(GetThreadFileName, 'dat', 'tmp', [rfReplaceAll]);
1939 DeleteFile(tmpFileName);
1940
1941 if FileExists(ChangeFileExt(GetThreadFileName,'.NG')) = true then
1942 DeleteFile(ChangeFileExt(GetThreadFileName,'.NG'));
1943 FRoundDate := ZERO_DATE;
1944 FLastModified := ZERO_DATE;
1945 FSize := 0;
1946 FIsLogFile := False;
1947 FKokomade := -1;
1948 FNewReceive := 0;
1949 FNewArrival := False;
1950 FUnRead := False;
1951 FScrollTop := 0;
1952 FRound := False;
1953 FDownloadHost := '';
1954 FAgeSage := gasNone;
1955
1956 FCount := 0;
1957 FNewResCount := 0;
1958 FRoundName := '';
1959
1960 ParentBoard.EndUpdate;
1961 ParentBoard.Modified := True;
1962 end;
1963
1964 function TThreadItem.GetThreadFileName: string;
1965 begin
1966 if Length( FilePath ) > 0 then
1967 Result := FilePath
1968 else
1969 Result := GikoSys.Setting.LogFolderP
1970 + BBS2CH_LOG_FOLDER + PATH_DELIM + ParentBoard.BBSID + PATH_DELIM + FileName;
1971 end;
1972
1973 procedure TThreadItem.SetLastModified(d: TDateTime);
1974 begin
1975 if FLastModified = d then Exit;
1976 FLastModified := d;
1977 if FUpdate and (ParentBoard <> nil) then
1978 ParentBoard.FModified := True;
1979 end;
1980
1981 {procedure TThreadItem.SetRoundNo(i: Integer);
1982 begin
1983 if FRoundNo = i then Exit;
1984 FRoundNo := i;
1985 if FUpdate and (ParentBoard <> nil) then
1986 ParentBoard.FModified := True;
1987 end;}
1988
1989 procedure TThreadItem.SetRound(b: Boolean);
1990 begin
1991 if b then
1992 RoundList.Add(Self)
1993 else
1994 RoundList.Delete(Self);
1995 if FRound = b then Exit;
1996 FRound := b;
1997 if FUpdate and (ParentBoard <> nil) then
1998 ParentBoard.FModified := True;
1999 end;
2000
2001 procedure TThreadItem.SetRoundName(const s: string);
2002 begin
2003 if FRoundName = s then Exit;
2004 FRoundName := s;
2005 if FUpdate and (ParentBoard <> nil) then
2006 ParentBoard.FModified := True;
2007 end;
2008 {
2009 procedure TThreadItem.SetRoundName(const s: PChar);
2010 begin
2011 if FRoundName = s then Exit;
2012 FRoundName := s;
2013 if FUpdate and (ParentBoard <> nil) then
2014 ParentBoard.FModified := True;
2015 end;
2016 }
2017 procedure TThreadItem.SetKokomade(i: Integer);
2018 begin
2019 if FKokomade = i then Exit;
2020 FKokomade := i;
2021 if FUpdate and (ParentBoard <> nil) then
2022 ParentBoard.FModified := True;
2023 end;
2024
2025 procedure TThreadItem.SetUnRead(b: Boolean);
2026 begin
2027 if FUnRead = b then Exit;
2028 FUnRead := b;
2029 if FUpdate and (ParentBoard <> nil) then begin
2030 ParentBoard.FModified := True;
2031 if FUnRead then begin
2032 ParentBoard.UnRead := ParentBoard.UnRead + 1;
2033 end else begin
2034 ParentBoard.UnRead := ParentBoard.UnRead - 1;
2035 end;
2036 end;
2037 end;
2038
2039 procedure TThreadItem.SetScrollTop(i: Integer);
2040 begin
2041 if FScrollTop = i then Exit;
2042 FScrollTop := i;
2043 if FUpdate and (ParentBoard <> nil) then
2044 ParentBoard.FModified := True;
2045 end;
2046
2047 procedure TThreadItem.BeginUpdate;
2048 begin
2049 FUpdate := False;
2050 end;
2051
2052 procedure TThreadItem.EndUpdate;
2053 begin
2054 FUpdate := True;
2055 end;
2056
2057 {initialization
2058 BBS2ch := TBBS.Create;
2059
2060 finalization
2061 if BBS2ch <> nil then
2062 BBS2ch.Free;}
2063 function TThreadItem.GetCreateDate: TDateTime;
2064 var
2065 unixtime: Int64;
2066 tmp: string;
2067 begin
2068 // ???<?ゃ?????????鴻??????ユ????羆?????
2069 try
2070 if ( GikoSys.Setting.CreationTimeLogs ) and not IsLogFile then
2071 Result := ZERO_DATE
2072 else begin
2073 // ???違???<?ゃ?????≦宍絖??????????????????鴻??????ユ??
2074 tmp := ChangeFileExt(FFileName, '');
2075 if AnsiPos('_', tmp) <> 0 then
2076 if AnsiPos('_', tmp) > 9 then
2077 tmp := Copy(tmp, 1, AnsiPos('_', tmp)-1)
2078 else
2079 Delete(tmp, AnsiPos('_', tmp), 1);
2080
2081 if ( Length(tmp) = 9) and ( tmp[1] = '0' ) then
2082 Insert('1', tmp, 1);
2083
2084 unixtime := StrToInt64Def(tmp, ZERO_DATE);
2085 Result := UnixToDateTime(unixtime) + OffsetFromUTC;
2086 if GikoSys.Setting.FutureThread then begin
2087 if CompareDateTime(Result, Now) = 1 then
2088 Result := ZERO_DATE;
2089 end;
2090 end;
2091
2092 except
2093 on E: Exception do
2094 Result := ZERO_DATE;
2095 end;
2096 end;
2097 function TThreadItem.GetFilePath: String;
2098 var
2099 path : String;
2100 begin
2101 path := ExtractFilePath(Self.ParentBoard.FilePath) + Self.FileName;
2102 Result := path;
2103 end;
2104
2105 destructor TBoardGroup.Destroy;
2106 begin
2107 Clear;
2108 inherited;
2109 end;
2110 procedure TBoardGroup.Clear;
2111 var
2112 i : Integer;
2113 begin
2114 for i := Self.Count - 1 downto 0 do begin
2115 try
2116 TBoard(Self.Objects[i]).Free;
2117 except
2118 end;
2119 end;
2120 inherited Clear;
2121 Self.Capacity := 0;
2122 try
2123 if FBoardPlugIn <> nil then
2124 FBoardPlugIn.Free;
2125 FBoardPlugIn := nil;
2126 except
2127 end;
2128
2129 end;
2130
2131
2132 end.
2133

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