OSDN Git Service

スレッドのHTMLを作るところの最適化
[gikonavigoeson/gikonavi.git] / GikoSystem.pas
1 unit GikoSystem;
2
3 interface
4
5 uses
6         Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7         ComCtrls, IniFiles, ShellAPI, ActnList, Math,
8 {$IF Defined(DELPRO) }
9         SHDocVw,
10         MSHTML,
11 {$ELSE}
12         SHDocVw_TLB,
13         MSHTML_TLB,
14 {$IFEND}
15         {HttpApp,} YofUtils, URLMon, IdGlobal, IdURI, {Masks,}
16         Setting, BoardGroup, gzip, Dolib, bmRegExp, AbonUnit,
17         MojuUtils, ExternalBoardManager, ExternalBoardPlugInMain,
18         Sort, GikoBayesian;
19
20 type
21         //BBS\83^\83C\83v
22         TGikoBBSType = (gbt2ch);
23         //\83\8d\83O\83^\83C\83v
24         TGikoLogType = (glt2chNew, glt2chOld);
25         //\83\81\83b\83Z\81[\83W\83A\83C\83R\83\93
26         TGikoMessageIcon = (gmiOK, gmiSAD, gmiNG, gmiWhat, gmiNone);
27         //URL\83I\81[\83v\83\93\83u\83\89\83E\83U\83^\83C\83v
28         TGikoBrowserType = (gbtIE, gbtUserApp, gbtAuto);
29
30
31         TStrTokSeparator = set of Char;
32         TStrTokRec = record
33                 Str: string;
34                 Pos: Integer;
35         end;
36
37         //\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b\83\8c\83R\81[\83h
38         TIndexRec = record
39                 FNo: Integer;
40                 FFileName: string;
41                 FTitle: string;
42                 FCount: Integer;
43                 FSize: Integer;
44 //              FRoundNo: Integer;
45                 FRoundDate: TDateTime;
46                 FLastModified: TDateTime;
47                 FKokomade: Integer;
48                 FNewReceive: Integer;
49                 FMishiyou: Boolean;     //\96¢\8eg\97p
50                 FUnRead: Boolean;
51                 FScrollTop: Integer;
52                 //Index Ver 1.01
53                 FAllResCount: Integer;
54                 FNewResCount: Integer;
55                 FAgeSage: TGikoAgeSage;
56         end;
57
58         //\83T\83u\83W\83F\83N\83g\83\8c\83R\81[\83h
59         TSubjectRec = record
60                 FFileName: string;
61                 FTitle: string;
62                 FCount: Integer;
63         end;
64
65         //\83\8c\83X\83\8c\83R\81[\83h
66         TResRec = record
67                 FTitle: string;
68                 FMailTo: string;
69                 FName: string;
70                 FDateTime: string;
71                 FBody: string;
72                 FType: TGikoLogType;
73         end;
74
75         //URLPath\83\8c\83R\81[\83h
76         TPathRec = record
77                 FBBS: string;                           //BBSID
78                 FKey: string;                           //ThreadID
79                 FSt: Int64;                             //\8aJ\8en\83\8c\83X\94Ô
80                 FTo: Int64;                             //\8fI\97¹\83\8c\83X\94Ô
81                 FFirst: Boolean;                //>>1\82Ì\95\\8e¦
82                 FStBegin: Boolean;      //1\81`\95\\8e¦
83                 FToEnd: Boolean;                //\81`\8dÅ\8cã\82Ü\82Å\95\\8e¦
84                 FDone: Boolean;                 //\90¬\8c÷
85                 FNoParam: Boolean;              //\83\8c\83X\94Ô\83p\83\89\83\81\81[\83^\82È\82µ
86         end;
87
88         TGikoSys = class(TObject)
89         private
90                 { Private \90é\8c¾ }
91                 FSetting: TSetting;
92                 FDolib: TDolib;
93                 FAWKStr: TAWKStr;
94                 FResRange : Longint;
95                 FBayesian       : TGikoBayesian;        //!< \83x\83C\83W\83A\83\93\83t\83B\83\8b\83^
96
97 //              FExitWrite: TStringList;
98 //              function StrToFloatDef(s: string; Default: Double): Double;
99                 function SetUserOptionalStyle(): string;
100         public
101                 { Public \90é\8c¾ }
102                 FAbon : TAbon;
103                 FSelectResFilter : TAbon;
104                 FBoardURLList: TStringList;
105                 constructor Create;
106
107                 destructor Destroy; override;
108                 property ResRange : Longint read FResRange write FResRange;
109 //              function MsgBox(Msg: string; Title: string; Flags: Longint): integer; overload;
110 //              function MsgBox(Handle: THandle; Msg: string; Title: string; Flags: Longint): integer; overload;
111                 function IsNumeric(s: string): boolean;
112                 function IsFloat(s: string): boolean;
113                 function DirectoryExistsEx(const Name: string): Boolean;
114                 function ForceDirectoriesEx(Dir: string): Boolean;
115 //              function GetVersion: string;
116
117                 function GetBoardFileName: string;
118                 function GetCustomBoardFileName: string;
119                 function GetHtmlTempFileName: string;
120                 function GetAppDir: string;
121                 function GetTempFolder: string;
122                 function GetSentFileName: string;
123                 function GetConfigDir: string;
124                 function GetSkinDir: string;
125                 function GetSkinHeaderFileName: string;
126                 function GetSkinFooterFileName: string;
127                 function GetSkinResFileName: string;
128                 function GetSkinNewResFileName: string;
129                 function GetSkinBookmarkFileName: string;
130                 function GetSkinNewmarkFileName: string;
131                 function GetStyleSheetDir: string;
132                 function GetOutBoxFileName: string;
133                 function GetUserAgent: string;
134                                 function GetSambaFileName : string;
135
136                 procedure ReadSubjectFile(Board: TBoard);
137                 procedure CreateThreadDat(Board: TBoard);
138                 procedure WriteThreadDat(Board: TBoard);
139                 function ParseIndexLine(Line: string): TIndexRec;
140                 procedure GetFileList(Path: string; Mask: string; var List: TStringList; SubDir: Boolean; IsPathAdd: Boolean); overload;
141                 procedure GetFileList(Path: string; Mask: string; var List: TStringList; IsPathAdd: Boolean); overload;//\83T\83u\83t\83H\83\8b\83_\82Í\8c\9f\8dõ\82µ\82È\82¢
142                 procedure GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
143
144                 procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
145                 procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
146                 function AddAnchorTag(s: string): string;
147
148                 function DivideSubject(Line: string): TSubjectRec;
149                 function DivideStrLine(Line: string): TResRec;
150
151                 property Setting: TSetting read FSetting write FSetting;
152                 property Dolib: TDolib read FDolib write FDolib;
153
154                 function UrlToID(url: string): string;
155                 function UrlToServer(url: string): string;
156
157                 function StrTokFirst(const s:string; const sep:TStrTokSeparator; var Rec:TStrTokRec):string;
158                 function StrTokNext(const sep:TStrTokSeparator; var Rec:TStrTokRec): string;
159
160                 function GetFileSize(FileName : string) : longint;
161                 function GetFileLineCount(FileName : string): longint;
162                 function Get2chDate(aDate: TDateTime): string;
163                 function IntToDateTime(val: Int64): TDateTime;
164                 function DateTimeToInt(ADate: TDateTime): Int64;
165
166                 function ReadThreadFile(FileName: string; Line: Integer): string;
167
168                 procedure MenuFont(Font: TFont);
169
170                 function RemoveToken(var s:string; const delimiter:string):string;
171                 function GetTokenIndex(s: string; delimiter: string; index: Integer): string;
172                 function DeleteLink(const s: string): string;
173
174                 function GetShortName(const LongName: string; ALength: integer): string;
175                 function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;
176                 function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue, FullURL : string): string; overload;
177                 function ConvertResAnchor(res: string): string;
178                 function BoolToInt(b: Boolean): Integer;
179                 function IntToBool(i: Integer): Boolean;
180                 function GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
181                 procedure LoadKeySetting(ActionList: TActionList);
182                 procedure SaveKeySetting(ActionList: TActionList);
183                 procedure LoadEditorKeySetting(ActionList: TActionList);
184                 procedure SaveEditorKeySetting(ActionList: TActionList);
185
186                 procedure CreateProcess(const AppPath: string; const Param: string);
187                 procedure OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
188                 function HTMLDecode(const AStr: String): String;
189                 function GetHRefText(s: string): string;
190                 function Is2chHost(Host: string): Boolean;
191                 function Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
192                 function Parse2chURL2(URL: string): TPathRec;
193                 procedure ParseURI(const URL : string; var Protocol, Host, Path, Document, Port, Bookmark: string);
194                 function GetVersionBuild: Integer;
195                 function        GetBrowsableThreadURL( inURL : string ) : string;
196                 function        GetThreadURL2BoardURL( inURL : string ) : string;
197                 function        Get2chThreadURL2BoardURL( inURL : string ) : string;
198                 function        Get2chBrowsableThreadURL( inURL : string ) : string;
199                 function        Get2chBoard2ThreadURL( inBoard : TBoard; inKey : string ) : string;
200                 procedure ListBoardFile;
201                 procedure ReadBoardFile( bbs : TBBS );
202
203                 function        GetUnknownCategory : TCategory;
204                 function        GetUnknownBoard( inPlugIn : TBoardPlugIn; inURL : string ) : TBoard;
205
206                 procedure GetPopupResNumber(URL : string; var stRes, endRes : Int64);
207
208                 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
209                 function LoadFromSkin( fileName: string; ThreadItem: TThreadItem; SizeByte: Integer ): string;
210         // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
211                 function SkinedRes( skin: string; Res: TResRec; No: string ): string;
212
213                 //Samba24\82Ì\83t\83@\83C\83\8b\82ª\91\8dÝ\82·\82é\82©\81B\91\8dÝ\82µ\82È\82¢\8fê\8d\87\81Adefault\83t\83@\83C\83\8b\82ðrename\82·\82é
214                                 procedure SambaFileExists();
215
216                 property Bayesian : TGikoBayesian read FBayesian write FBayesian;
217                 function GetSameIDResAnchor(const AID : string; ThreadItem: TThreadItem):string; overload;
218                 function GetSameIDResAnchor(AIDNum : Integer; ThreadItem: TThreadItem):string; overload;
219                 procedure GetSameIDRes(const AID : string; ThreadItem: TThreadItem;var body: TStringList); overload;
220                 procedure GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList); overload;
221                 //! \92P\8cê\89ð\90Í
222                 procedure SpamCountWord( const text : string; wordCount : TWordCount );
223                 //! \8aw\8fK\83N\83\8a\83A
224                 procedure SpamForget( wordCount : TWordCount; isSpam : Boolean );
225                 //! \83X\83p\83\80\8aw\8fK
226                 procedure SpamLearn( wordCount : TWordCount; isSpam : Boolean );
227                 //! \83X\83p\83\80\93x\90\94
228                 function SpamParse( const text : string; wordCount : TWordCount ) : Extended;
229         //\88ø\90\94\82ª\81A\93ú\95t\82Å\82à\8e\9e\8d\8f\82Å\82à\82È\82¢\82±\82Æ\82ð\92²\82×\82é
230                 function NotDateorTimeString(const AStr : string): boolean;
231         end;
232
233 var
234         GikoSys: TGikoSys;
235 const
236         //LENGTH_RESTITLE                       = 40;
237         ZERO_DATE: Integer      = 25569;
238         BETA_VERSION_NAME_E = 'beta';
239         BETA_VERSION_NAME_J = 'ÊÞÀ';
240         BETA_VERSION                            = 50;
241         BETA_VERSION_BUILD      = '';                           //debug\94Å\82È\82Ç
242         APP_NAME                                                = 'gikoNavi';
243
244 implementation
245
246 uses
247         Giko, RoundData, Favorite;
248
249 const
250         FOLDER_INDEX_VERSION                                    = '1.01';
251         USER_AGENT                                                                              = 'Monazilla';
252         DEFAULT_NGWORD_FILE_NAME : String = 'NGword.txt';
253         NGWORDs_DIR_NAME : String               = 'NGwords';
254
255         READ_PATH: string =                     '/test/read.cgi/';
256         OLD_READ_PATH: string =         '/test/read.cgi?';
257         KAKO_PATH: string =                     '/kako/';
258
259 (*************************************************************************
260  *GikoSys\83R\83\93\83X\83g\83\89\83N\83^
261  *************************************************************************)
262 constructor TGikoSys.Create;
263 begin
264         FSetting := TSetting.Create;
265         FDolib := TDolib.Create;
266         FAWKStr := TAWKStr.Create(nil);
267         if DirectoryExists(GetConfigDir) = false then begin
268                 CreateDir(GetConfigDir);
269         end;
270         FAbon := TAbon.Create;
271         FAbon.Setroot(GetConfigDir+NGWORDs_DIR_NAME);
272         FAbon.GoHome;
273         FAbon.ReturnNGwordLineNum := FSetting.ShowNGLinesNum;
274         FAbon.SetNGResAnchor := FSetting.AddResAnchor;
275     FAbon.DeleteSyria := FSetting.DeleteSyria;
276         FAbon.Deleterlo := FSetting.AbonDeleterlo;
277         FAbon.Replaceul := FSetting.AbonReplaceul;
278         FAbon.AbonPopupRes := FSetting.PopUpAbon;
279
280         FSelectResFilter := TAbon.Create;
281         // \8di\82è\8d\9e\82Þ\82Æ\82«\82Í\8bÉ\97Í\88ê\97\97\82ª\8c©\82ç\82ê\82é\82Ù\82¤\82ª\82¢\82¢\82Ì\82Å\91¼\82Í\8a®\91S\82É\8dí\8f\9c
282         FSelectResFilter.AbonString := '';
283         //
284         ResRange := FSetting.ResRange;
285         FBayesian := TGikoBayesian.Create;
286         FBoardURLList := TStringList.Create;
287 end;
288
289 (*************************************************************************
290  *GikoSys\83f\83X\83g\83\89\83N\83^
291  *************************************************************************)
292 destructor TGikoSys.Destroy;
293 var
294         i: Integer;
295         FileList: TStringList;
296 begin
297         //\83X\83\8c\83b\83h\83f\81[\83^\83t\83@\83C\83\8b\82ð\8dX\90V
298 //      FlashExitWrite;
299
300 //      FExitWrite.Free;
301         FBayesian.Free;
302         FAWKStr.Free;
303         FSetting.Free;
304         FDolib.Free;
305         FAbon.Free;
306         FSelectResFilter.Free;
307         FBoardURLList.Free;
308         //\83e\83\93\83|\83\89\83\8aHTML\82ð\8dí\8f\9c
309         FileList := TStringList.Create;
310         try
311                 GetFileList(GetTempFolder, '*.html', FileList, False, True);
312                 for i := 0 to FileList.Count - 1 do begin
313                         DeleteFile(FileList[i]);
314                 end;
315         finally
316                 FileList.Free;
317         end;
318         inherited;
319 end;
320
321 (*************************************************************************
322  *\95\8e\9a\97ñ\90\94\8e\9a\83`\83F\83b\83N
323  *************************************************************************)
324 {$HINTS OFF}
325 function TGikoSys.IsNumeric(s: string): boolean;
326 var
327         e: integer;
328         v: integer;
329 begin
330         Val(s, v, e);
331         Result := e = 0;
332 end;
333 {$HINTS ON}
334
335 (*************************************************************************
336  *\95\8e\9a\97ñ\95\82\93®\8f¬\90\94\93_\90\94\8e\9a\83`\83F\83b\83N
337  *************************************************************************)
338 function TGikoSys.IsFloat(s: string): boolean;
339 var
340         v: Extended;
341 begin
342         Result := TextToFloat(PChar(s), v, fvExtended);
343 end;
344
345 (*************************************************************************
346  *\83{\81[\83h\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
347  *************************************************************************)
348 function TGikoSys.GetBoardFileName: string;
349 begin
350         Result := Setting.GetBoardFileName;
351 end;
352
353 (*************************************************************************
354  *\83{\81[\83h\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
355  *************************************************************************)
356 function TGikoSys.GetCustomBoardFileName: string;
357 begin
358         Result := Setting.GetCustomBoardFileName;
359 end;
360
361 (*************************************************************************
362  *\83e\83\93\83|\83\89\83\8a\83t\83H\83\8b\83_\81[\96¼\8eæ\93¾
363  *************************************************************************)
364 function TGikoSys.GetHtmlTempFileName: string;
365 begin
366         Result := Setting.GetHtmlTempFileName;
367 end;
368
369
370 (*************************************************************************
371  *\8eÀ\8ds\83t\83@\83C\83\8b\83t\83H\83\8b\83_\8eæ\93¾
372  *************************************************************************)
373 function TGikoSys.GetAppDir: string;
374 begin
375         Result := Setting.GetAppDir;
376 end;
377
378 (*************************************************************************
379  *TempHtml\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
380  *************************************************************************)
381 function TGikoSys.GetTempFolder: string;
382 begin
383         Result := Setting.GetTempFolder;
384 end;
385
386 (*************************************************************************
387  *sent.ini\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
388  *************************************************************************)
389 function TGikoSys.GetSentFileName: string;
390 begin
391         Result := Setting.GetSentFileName;
392 end;
393
394 (*************************************************************************
395  *outbox.ini\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
396  *************************************************************************)
397 function TGikoSys.GetOutBoxFileName: string;
398 begin
399         Result := Setting.GetOutBoxFileName;
400 end;
401
402 (*************************************************************************
403  *Config\83t\83H\83\8b\83_\8eæ\93¾
404  *************************************************************************)
405 function TGikoSys.GetConfigDir: string;
406 begin
407         Result := Setting.GetConfigDir;
408 end;
409
410 function TGikoSys.GetStyleSheetDir: string;
411 begin
412         Result := Setting.GetStyleSheetDir;
413 end;
414
415 function TGikoSys.GetSkinDir: string;
416 begin
417         Result := Setting.GetSkinDir;
418 end;
419
420 function TGikoSys.GetSkinHeaderFileName: string;
421 begin
422         Result := Setting.GetSkinHeaderFileName;
423 end;
424
425 function TGikoSys.GetSkinFooterFileName: string;
426 begin
427         Result := Setting.GetSkinFooterFileName;
428 end;
429
430 function TGikoSys.GetSkinNewResFileName: string;
431 begin
432         Result := Setting.GetSkinNewResFileName;
433 end;
434
435 function TGikoSys.GetSkinResFileName: string;
436 begin
437         Result := Setting.GetSkinResFileName;
438 end;
439
440 function TGikoSys.GetSkinBookmarkFileName: string;
441 begin
442         Result := Setting.GetSkinBookmarkFileName;
443 end;
444
445 function TGikoSys.GetSkinNewmarkFileName: string;
446 begin
447         Result := Setting.GetSkinNewmarkFileName;
448 end;
449
450 // UserAgent\8eæ\93¾
451 function TGikoSys.GetUserAgent: string;
452 begin
453         if Dolib.Connected then begin
454                 Result := Format('%s %s/%s%d%s', [
455                                                                 Dolib.UserAgent,
456                                                                 APP_NAME,
457                                                                 //MAJOR_VERSION,
458                                                                 //MINOR_VERSION,
459                                                                 BETA_VERSION_NAME_E,
460                                                                 BETA_VERSION,
461                                                                 BETA_VERSION_BUILD]);
462         end else begin
463                 Result := Format('%s/%s %s/%s%d%s', [
464                                                                 USER_AGENT,
465                                                                 Dolib.Version,
466                                                                 APP_NAME,
467                                                                 //MAJOR_VERSION,
468                                                                 //MINOR_VERSION,
469                                                                 BETA_VERSION_NAME_E,
470                                                                 BETA_VERSION,
471                                                                 BETA_VERSION_BUILD]);
472         end;
473 end;
474
475 (*************************************************************************
476  *\82Q\82¿\82á\82ñ\82Ë\82é\95û\8e®\8e\9e\8d\8f\8eæ\93¾
477  *************************************************************************)
478 function TGikoSys.Get2chDate(aDate: TDateTime): string;
479 var
480         d1: TDateTime;
481         d2: TDateTime;
482 begin
483         d1 := EncodeDate(1970, 1, 1);
484         d2 := aDate - EncodeTime(9, 0, 0, 0);
485         //Result := FloatToStr(Trunc((d2 - d1) * 24 * 60 * 60));
486         Result := FloatToStr(Trunc((d2 - d1) * 86400));
487 end;
488
489
490 function TGikoSys.IntToDateTime(val: Int64): TDateTime;
491 var
492         d1: tdatetime;
493         d2: tdatetime;
494 begin
495         d1 := EncodeDate(1970, 1, 1);
496         d2 := val / 86400.0;//(val * 1000) / (24 * 60 * 60 * 1000);
497         Result := d1 + d2;
498 end;
499
500 function TGikoSys.DateTimeToInt(ADate: TDateTime): Int64;
501 var
502         d: TDateTime;
503         c: Currency;
504 begin
505         d := EncodeDate(1970, 1, 1);
506         c := (ADate - d) * 86400; //(ADate - d) * 24 * 60 * 60;
507         Result := Trunc(c);
508 end;
509
510
511 (*************************************************************************
512  *Subject\83t\83@\83C\83\8bRead
513  *************************************************************************)
514 procedure TGikoSys.ReadSubjectFile(Board: TBoard);
515 var
516         ThreadItem: TThreadItem;
517         FileName: string;
518         FileList: TStringList;
519         TmpFileList: TStringList;
520         Index: Integer;
521         sl: TStringList;
522         i: Integer;
523         Rec: TIndexRec;
524         UnRead: Integer;
525         ini: TMemIniFile;
526         ResRec: TResRec;
527         RoundItem: TRoundItem;
528         idx: Integer;
529         usePlugIn : Boolean;
530         tmpStr: string;
531         {*
532         FavoThreadItem : TFavoriteThreadItem;
533         Node: TTreeNode;
534         *}
535 begin
536         if Board.IsThreadDatRead then
537                 Exit;
538         Board.Clear;
539         UnRead := 0;
540
541         usePlugIn := Board.IsBoardPlugInAvailable;
542
543         FileName := Board.GetFolderIndexFileName;
544
545         FileList := TStringList.Create;
546         FileList.Sorted := True;
547         TmpFileList := TStringList.Create;
548         TmpFileList.Sorted := True;
549
550         //IsLogFile\97pDAT\83t\83@\83C\83\8b\83\8a\83X\83g
551         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.dat', FileList, False);
552         //\91O\89ñ\88Ù\8fí\8fI\97¹\8e\9e\97pTmp\83t\83@\83C\83\8b\83\8a\83X\83g
553         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, False);
554
555         // \8fd\95¡\82ð\96h\82®
556         Board.BeginUpdate;
557         Board.Sorted := True;
558
559         sl := TStringList.Create;
560         try
561                 if FileExists(FileName) then begin
562                         sl.LoadFromFile(FileName);
563
564                         //\82Q\8ds\96Ú\82©\82ç\81i\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93\81j
565                         for i := sl.Count - 1 downto 1 do begin
566                                 Rec := ParseIndexLine(sl[i]);
567                                 if usePlugIn then
568                                         ThreadItem := TThreadItem.Create(
569                                                         Board.BoardPlugIn,
570                                                         Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), Rec.FFileName ) )
571                                 else
572                                         ThreadItem := TThreadItem.Create(
573                                                 nil,
574                                                 Get2chBoard2ThreadURL( Board, ChangeFileExt( Rec.FFileName, '' ) ) );
575
576                                 if FileList.Count <> 0 then
577                                         if FileList.Find( ThreadItem.FileName, Index ) then
578                                                 FileList.Delete( Index );
579
580                                 ThreadItem.BeginUpdate;
581                                 ThreadItem.No := Rec.FNo;
582                                 ThreadItem.FileName := Rec.FFileName;
583                                 ThreadItem.Title := Rec.FTitle;
584                                 //ThreadItem.ShortTitle := CustomStringReplace(ZenToHan(ThreadItem.Title), ' ', '');
585                                 ThreadItem.Count := Rec.FCount;
586                                 ThreadItem.Size := Rec.FSize;
587 //                      ThreadItem.RoundNo := Rec.FRoundNo;
588                                 ThreadItem.RoundDate := Rec.FRoundDate;
589                                 ThreadItem.LastModified := Rec.FLastModified;
590                                 ThreadItem.Kokomade := Rec.FKokomade;
591                                 ThreadItem.NewReceive := Rec.FNewReceive;
592 //                      ThreadItem.Round := Rec.FRound;
593                                 ThreadItem.UnRead := Rec.FUnRead;
594                                 ThreadItem.ScrollTop := Rec.FScrollTop;
595                                 ThreadItem.AllResCount := Rec.FAllResCount;
596                                 ThreadItem.NewResCount := Rec.FNewResCount;
597                                 ThreadItem.AgeSage := Rec.FAgeSage;
598                                 ThreadItem.ParentBoard := Board;
599                                 {* \82¨\8bC\82É\93ü\82è\91å\97Ê\90\90¬\83R\81[\83h *}
600                                 {*
601                                 FavoThreadItem := TFavoriteThreadItem.Create( ThreadItem.URL, ThreadItem.Title, ThreadItem );
602                                 Node := FavoriteDM.TreeView.Items.AddChildObject( FavoriteDM.TreeView.Items.Item[0], ThreadItem.Title, FavoThreadItem);
603                                 *}
604
605                                 //\8f\84\89ñ\83\8a\83X\83g\82É\91\8dÝ\82µ\82½\82ç\8f\84\89ñ\83t\83\89\83O\83Z\83b\83g
606                                 if ThreadItem.IsLogFile then begin
607                                         idx := RoundList.Find(ThreadItem);
608                                         if idx <> -1 then begin
609                                                 RoundItem := RoundList.Items[idx, grtItem];
610                                                 ThreadItem.RoundName := RoundItem.RoundName;
611                                                 ThreadItem.Round := True;
612                                         end;
613                                 end;
614
615                                 //\91O\89ñ\88Ù\8fí\8fI\97¹\8e\9e\83`\83F\83b\83N
616                                 if TmpFileList.Count <> 0 then begin
617                                         if TmpFileList.Find(ChangeFileExt(ThreadItem.FileName, '.tmp'), Index) then begin
618                                                 ini := TMemIniFile.Create(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[Index]);
619                                                 try
620                                                         tmpStr := ini.ReadString('Setting', 'RoundDate', DateTimeToStr(ZERO_DATE));
621                                                         ThreadItem.RoundDate := ConvertDateTimeString(tmpStr);
622
623                                                         tmpStr := ini.ReadString('Setting', 'LastModified', DateTimeToStr(ZERO_DATE));
624                                                         ThreadItem.LastModified := ConvertDateTimeString(tmpStr);
625                                                         ThreadItem.Count := ini.ReadInteger('Setting', 'Count', 0);
626                                                         ThreadItem.NewReceive := ini.ReadInteger('Setting', 'NewReceive', 0);
627
628                                                         ThreadItem.Size := ini.ReadInteger('Setting', 'Size', 0);
629                                                         if(ThreadItem.Size = 0) and (FileExists(ThreadItem.GetThreadFileName)) then begin
630                                                                 try
631                                                                         ThreadItem.Size := GetFileSize(ThreadItem.GetThreadFileName) - ThreadItem.Count;
632                                                                 except
633                                                                 end;
634                                                         end;
635
636
637                                                         ThreadItem.Round := ini.ReadBool('Setting', 'Round', False);
638                                                         ThreadItem.UnRead := False;//ini.ReadBool('Setting', 'UnRead', False);
639                                                         ThreadItem.ScrollTop := ini.ReadInteger('Setting', 'ScrollTop', 0);
640                                                         ThreadItem.AllResCount := ini.ReadInteger('Setting', 'AllResCount', ThreadItem.Count);
641                                                         ThreadItem.NewResCount := ini.ReadInteger('Setting', 'NewResCount', 0);
642                                                         ThreadItem.AgeSage := TGikoAgeSage(ini.ReadInteger('Setting', 'AgeSage', Ord(gasNone)));
643                                                 finally
644                                                         ini.Free;
645                                                 end;
646                                                 DeleteFile(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[Index]);
647                                                 TmpFileList.Delete(Index);
648                                         end;
649                                 end;
650
651                                 ThreadItem.EndUpdate;
652                                 Board.Add(ThreadItem);
653
654                                 if (ThreadItem.IsLogFile) and (ThreadItem.UnRead) then
655                                         Inc(UnRead);
656                         end;
657                 end;
658
659                 if UnRead <> Board.UnRead then
660                         Board.UnRead := UnRead;
661
662                 //\83C\83\93\83f\83b\83N\83X\82É\96³\82©\82Á\82½\83\8d\83O\82ð\92Ç\89Á\81i\95\85\82ê\83C\83\93\83f\83b\83N\83X\91Î\89\9e\81j
663                 for i := 0 to FileList.Count - 1 do begin
664                         FileName := ExtractFileDir(Board.GetFolderIndexFileName) + '\' + FileList[i];
665
666                         //ResRec := DivideStrLine(ReadThreadFile(FileName, 1));
667                         if usePlugIn then begin
668                                 ThreadItem := TThreadItem.Create(
669                                         Board.BoardPlugIn,
670                                         Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), FileList[i] ) );
671                                 ResRec := DivideStrLine(Board.BoardPlugIn.GetDat( DWORD( ThreadItem ), 1 ));
672                         end else begin
673                                 ThreadItem := TThreadItem.Create(
674                                         nil, Get2chBoard2ThreadURL( Board, ChangeFileExt( FileList[i], '' ) ) );
675                                 ResRec := DivideStrLine(ReadThreadFile(FileName, 1));
676                         end;
677
678                         ThreadItem.BeginUpdate;
679                         ThreadItem.FilePath := FileName;
680                         ThreadItem.No := Board.Count + 1;
681                         ThreadItem.FileName := FileList[i];
682                         ThreadItem.Title := ResRec.FTitle;
683                         ThreadItem.Count := GetFileLineCount(FileName);
684                         ThreadItem.AllResCount := ThreadItem.Count;
685                         ThreadItem.NewResCount := ThreadItem.Count;
686                         ThreadItem.Size := GetFileSize(FileName) - ThreadItem.Count;//1byte\82¸\82ê\82é\82Æ\82«\82ª\82 \82é\82¯\82Ç\82»\82ê\82Í\82 \82«\82ç\82ß\82é
687                         ThreadItem.RoundDate := ZERO_DATE;
688                         ThreadItem.LastModified := ZERO_DATE;
689                         ThreadItem.Kokomade := -1;
690                         ThreadItem.NewReceive := ThreadItem.Count;
691                         ThreadItem.ParentBoard := Board;
692                         ThreadItem.IsLogFile := True;
693                         ThreadItem.Round := False;
694                         ThreadItem.UnRead := False;
695                         ThreadItem.ScrollTop := 0;
696                         ThreadItem.AgeSage := gasNone;
697                         ThreadItem.EndUpdate;
698                         Board.Add(ThreadItem);
699                 end;
700                 Board.EndUpdate;
701         finally
702                 sl.Free;
703                 FileList.Free;
704                 TmpFileList.Free;
705                 Board.Sorted := False;
706         end;
707         Board.IsThreadDatRead := True;
708 end;
709
710 (*************************************************************************
711  *\83X\83\8c\83b\83h\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b(Folder.idx)\8dì\90¬
712  *************************************************************************)
713 procedure TGikoSys.CreateThreadDat(Board: TBoard);
714 var
715         i: integer;
716         s: string;
717         SubjectList: TStringList;
718         sl: TStringList;
719         Rec: TSubjectRec;
720         FileName: string;
721         cnt: Integer;
722 begin
723         if not FileExists(Board.GetSubjectFileName) then Exit;
724         FileName := Board.GetFolderIndexFileName;
725
726         SubjectList := TStringList.Create;
727         try
728                 SubjectList.LoadFromFile(Board.GetSubjectFileName);
729                 sl := TStringList.Create;
730                 try
731                         cnt := 1;
732                         sl.Add(FOLDER_INDEX_VERSION);
733                         for i := 0 to SubjectList.Count - 1 do begin
734                                 Rec := DivideSubject(SubjectList[i]);
735
736                                 if (Trim(Rec.FFileName) = '') or (Trim(Rec.FTitle) = '') then
737                                         Continue;
738
739                                 s := Format('%x', [cnt]) + #1                                   //\94Ô\8d\86
740                                          + Rec.FFileName + #1                                                           //\83t\83@\83C\83\8b\96¼
741                                          + Rec.FTitle + #1                                                                      //\83^\83C\83g\83\8b
742                                          + Format('%x', [Rec.FCount]) + #1      //\83J\83E\83\93\83g
743                                          + Format('%x', [0]) + #1                                               //size
744                                          + Format('%x', [0]) + #1                                               //RoundDate
745                                          + Format('%x', [0]) + #1                                               //LastModified
746                                          + Format('%x', [0]) + #1                                               //Kokomade
747                                          + Format('%x', [0]) + #1                                               //NewReceive
748                                          + '0' + #1                                                                                             //\96¢\8eg\97p
749                                          + Format('%x', [0]) + #1                                               //UnRead
750                                          + Format('%x', [0]) + #1                                               //ScrollTop
751                                          + Format('%x', [Rec.FCount]) + #1      //AllResCount
752                                          + Format('%x', [0]) + #1                                               //NewResCount
753                                          + Format('%x', [0]);                                                           //AgeSage
754
755                                 sl.Add(s);
756                                 inc(cnt);
757                         end;
758                         sl.SaveToFile(FileName);
759                 finally
760                         sl.Free;
761                 end;
762         finally
763                 SubjectList.Free;
764         end;
765 end;
766
767 (*************************************************************************
768  *\83X\83\8c\83b\83h\83C\83\93\83f\83b\83N\83X(Thread.dat)\8f\91\82«\8d\9e\82Ý
769  *Public
770  *************************************************************************)
771 procedure TGikoSys.WriteThreadDat(Board: TBoard);
772 //const
773 //      Values: array[Boolean] of string = ('0', '1');
774 var
775         i: integer;
776         FileName: string;
777         sl: TStringList;
778         s: string;
779         TmpFileList: TStringList;
780 begin
781         if not Board.IsThreadDatRead then
782                 Exit;
783         FileName := Board.GetFolderIndexFileName;
784         ForceDirectoriesEx( ExtractFilePath( FileName ) );
785
786         sl := TStringList.Create;
787         TmpFileList := TStringList.Create;
788         TmpFileList.Sorted := true;
789         try
790                 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, false);
791                 sl.BeginUpdate;
792                 sl.Add(FOLDER_INDEX_VERSION);
793
794                 // \83X\83\8c\94Ô\8d\86\95Û\91\82Ì\82½\82ß\83\\81[\83g
795                 Sort.SortNoFlag := true;
796                 Sort.SortOrder := true;
797                 Sort.SortIndex := 0;
798                 //Sort.SortNonAcquiredCountFlag := GikoSys.Setting.NonAcquiredCount;
799                 Board.CustomSort(ThreadItemSortProc);
800
801                 for i := 0 to Board.Count - 1 do begin
802                         Board.Items[i].No := i + 1;
803                         s := Format('%x', [Board.Items[i].No]) + #1
804                                  + Board.Items[i].FileName + #1
805                                  + Board.Items[i].Title + #1
806                                  + Format('%x', [Board.Items[i].Count]) + #1
807                                  + Format('%x', [Board.Items[i].Size]) + #1
808                                  + Format('%x', [DateTimeToInt(Board.Items[i].RoundDate)]) + #1
809                                  + Format('%x', [DateTimeToInt(Board.Items[i].LastModified)]) + #1
810                                  + Format('%x', [Board.Items[i].Kokomade]) + #1
811                                  + Format('%x', [Board.Items[i].NewReceive]) + #1
812                                  + '0' + #1     //\96¢\8eg\97p
813                                  + Format('%x', [BoolToInt(Board.Items[i].UnRead)]) + #1
814                                  + Format('%x', [Board.Items[i].ScrollTop]) + #1
815                                  + Format('%x', [Board.Items[i].AllResCount]) + #1
816                                  + Format('%x', [Board.Items[i].NewResCount]) + #1
817                                  + Format('%x', [Ord(Board.Items[i].AgeSage)]);
818
819                         sl.Add(s);
820                 end;
821                 sl.EndUpdate;
822                 sl.SaveToFile(FileName);
823
824                 for i := 0 to TmpFileList.Count - 1 do begin
825                         DeleteFile(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[i]);
826                 end;
827
828         finally
829                 TmpFileList.Free;
830                 sl.Free;
831         end;
832 end;
833
834 function TGikoSys.ParseIndexLine(Line: string): TIndexRec;
835 begin
836         Result.FNo := StrToIntDef('$' + RemoveToken(Line, #1), 0);
837         Result.FFileName := RemoveToken(Line, #1);
838         Result.FTitle := RemoveToken(Line, #1);
839         Result.FCount := StrToIntDef('$' + RemoveToken(Line, #1), 0);
840         Result.FSize := StrToIntDef('$' + RemoveToken(Line, #1), 0);
841         Result.FRoundDate := IntToDateTime(StrToIntDef('$' + RemoveToken(Line, #1), ZERO_DATE));
842         Result.FLastModified := IntToDateTime(StrToIntDef('$' + RemoveToken(Line, #1), ZERO_DATE));
843         Result.FKokomade := StrToIntDef('$' + RemoveToken(Line, #1), -1);
844         Result.FNewReceive := StrToIntDef('$' + RemoveToken(Line, #1), 0);
845         RemoveToken(Line, #1);//9: ;    //\96¢\8eg\97p
846         Result.FUnRead := IntToBool(StrToIntDef('$' + RemoveToken(Line, #1), 0));
847         Result.FScrollTop := StrToIntDef('$' + RemoveToken(Line, #1), 0);
848         Result.FAllResCount := StrToIntDef('$' + RemoveToken(Line, #1), 0);
849         Result.FNewResCount := StrToIntDef('$' + RemoveToken(Line, #1), 0);
850         Result.FAgeSage := TGikoAgeSage(StrToIntDef('$' + RemoveToken(Line, #1), 0));
851
852 end;
853
854 //\8ew\92è\83t\83H\83\8b\83_\93à\82Ì\8ew\92è\83t\83@\83C\83\8b\88ê\97\97\82ð\8eæ\93¾\82·\82é
855 // ListFiles('c:\', '*.txt', list, True);
856 procedure TGikoSys.GetFileList(Path: string; Mask: string; var List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
857 var
858         rc: Integer;
859         SearchRec : TSearchRec;
860         s: string;
861         maskExt: string;
862 begin
863         maskExt := Copy(Mask, 1, Length(Mask) - 1);
864
865         Path := IncludeTrailingPathDelimiter(Path);
866         rc := FindFirst(Path + '*.*', faAnyfile, SearchRec);
867         try
868                 while rc = 0 do begin
869                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
870                                 s := Path + SearchRec.Name;
871                                 //if (SearchRec.Attr and faDirectory > 0) then
872                                 //      s := IncludeTrailingPathDelimiter(s)
873
874                                 if (SearchRec.Attr and faDirectory = 0) and (MatchesMask(s, Mask)) then
875                                                 if IsPathAdd then
876                                                         List.Add(s)
877                                                 else
878                                                         List.Add(SearchRec.Name);
879                                 if SubDir and (SearchRec.Attr and faDirectory > 0) then
880                                         GetFileList(s, Mask, List, True, IsPathAdd);
881                         end;
882                         rc := FindNext(SearchRec);
883                 end;
884         finally
885                 SysUtils.FindClose(SearchRec);
886         end;
887         List.Sort;
888 end;
889 //\8ew\92è\83t\83H\83\8b\83_\93à\82Ì\8ew\92è\83t\83@\83C\83\8b\88ê\97\97\82ð\8eæ\93¾\82·\82é
890 //\83T\83u\83t\83H\83\8b\83_\82Í\8c\9f\8dõ\82µ\82È\82¢
891 // ListFiles('c:\', '*.txt', list, True);
892 procedure TGikoSys.GetFileList(Path: string; Mask: string; var List: TStringList; IsPathAdd: Boolean);
893 var
894         rc: Integer;
895         SearchRec : TSearchRec;
896         s: string;
897 begin
898         Path := IncludeTrailingPathDelimiter(Path);
899         rc := FindFirst(Path + Mask, faAnyfile, SearchRec);
900         try
901                 while rc = 0 do begin
902                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
903                                 s := Path + SearchRec.Name;
904
905                                 if (SearchRec.Attr and faDirectory = 0) then
906                                                 if IsPathAdd then
907                                                         List.Add(s)
908                                                 else
909                                                         List.Add(SearchRec.Name);
910                         end;
911                         rc := FindNext(SearchRec);
912                 end;
913         finally
914                 SysUtils.FindClose(SearchRec);
915         end;
916         List.Sort;
917 end;
918 //\8ew\92è\83t\83H\83\8b\83_\93à\82Ì\83f\83B\83\8c\83N\83g\83\8a\88ê\97\97\82ð\8eæ\93¾\82·\82é
919 procedure TGikoSys.GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
920 var
921         rc: Integer;
922         SearchRec : TSearchRec;
923         s: string;
924 begin
925         Path := IncludeTrailingPathDelimiter(Path);
926         rc := FindFirst(Path + '*.*', faDirectory, SearchRec);
927         try
928                 while rc = 0 do begin
929                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
930                                 s := Path + SearchRec.Name;
931                                 //if (SearchRec.Attr and faDirectory > 0) then
932                                 //      s := IncludeTrailingPathDelimiter(s)
933
934                                 if (SearchRec.Attr and faDirectory > 0) and (MatchesMask(s, Mask)) then
935                                         List.Add( IncludeTrailingPathDelimiter( s ) );
936                                 if SubDir and (SearchRec.Attr and faDirectory > 0) then
937                                         GetDirectoryList(s, Mask, List, True);
938                         end;
939                         rc := FindNext(SearchRec);
940                 end;
941         finally
942                 SysUtils.FindClose(SearchRec);
943         end;
944 end;
945
946 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
947 function TGikoSys.LoadFromSkin(
948         fileName: string;
949         ThreadItem: TThreadItem;
950         SizeByte: Integer
951 ): string;
952 var
953         Skin: TStringList;
954 begin
955
956         Skin := TStringList.Create;
957         try
958                 if FileExists( fileName ) then begin
959                         Skin.LoadFromFile( fileName );
960
961                         // \82â\82è\82©\82½\82ª\8bê\82µ\82¢\82¯\82Ç\81A\83I\83v\83V\83\87\83\93\83_\83C\83A\83\8d\83O\82Ì\83v\83\8c\83r\83\85\81[\97p try
962                         try
963                                 if ThreadItem.ParentBoard <> nil then
964                                         if ThreadItem.ParentBoard.ParentCategory <> nil then
965                                                 CustomStringReplace( Skin, '<BBSNAME/>', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
966                                         CustomStringReplace( Skin, '<THREADURL/>', ThreadItem.URL);
967                         except end;
968                         CustomStringReplace( Skin, '<BOARDNAME/>', ThreadItem.ParentBoard.Title);
969                         CustomStringReplace( Skin, '<BOARDURL/>', ThreadItem.ParentBoard.URL);
970                         CustomStringReplace( Skin, '<THREADNAME/>', ThreadItem.Title);
971                         CustomStringReplace( Skin, '<SKINPATH/>', Setting.CSSFileName);
972                         CustomStringReplace( Skin, '<GETRESCOUNT/>', IntToStr( ThreadItem.Count - ThreadItem.NewResCount ));
973                                                 CustomStringReplace( Skin, '<NEWRESCOUNT/>', IntToStr( ThreadItem.NewResCount ));
974                                                 CustomStringReplace( Skin, '<ALLRESCOUNT/>', IntToStr( ThreadItem.Count ));
975
976                         CustomStringReplace( Skin, '<NEWDATE/>',FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
977                                                 CustomStringReplace( Skin, '<SIZEKB/>', IntToStr( Floor( SizeByte / 1024 ) ));
978                                                 CustomStringReplace( Skin, '<SIZE/>', IntToStr( SizeByte ));
979
980                         //----- \82Æ\82è\82 \82¦\82¸\82©\82¿\82ã\81`\82µ\82á\8cÝ\8a·\97p\81B\83R\83\81\83\93\83g\83A\83E\83g\82µ\82Ä\82à\82æ\82µ
981                         // \82â\82è\82©\82½\82ª\8bê\82µ\82¢\82¯\82Ç\81A\83I\83v\83V\83\87\83\93\83_\83C\83A\83\8d\83O\82Ì\83v\83\8c\83r\83\85\81[\97p try
982                         try
983                                 if ThreadItem.ParentBoard <> nil then
984                                         if ThreadItem.ParentBoard.ParentCategory <> nil then
985                                                 CustomStringReplace( Skin, '&BBSNAME', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
986                                         CustomStringReplace( Skin, '&THREADURL', ThreadItem.URL);
987                         except end;
988                         CustomStringReplace( Skin, '&BOARDNAME', ThreadItem.ParentBoard.Title);
989                         CustomStringReplace( Skin, '&BOARDURL', ThreadItem.ParentBoard.URL);
990                         CustomStringReplace( Skin, '&THREADNAME', ThreadItem.Title);
991                         CustomStringReplace( Skin, '&SKINPATH', Setting.CSSFileName);
992                         CustomStringReplace( Skin, '&GETRESCOUNT', IntToStr( ThreadItem.NewReceive - 1 ));
993                         CustomStringReplace( Skin, '&NEWRESCOUNT', IntToStr( ThreadItem.NewResCount ));
994                         CustomStringReplace( Skin, '&ALLRESCOUNT', IntToStr( ThreadItem.AllResCount ));
995
996                         CustomStringReplace( Skin, '&NEWDATE', FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
997                         CustomStringReplace( Skin, '&SIZEKB', IntToStr( Floor( SizeByte / 1024 ) ));
998                         CustomStringReplace( Skin, '&SIZE', IntToStr( SizeByte ));
999                         //----- \82±\82±\82Ü\82Å
1000                 end;
1001                 Result := Skin.Text;
1002         finally
1003                 Skin.Free;
1004         end;
1005 end;
1006
1007 // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
1008 function TGikoSys.SkinedRes(
1009         skin: string;
1010         Res: TResRec;
1011         No: string
1012 ): string;
1013 var
1014         spamminess      : Extended;
1015         wordCount               : TWordCount;
1016 begin
1017
1018         wordCount := TWordCount.Create;
1019         try
1020                 spamminess := Floor( SpamParse(
1021                         Res.FName + '<>' + Res.FMailTo + '<>' + Res.FBody, wordCount ) * 100 );
1022
1023                 Skin := CustomStringReplace( Skin, '<NUMBER/>',
1024                         '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
1025                 Skin := CustomStringReplace( Skin, '<PLAINNUMBER/>', No);
1026                 Skin := CustomStringReplace( Skin, '<NAME/>', '<b>' + Res.FName + '</b>');
1027                 Skin := CustomStringReplace( Skin, '<MAILNAME/>',
1028                         '<a href="mailto:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>');
1029                 Skin := CustomStringReplace( Skin, '<MAIL/>', Res.FMailTo);
1030                 Skin := CustomStringReplace( Skin, '<DATE/>', Res.FDateTime);
1031                 Skin := CustomStringReplace( Skin, '<MESSAGE/>', Res.FBody);
1032                 Skin := CustomStringReplace( Skin, '<SPAMMINESS/>', FloatToStr( spamminess ) );
1033                 Skin := CustomStringReplace( Skin, '<NONSPAMMINESS/>', FloatToStr( 100 - spamminess ) );
1034
1035                 //----- \82©\82¿\82ã\81`\82µ\82á\8cÝ\8a·\97p\81B\83R\83\81\83\93\83g\83A\83E\83g\82µ\82Ä\82à\82æ\82µ
1036                 Skin := CustomStringReplace( Skin, '&NUMBER',
1037                         '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
1038                 Skin := CustomStringReplace( Skin, '&PLAINNUMBER', No);
1039                 Skin := CustomStringReplace( Skin, '&NAME', '<b>' + Res.FName + '</b>');
1040                 Skin := CustomStringReplace( Skin, '&MAILNAME',
1041                         '<a href="mailto:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>');
1042                 Skin := CustomStringReplace( Skin, '&MAIL', Res.FMailTo);
1043                 Skin := CustomStringReplace( Skin, '&DATE', Res.FDateTime);
1044                 Skin := CustomStringReplace( Skin, '&MESSAGE', Res.FBody);
1045                 Skin := CustomStringReplace( Skin, '&SPAMMINESS', FloatToStr( spamminess ) );
1046                 Skin := CustomStringReplace( Skin, '&NONSPAMMINESS', FloatToStr( 100 - spamminess ) );
1047                 //----- \82±\82±\82Ü\82Å
1048
1049                 Result := Skin;
1050         finally
1051                 wordCount.Free;
1052         end;
1053
1054 end;
1055
1056 procedure TGikoSys.CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
1057 var
1058         i: integer;
1059         No: string;
1060         //bufList : TStringList;
1061         ReadList: TStringList;
1062         SaveList: TStringList;
1063         CSSFileName: string;
1064         BBSID: string;
1065         FileName: string;
1066         NewReceiveNo: Integer;
1067         Res: TResRec;
1068         boardPlugIn : TBoardPlugIn;
1069
1070         UserOptionalStyle: string;
1071         SkinHeader: string;
1072         SkinNewRes: string;
1073         SkinRes: string;
1074
1075         strTmp : string;
1076
1077         function LoadSkin( fileName: string ): string;
1078         begin
1079                 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1080         end;
1081         function ReplaceRes( skin: string ): string;
1082         begin
1083                 Result := SkinedRes( skin, Res, No );
1084         end;
1085 begin
1086         if ThreadItem <> nil then begin
1087                 if ThreadItem.IsBoardPlugInAvailable then begin
1088                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
1089                         boardPlugIn             := ThreadItem.BoardPlugIn;
1090                         NewReceiveNo    := ThreadItem.NewReceive;
1091                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1092                         UserOptionalStyle := SetUserOptionalStyle;
1093                         SaveList := TStringList.Create;
1094                         try
1095                                 doc.open;
1096                                 // \95\8e\9a\83R\81[\83h\82Í\83v\83\89\83O\83C\83\93\82É\94C\82¹\82é
1097                                 // doc.charset := 'Shift_JIS';
1098
1099                                 // \83w\83b\83_
1100                                 SaveList.Add( boardPlugIn.GetHeader( DWORD( threadItem ),
1101                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ) );
1102
1103                                 SaveList.Add('<p id="idSearch"></p>');
1104                                 for i := 0 to threadItem.Count - 1 do begin
1105                                         // 1 \82Í\95K\82¸\95\\8e¦
1106                                         if i <> 0 then begin
1107                                                 // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
1108                                                 case ResRange of
1109                                                 Ord( grrKoko ):
1110                                                         if ThreadItem.Kokomade > (i + 1) then
1111                                                                 Continue;
1112                                                 Ord( grrNew ):
1113                                                         if NewReceiveNo > (i + 1) then
1114                                                                 Continue;
1115                                                 10..65535:
1116                                                         if (threadItem.Count - i) > ResRange then
1117                                                                 Continue;
1118                                                 end;
1119                                         end;
1120
1121                                         // \90V\92\85\83}\81[\83N
1122                                         if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1123                                                 try
1124                                                         if GikoSys.Setting.UseSkin then begin
1125                                                                 if FileExists( GetSkinNewmarkFileName ) then
1126                                                                         SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) )
1127                                                                 else
1128                                                                         SaveList.Add( '<a name="new"></a>' );
1129                                                         end else if GikoSys.Setting.UseCSS then begin
1130                                                                 SaveList.Add('<a name="new"></a><div class="new">\90V\92\85\83\8c\83X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1131                                                         end else begin
1132                                                                 SaveList.Add('</dl>');
1133                                                                 SaveList.Add('<a name="new"></a>');
1134                                                                 SaveList.Add('<table width="100%" bgcolor="#3333CC" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#6666FF" valign="middle"><font size="-1" color="#ffffff"><b>\90V\92\85\83\8c\83X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
1135                                                                 SaveList.Add('<dl>');
1136                                                         end;
1137                                                 except
1138                                                         SaveList.Add( '<a name="new"></a>' );
1139                                                 end;
1140                                         end;
1141
1142                                         // \83\8c\83X
1143                                         SaveList.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) );
1144
1145                                         if ThreadItem.Kokomade = (i + 1) then begin
1146                                                 // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
1147                                                 try
1148                                                         if GikoSys.Setting.UseSkin then begin
1149                                                                 if FileExists( GetSkinBookmarkFileName ) then
1150                                                                         SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) )
1151                                                                 else
1152                                                                         SaveList.Add( '<a name="koko"></a>' );
1153                                                         end else if GikoSys.Setting.UseCSS then begin
1154                                                                 SaveList.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
1155                                                         end else begin
1156                                                                 SaveList.Add('</dl>');
1157                                                                 SaveList.Add('<a name="koko"></a><table width="100%" bgcolor="#55AA55" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#77CC77" valign="middle"><font size="-1" color="#ffffff"><b>\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</b></font></td></tr></table>');
1158                                                                 SaveList.Add('<dl>');
1159                                                         end;
1160                                                 except
1161                                                         SaveList.Add( '<a name="koko"></a>' );
1162                                                 end;
1163                                         end;
1164
1165                                         doc.Write(SaveList.Text);
1166                                         SaveList.Clear;
1167                                 end;
1168
1169
1170                                 // \83X\83L\83\93(\83t\83b\83^)
1171                                 SaveList.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1172                                 doc.Write(SaveList.Text);
1173                         finally
1174                                 SaveList.Free;
1175                                 doc.Close;
1176                         end;
1177
1178                 //      Exit;
1179                 //end;
1180                 end else begin
1181                         ShortDayNames[1] := '\93ú';               ShortDayNames[2] := '\8c\8e';
1182                         ShortDayNames[3] := '\89Î';               ShortDayNames[4] := '\90\85';
1183                         ShortDayNames[5] := '\96Ø';               ShortDayNames[6] := '\8bà';
1184                         ShortDayNames[7] := '\93y';
1185                         BBSID := ThreadItem.ParentBoard.BBSID;
1186                         NewReceiveNo := ThreadItem.NewReceive;
1187                         ReadList := TStringList.Create;
1188                         try
1189                                 if ThreadItem.IsLogFile then begin
1190                                         FileName := ThreadItem.GetThreadFileName;
1191                                         ReadList.LoadFromFile(FileName);
1192                                         FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1193                                         FAbon.Execute(ReadList);                //       \82 \82Ú\81`\82ñ\82µ\82Ä
1194                                         FSelectResFilter.Execute(ReadList); //\83\8c\83X\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\82·\82é
1195                                         if ThreadItem.Title = '' then begin
1196                                                 Res := DivideStrLine(ReadList[0]);
1197                                                 sTitle := Res.FTitle;
1198                                         end else
1199                                                 sTitle := ThreadItem.Title;
1200                                 end else begin
1201                                         sTitle := CustomStringReplace(ThreadItem.Title, '\81\97\81M', ',');
1202                                 end;
1203                                 SaveList := TStringList.Create;
1204                                 try
1205                                         doc.open;
1206                                         doc.charset := 'Shift_JIS';
1207
1208                                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1209                                         UserOptionalStyle := SetUserOptionalStyle;
1210                                         CSSFileName := GetStyleSheetDir + Setting.CSSFileName;
1211                                         if GikoSys.Setting.UseSkin then begin
1212                                                 // \83X\83L\83\93\8eg\97p
1213                                                 // \83X\83L\83\93\82Ì\90Ý\92è
1214                                                 try
1215                                                         SkinHeader := LoadSkin( GetSkinHeaderFileName );
1216                                                         if Length( UserOptionalStyle ) > 0 then
1217                                                                 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1218                                                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1219                                                         SaveList.Add( SkinHeader );
1220                                                 except
1221                                                 end;
1222                                                 try
1223                                                         SkinNewRes := LoadSkin( GetSkinNewResFileName );
1224                                                 except
1225                                                                                 end;
1226                                                 try
1227                                                         SkinRes := LoadSkin( GetSkinResFileName );
1228                                                 except
1229                                                 end;
1230                                                 SaveList.Add('<p id="idSearch"></p>');
1231                                                 SaveList.Add('<a name="top"></a>');
1232
1233                                                 for i := 0 to ReadList.Count - 1 do begin
1234                                                         // 1 \82Í\95K\82¸\95\\8e¦
1235                                                         if i <> 0 then begin
1236                                                                 // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
1237                                                                 case ResRange of
1238                                                                 Ord( grrKoko ):
1239                                                                         if ThreadItem.Kokomade > (i + 1) then
1240                                                                                 Continue;
1241                                                                 Ord( grrNew ):
1242                                                                         if NewReceiveNo > (i + 1) then
1243                                                                                 Continue;
1244                                                                 10..65535:
1245                                                                         if (threadItem.Count - i) > ResRange then
1246                                                                                 Continue;
1247                                                                 end;
1248                                                         end;
1249
1250                                                         // \90V\92\85\83}\81[\83N
1251                                                         if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
1252                                                                 try
1253                                                                         if FileExists( GetSkinNewmarkFileName ) then
1254                                                                                 SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) )
1255                                                                         else
1256                                                                                 SaveList.Add( '<a name="new"></a>' );
1257                                                                 except
1258                                                                         SaveList.Add( '<a name="new"></a>' );
1259                                                                 end;
1260                                                         end;
1261                                                         if (Trim(ReadList[i]) <> '') then begin
1262                                                                 No := IntToStr(i + 1);
1263
1264                                                                 Res := DivideStrLine(ReadList[i]);
1265                                                                 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1266                                                                 try
1267                                                                         if NewReceiveNo <= (i + 1) then
1268                                                                                 // \90V\92\85\83\8c\83X
1269                                                                                 strTmp := ReplaceRes( SkinNewRes )
1270                                                                         else
1271                                                                                 // \92Ê\8fí\82Ì\83\8c\83X
1272                                                                                 strTmp := ReplaceRes( SkinRes );
1273
1274                                                                         SaveList.Add( strTmp );
1275                                                                 except
1276                                                                 end;
1277                                                         end;
1278
1279                                                         if ThreadItem.Kokomade = (i + 1) then begin
1280                                                                 // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
1281                                                                 try
1282                                                                         if FileExists( GetSkinBookmarkFileName ) then
1283                                                                                 SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) )
1284                                                                         else
1285                                                                                 SaveList.Add( '<a name="koko"></a>' );
1286                                                                 except
1287                                                                         SaveList.Add( '<a name="koko"></a>' );
1288                                                                 end;
1289                                                         end;
1290                                                         doc.Write(SaveList.Text);
1291                                                         SaveList.Clear;
1292                                                 end;
1293                                                 SaveList.Add('<a name="bottom"></a>');
1294                                                 // \83X\83L\83\93(\83t\83b\83^)
1295                                                 try
1296                                                         SaveList.Add( LoadSkin( GetSkinFooterFileName ) );
1297                                                 except
1298                                                 end;
1299                                                 doc.Write(SaveList.Text);
1300                                         end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1301                                                 //CSS\8eg\97p
1302                                                 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1303                 //                              SaveList.Add('<html lang="ja"><head>');
1304                                                 SaveList.Add('<html><head>');
1305                                                 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1306                                                 SaveList.Add('<title>' + sTitle + '</title>');
1307                                                 SaveList.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1308                                                 if Length( UserOptionalStyle ) > 0 then
1309                                                         SaveList.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1310                                                 SaveList.Add('</head>');
1311                                                 SaveList.Add('<body>');
1312                                                 SaveList.Add('<a name="top"></a>');
1313                                                 SaveList.Add('<p id="idSearch"></p>');
1314                                                 SaveList.Add('<div class="title">' + sTitle + '</div>');
1315                                                 doc.Write(SaveList.Text);
1316                                                 SaveList.Clear;
1317                                                 //Application.ProcessMessages;
1318                                                 for i := 0 to ReadList.Count - 1 do begin
1319                                                         // 1 \82Í\95K\82¸\95\\8e¦
1320                                                         if i <> 0 then begin
1321                                                                 // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
1322                                                                 case ResRange of
1323                                                                 Ord( grrKoko ):
1324                                                                         if ThreadItem.Kokomade > (i + 1) then
1325                                                                                 Continue;
1326                                                                 Ord( grrNew ):
1327                                                                         if NewReceiveNo > (i + 1) then
1328                                                                                 Continue;
1329                                                                 10..65535:
1330                                                                         if (threadItem.Count - i) > ResRange then
1331                                                                                 Continue;
1332                                                                 end;
1333                                                         end;
1334
1335                                                         if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1336                                                                 SaveList.Add('<a name="new"></a><div class="new">\90V\92\85\83\8c\83X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1337                                                         end;
1338                                                         if (Trim(ReadList[i]) <> '') then begin
1339                                                                 No := IntToStr(i + 1);
1340                                                                 Res := DivideStrLine(ReadList[i]);
1341                                                                 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1342                                                                 if Res.FMailTo = '' then
1343                                                                         SaveList.Add('<a name="' + No + '"></a>'
1344                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1345                                                                                                         + '<span class="name_label">\96¼\91O\81F</span> '
1346                                                                                                         + '<span class="name"><b>' + Res.FName + '</b></span> '
1347                                                                                                         + '<span class="date_label">\93\8a\8de\93ú\81F</span> '
1348                                                                                                         + '<span class="date">' + Res.FDateTime+ '</span></div>'
1349                                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>')
1350                                                                 else if GikoSys.Setting.ShowMail then
1351                                                                         SaveList.Add('<a name="' + No + '"></a>'
1352                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1353                                                                                                                                                                                                 + '<span class="name_label"> \96¼\91O\81F </span>'
1354                                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1355                                                                                                         + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1356                                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1357                                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1358                                                                                                         + '<div class="mes">' + Res.FBody + ' </div>')
1359                                                                 else
1360                                                                         SaveList.Add('<a name="' + No + '"></a>'
1361                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1362                                                                                                         + '<span class="name_label"> \96¼\91O\81F </span>'
1363                                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1364                                                                                                         + '<b>' + Res.FName + '</b></a>'
1365                                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1366                                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1367                                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>');
1368                                                         end;
1369                                                         if ThreadItem.Kokomade = (i + 1) then begin
1370                                                                 SaveList.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
1371                                                         end;
1372
1373                                                         doc.Write(SaveList.Text);
1374                                                         SaveList.Clear;
1375                                                 end;
1376                                                 SaveList.Add('<a name="bottom"></a>');
1377                                                 //SaveList.Add('</body></html>');
1378                                                 SaveList.Add('<a name="last"></a>');
1379                                                 SaveList.Add('</body></html>');
1380                                                 doc.Write(SaveList.Text);
1381                                         end else begin
1382                                                 //CSS\94ñ\8eg\97p
1383                 //                              SaveList.Add('<html lang="ja"><head>');
1384                                                 SaveList.Add('<html><head>');
1385                                                 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1386                                                 SaveList.Add('<title>' + sTitle + '</title></head>');
1387                                                 SaveList.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1388                                                 SaveList.Add('<a name="top"></a>');
1389                                                 SaveList.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1390                                                 SaveList.Add('<dl>');
1391                                                 SaveList.Add('<p id="idSearch"></p>');
1392                                                 doc.Write(SaveList.Text);
1393                                                 SaveList.Clear;
1394                                                 //Application.ProcessMessages;
1395                                                 for i := 0 to ReadList.Count - 1 do begin
1396                                                         // 1 \82Í\95K\82¸\95\\8e¦
1397                                                         if i <> 0 then begin
1398                                                                 // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
1399                                                                 case ResRange of
1400                                                                 Ord( grrKoko ):
1401                                                                         if ThreadItem.Kokomade > (i + 1) then
1402                                                                                 Continue;
1403                                                                 Ord( grrNew ):
1404                                                                         if NewReceiveNo > (i + 1) then
1405                                                                                 Continue;
1406                                                                 10..65535:
1407                                                                         if (threadItem.Count - i) > ResRange then
1408                                                                                 Continue;
1409                                                                 end;
1410                                                         end;
1411
1412                                                         if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1413                                                                 SaveList.Add('</dl>');
1414                                                                 SaveList.Add('<a name="new"></a>');
1415                                                                 SaveList.Add('<table width="100%" bgcolor="#3333CC" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#6666FF" valign="middle"><font size="-1" color="#ffffff"><b>\90V\92\85\83\8c\83X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
1416                                                                 SaveList.Add('<dl>');
1417                                                         end;
1418                                                         if (Trim(ReadList[i]) <> '') then begin
1419                                                                 No := IntToStr(i + 1);
1420                                                                 Res := DivideStrLine(ReadList[i]);
1421                                                                 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1422                                                                 if Res.FMailTo = '' then
1423                                                                         SaveList.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>')
1424                                                                 else if GikoSys.Setting.ShowMail then
1425                                                                         SaveList.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>')
1426                                                                 else
1427                                                                         SaveList.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>');
1428                                                         end;
1429                                                         if ThreadItem.Kokomade = (i + 1) then begin
1430                                                                 SaveList.Add('</dl>');
1431                                                                 SaveList.Add('<a name="koko"></a><table width="100%" bgcolor="#55AA55" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#77CC77" valign="middle"><font size="-1" color="#ffffff"><b>\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</b></font></td></tr></table>');
1432                                                                 SaveList.Add('<dl>');
1433                                                         end;
1434                                                         doc.Write(SaveList.Text);
1435                                                         SaveList.Clear;
1436                                                 end;
1437                                                 SaveList.Add('</dl>');
1438                                                 SaveList.Add('<a name="bottom"></a>');
1439                                                 SaveList.Add('</body></html>');
1440                                                 doc.Write(SaveList.Text);
1441                                         end;
1442                                 finally
1443                                         SaveList.Free;
1444                                         doc.Close;
1445                                 end;
1446                         finally
1447                                 ReadList.Free;
1448                         end;
1449                 end;
1450         end;
1451 end;
1452 procedure TGikoSys.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1453 var
1454         i: integer;
1455         No: string;
1456         //bufList : TStringList;
1457         ReadList: TStringList;
1458 //      SaveList: TStringList;
1459         CSSFileName: string;
1460         BBSID: string;
1461         FileName: string;
1462         Res: TResRec;
1463         boardPlugIn : TBoardPlugIn;
1464
1465         UserOptionalStyle: string;
1466         SkinHeader: string;
1467         SkinRes: string;
1468         tmp, tmp1: string;
1469         function LoadSkin( fileName: string ): string;
1470         begin
1471                 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1472         end;
1473         function ReplaceRes( skin: string ): string;
1474         begin
1475                 Result := SkinedRes( skin, Res, No );
1476         end;
1477
1478 begin
1479         if ThreadItem <> nil then begin
1480                 CSSFileName := GetStyleSheetDir + Setting.CSSFileName;
1481                 html.Clear;
1482                 html.BeginUpdate;
1483                 if ThreadItem.IsBoardPlugInAvailable then begin
1484                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
1485                         boardPlugIn             := ThreadItem.BoardPlugIn;
1486                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1487                         UserOptionalStyle := SetUserOptionalStyle;
1488                         try
1489                                 // \95\8e\9a\83R\81[\83h\82Í\83v\83\89\83O\83C\83\93\82É\94C\82¹\82é
1490                                 // \83w\83b\83_
1491                                 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1492                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1493                                 //\90â\91Î\8eQ\8fÆ\82©\82ç\91\8a\91Î\8eQ\8fÆ\82Ö
1494                                 if Setting.UseSkin then begin
1495                                         tmp1 := './' +Setting.CSSFileName;
1496                                         tmp1 := CustomStringReplace(tmp1, GetConfigDir, '');
1497                                         tmp1 := CustomStringReplace(tmp1, '\', '/');
1498                                         tmp := CustomStringReplace(tmp, ExtractFilePath(Setting.CSSFileName),  tmp1);
1499                                 end else if Setting.UseCSS then begin
1500                                         tmp1 := './' + CSSFileName;
1501                                         tmp1 := CustomStringReplace(tmp1, GetConfigDir, '');
1502                                         tmp1 := CustomStringReplace(tmp1, '\', '/');
1503                                         tmp := CustomStringReplace(tmp, CSSFileName,  tmp1);
1504                                 end;
1505                                 html.Append( tmp );
1506
1507                                 for i := 0 to threadItem.Count - 1 do begin
1508
1509                                         // \83\8c\83X
1510                                         html.Append( ConvertResAnchor(boardPlugIn.GetRes( DWORD( threadItem ), i + 1 )) );
1511
1512                                 end;
1513                                 // \83X\83L\83\93(\83t\83b\83^)
1514                                 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1515                         finally
1516                         end;
1517                         html.EndUpdate;
1518                         //Exit;
1519                 end else begin
1520                         ShortDayNames[1] := '\93ú';               ShortDayNames[2] := '\8c\8e';
1521                         ShortDayNames[3] := '\89Î';               ShortDayNames[4] := '\90\85';
1522                         ShortDayNames[5] := '\96Ø';               ShortDayNames[6] := '\8bà';
1523                         ShortDayNames[7] := '\93y';
1524                         BBSID := ThreadItem.ParentBoard.BBSID;
1525                         ReadList := TStringList.Create;
1526                         try
1527                                 if ThreadItem.IsLogFile then begin
1528                                         FileName := ThreadItem.GetThreadFileName;
1529                                         ReadList.LoadFromFile(FileName);
1530                                         FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1531                                         FAbon.Execute(ReadList);                //       \82 \82Ú\81`\82ñ\82µ\82Ä
1532                                         FSelectResFilter.Execute(ReadList); //\83\8c\83X\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\82·\82é
1533                                         Res := DivideStrLine(ReadList[0]);
1534                                         //Res.FTitle := CustomStringReplace(Res.FTitle, '\81\97\81M', ',');
1535                                         sTitle := Res.FTitle;
1536                                 end else begin
1537                                         sTitle := CustomStringReplace(ThreadItem.Title, '\81\97\81M', ',');
1538                                 end;
1539                                 try
1540                                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1541                                         UserOptionalStyle := SetUserOptionalStyle;
1542
1543                                         if GikoSys.Setting.UseSkin then begin
1544                                                 // \83X\83L\83\93\8eg\97p
1545                                                 // \83X\83L\83\93\82Ì\90Ý\92è
1546                                                 try
1547                                                         SkinHeader := LoadSkin( GetSkinHeaderFileName );
1548                                                         if Length( UserOptionalStyle ) > 0 then
1549                                                                 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1550                                                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1551                                                         //\90â\91Î\8eQ\8fÆ\82©\82ç\91\8a\91Î\8eQ\8fÆ\82Ö
1552                                                         tmp1 := './' +Setting.CSSFileName;
1553                                                         tmp1 := CustomStringReplace(tmp1, GetConfigDir, '');
1554                                                         tmp1 := CustomStringReplace(tmp1, '\', '/');
1555                                                         SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(Setting.CSSFileName),  tmp1);
1556                                                         html.Append( SkinHeader );
1557                                                 except
1558                                                 end;
1559                                                 try
1560                                                         SkinRes := LoadSkin( GetSkinResFileName );
1561                                                 except
1562                                                 end;
1563                                                 html.Append('<a name="top"></a>');
1564                                                 for i := 0 to ReadList.Count - 1 do begin
1565                                                         if (Trim(ReadList[i]) <> '') then begin
1566                                                                 No := IntToStr(i + 1);
1567
1568                                                                 Res := DivideStrLine(ReadList[i]);
1569                                                                 {if Res.FType = glt2chOld then begin
1570                                                                         Res.FMailTo := CustomStringReplace(Res.FMailTo, '\81\97\81M', ',');
1571                                                                         Res.FName := CustomStringReplace(Res.FName, '\81\97\81M', ',');
1572                                                                         Res.FBody := CustomStringReplace(Res.FBody, '\81\97\81M', ',');
1573                                                                 end;
1574                                                                 }
1575                                                                 Res.FBody := AddAnchorTag(Res.FBody);
1576                                                                 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1577
1578                                                                 try
1579                                                                         html.Append( ReplaceRes( SkinRes ) );
1580                                                                 except
1581                                                                 end;
1582                                                         end;
1583
1584                                                 end;
1585                                                 html.Append('<a name="bottom"></a>');
1586                                                 // \83X\83L\83\93(\83t\83b\83^)
1587                                                 try
1588                                                         html.Append( LoadSkin( GetSkinFooterFileName ) );
1589                                                 except
1590                                                 end;
1591                                         end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1592                                                 //CSS\8eg\97p
1593                                                 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1594                                                 html.Append('<html><head>');
1595                                                 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1596                                                 html.Append('<title>' + sTitle + '</title>');
1597                                                 //\90â\91Î\8eQ\8fÆ\82©\82ç\91\8a\91Î\8eQ\8fÆ\82Ö
1598                                                 tmp1 := './' + CSSFileName;
1599                                                 tmp1 := CustomStringReplace(tmp1, GetConfigDir, '');
1600                                                 tmp1 := CustomStringReplace(tmp1, '\', '/');
1601
1602                                                 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1603                                                 if Length( UserOptionalStyle ) > 0 then
1604                                                         html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1605                                                 html.Append('</head>');
1606                                                 html.Append('<body>');
1607                                                 html.Append('<a name="top"></a>');
1608                                                 html.Append('<div class="title">' + sTitle + '</div>');
1609                                                 for i := 0 to ReadList.Count - 1 do begin
1610                                                         if (Trim(ReadList[i]) <> '') then begin
1611                                                                 No := IntToStr(i + 1);
1612                                                                 Res := DivideStrLine(ReadList[i]);
1613                                                                 {if Res.FType = glt2chOld then begin
1614                                                                         Res.FMailTo := CustomStringReplace(Res.FMailTo, '\81\97\81M', ',');
1615                                                                         Res.FName := CustomStringReplace(Res.FName, '\81\97\81M', ',');
1616                                                                         Res.FBody := CustomStringReplace(Res.FBody, '\81\97\81M', ',');
1617                                                                 end;
1618                                                                 }
1619                                                                 Res.FBody := AddAnchorTag(Res.FBody);
1620                                                                 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1621                                                                 if Res.FMailTo = '' then
1622                                                                         html.Append('<a name="' + No + '"></a>'
1623                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1624                                                                                                         + '<span class="name_label">\96¼\91O\81F</span> '
1625                                                                                                         + '<span class="name"><b>' + Res.FName + '</b></span> '
1626                                                                                                         + '<span class="date_label">\93\8a\8de\93ú\81F</span> '
1627                                                                                                         + '<span class="date">' + Res.FDateTime+ '</span></div>'
1628                                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>')
1629                                                                 else if GikoSys.Setting.ShowMail then
1630                                                                         html.Append('<a name="' + No + '"></a>'
1631                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1632                                                                                                                                                                                                 + '<span class="name_label"> \96¼\91O\81F </span>'
1633                                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1634                                                                                                         + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1635                                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1636                                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1637                                                                                                         + '<div class="mes">' + Res.FBody + ' </div>')
1638                                                                 else
1639                                                                         html.Append('<a name="' + No + '"></a>'
1640                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1641                                                                                                         + '<span class="name_label"> \96¼\91O\81F </span>'
1642                                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1643                                                                                                         + '<b>' + Res.FName + '</b></a>'
1644                                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1645                                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1646                                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>');
1647                                                         end;
1648                                                 end;
1649                                                 html.Append('<a name="bottom"></a>');
1650                                                 //html.Append('</body></html>');
1651                                                 html.Append('<a name="last"></a>');
1652                                                 html.Append('</body></html>');
1653                                         end else begin
1654                                                 //CSS\94ñ\8eg\97p
1655                                                 html.Append('<html><head>');
1656                                                 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1657                                                 html.Append('<title>' + sTitle + '</title></head>');
1658                                                 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1659                                                 html.Append('<a name="top"></a>');
1660                                                 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1661                                                 html.Append('<dl>');
1662                                                 for i := 0 to ReadList.Count - 1 do begin
1663                                                         if (Trim(ReadList[i]) <> '') then begin
1664                                                                 No := IntToStr(i + 1);
1665                                                                 Res := DivideStrLine(ReadList[i]);
1666                                                                 {if Res.FType = glt2chOld then begin
1667                                                                         Res.FMailTo := CustomStringReplace(Res.FMailTo, '\81\97\81M', ',');
1668                                                                         Res.FName := CustomStringReplace(Res.FName, '\81\97\81M', ',');
1669                                                                         Res.FBody := CustomStringReplace(Res.FBody, '\81\97\81M', ',');
1670                                                                 end;
1671                                                                 }
1672                                                                 Res.FBody := AddAnchorTag(Res.FBody);
1673                                                                 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1674                                                                 if Res.FMailTo = '' then
1675                                                                         html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> \93\8a\8de\93ú\81F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1676                                                                 else if GikoSys.Setting.ShowMail then
1677                                                                         html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] \93\8a\8de\93ú\81F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1678                                                                 else
1679                                                                         html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> \93\8a\8de\93ú\81F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1680                                                         end;
1681                                                 end;
1682                                                 html.Append('</dl>');
1683                                                 html.Append('<a name="bottom"></a>');
1684                                                 html.Append('</body></html>');
1685                                         end;
1686                                 finally
1687                                         html.EndUpdate;
1688                                 end;
1689                         finally
1690                                 ReadList.Free;
1691                         end;
1692                 end;
1693         end;
1694 end;
1695 function TGikoSys.ConvertResAnchor(res: string): string;
1696 const
1697         _HEAD : string = '<a href="../';
1698         _TAIL : string = ' target="_blank">';
1699         _ST: string = '&st=';
1700         _TO: string = '&to=';
1701         _STA: string = '&START=';
1702         _END: string = '&END=';
1703 var
1704         i, j, k: Integer;
1705         tmp: string;
1706 begin
1707         Result := '';
1708         i := AnsiPos(_HEAD, res);
1709         while i <> 0 do begin
1710                 Result := Result + Copy(res, 1, i -1);
1711                 Delete(res, 1, i - 1);
1712                 j := AnsiPos(_TAIL, res);
1713                 if j = 0 then begin
1714                         Result := Result + res;
1715                         Exit;
1716                 end;
1717                 tmp := Copy(res, 1, j - 1);
1718                 Delete(res, 1, j + 16);
1719                 if (AnsiPos(_ST, tmp) <> 0) and (AnsiPos(_TO, tmp) <> 0) then begin
1720                         Delete(tmp, 1, AnsiPos(_ST, tmp) + 3);
1721                         Delete(tmp, AnsiPos(_TO, tmp), Length(tmp));
1722                         Result := Result + '<a href="#' + tmp + '">';
1723                 end else if (AnsiPos(_STA, tmp) <> 0) and (AnsiPos(_END, tmp) <> 0) then begin
1724                         Delete(tmp, 1, AnsiPos(_STA, tmp) + 6);
1725                         Delete(tmp, AnsiPos(_END, tmp), Length(tmp));
1726                         Result := Result + '<a href="#' + tmp + '">';
1727                 end else begin
1728                         k := LastDelimiter('/', tmp);
1729                         Delete(tmp, 1, k);
1730                         if AnsiPos('-', tmp) < AnsiPos('"', tmp) then
1731                                 Delete(tmp, AnsiPos('-', tmp), Length(tmp))
1732                         else
1733                                 Delete(tmp, AnsiPos('"', tmp), Length(tmp));
1734
1735                         Result := Result + '<a href="#' + tmp + '">';
1736                 end;
1737                 i := AnsiPos(_HEAD, res);
1738         end;
1739         Result := Result + res;
1740
1741 end;
1742
1743 (*************************************************************************
1744  *http://\82Ì\95\8e\9a\97ñ\82ðanchor\83^\83O\95t\82«\82É\82·\82é\81B
1745  *************************************************************************)
1746 function TGikoSys.AddAnchorTag(s: string): string;
1747 const
1748         URL_CHAR: string = '0123456789'
1749                                                                          + 'abcdefghijklmnopqrstuvwxyz'
1750                                                                          + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1751                                                                          + '#$%&()*+,-./:;=?@[]^_`{|}~!''\';
1752         ANCHOR_REF      = 'href=';
1753         RES_REF                 = '&gt;&gt;';
1754 var
1755         wkIdx: array[0..9] of Integer;
1756         url: string;
1757         href: string;
1758         i, b: Integer;
1759         idx: Integer;
1760         anchorLen : Integer;
1761 begin
1762         Result := '';
1763         // + 3 \82Í 'href="' ('"'\82Â\82«)\82È\82Ç\82Ì\83o\83\8a\83G\81[\83V\83\87\83\93\82É\97]\97T\82ð\8e\9d\82½\82¹\82é\82½\82ß
1764         anchorLen := Length( ANCHOR_REF ) + 3;
1765
1766         while True do begin
1767                 wkIdx[0] := AnsiPos('http://', s);
1768                 wkIdx[1] := AnsiPos('ttp://', s);
1769                 wkIdx[2] := AnsiPos('tp://', s);
1770                 wkIdx[3] := AnsiPos('ms-help://', s);
1771                 wkIdx[4] := AnsiPos('p://', s);
1772                 wkIdx[5] := AnsiPos('https://', s);
1773                 wkIdx[6] := AnsiPos('www.', s);
1774                 wkIdx[7] := AnsiPos('ftp://', s);
1775                 wkIdx[8] := AnsiPos('news://', s);
1776                 wkIdx[9] := AnsiPos('rtsp://', s);
1777
1778                 idx := MaxInt;
1779                 for i := 0 to 9 do
1780                         if wkIdx[i] <> 0 then idx := Min(wkIdx[i], idx);
1781
1782                 if idx = MaxInt then begin
1783                         //\83\8a\83\93\83N\82ª\96³\82¢\82æ\81B
1784                         Result := Result + s;
1785                         Break;
1786                 end;
1787
1788                 if (idx > 1) and
1789                         (Pos( ANCHOR_REF, Copy(s, idx - anchorLen, anchorLen ) ) > 0) then begin
1790                         //\8aù\82É\83\8a\83\93\83N\83^\83O\82ª\82Â\82¢\82Ä\82¢\82é\82Á\82Û\82¢\82Æ\82«\82Í\83\80\83V
1791                         href := Copy( s, idx, Length( s ) );
1792                         Result := Result + Copy( s, 1, idx + Pos( '</a>', href ) + Length( '</a>' ) - 2 );
1793                         s := href;
1794                         s := Copy( s, Pos( '</a>', s ) + Length( '</a>' ), Length( s ) );
1795
1796                         Continue;
1797                 end;
1798
1799                 Result := Result + Copy(s, 0, idx - 1);
1800
1801                 s := Copy(s, idx, length(s));
1802
1803                 b := Length( s ) + 1;
1804                 for i := 1 to b do begin
1805                         if i = b then
1806         idx := 0
1807       else
1808                                 idx := AnsiPos(s[i], URL_CHAR);
1809                         if idx = 0 then begin
1810                                 //URL\82\82á\82È\82¢\95\8e\9a\94­\8c©\81I\82Æ\82©\81A\95\8e\9a\82ª\82È\82­\82È\82Á\82½\81B
1811                                 url := Copy(s, 0, i - 1);
1812
1813                                 if AnsiPos('ttp://', url) = 1 then
1814                                         href := 'h' + url
1815                                 else if AnsiPos('tp://', url) = 1 then
1816                                         href := 'ht' + url
1817                                 else if AnsiPos('p://', url) = 1 then
1818                                         href := 'htt' + url
1819                                 else if AnsiPos('www.', url) = 1 then
1820                                         href := 'http://' + url
1821                                 else
1822                                         href := url;
1823                                 Result := Result + '<a href="' + href + '" target="_blank">' + url + '</a>';
1824                                 s := Copy(s, i, MaxInt);
1825                                 Break;
1826                         end;
1827                 end;
1828         end;
1829 end;
1830
1831 (*************************************************************************
1832  *\83T\83u\83W\83F\83N\83g\88ê\8ds\82ð\95ª\8a\84
1833  *************************************************************************)
1834 function TGikoSys.DivideSubject(Line: string): TSubjectRec;
1835 var
1836         i: integer;
1837         ws: WideString;
1838         Delim: string;
1839         LeftK: string;
1840         RightK: string;
1841 begin
1842         Result.FCount := 0;
1843
1844         if AnsiPos('<>', Line) = 0 then
1845                 Delim := ','
1846         else
1847                 Delim := '<>';
1848         Result.FFileName := RemoveToken(Line, Delim);
1849         Result.FTitle := RemoveToken(Line, Delim);
1850
1851         ws := Trim(Result.FTitle);
1852
1853         if Copy(ws, Length(ws), 1) = ')' then begin
1854                 LeftK := '(';
1855                 RightK := ')';
1856         end else if Copy(ws, Length(ws), 1) = '\81j' then begin
1857                 LeftK := '\81i';
1858                 RightK := '\81j';
1859         end else if Copy(ws, Length(ws), 1) = '<' then begin
1860                 LeftK := '<';
1861                 RightK := '>';
1862         end;
1863
1864         for i := Length(ws) - 1 downto 1 do begin
1865                 if ws[i] = LeftK then begin
1866                         ws := Copy(ws, i + 1, Length(ws) - i - 1);
1867                         if IsNumeric(ws) then
1868                                 Result.FCount := StrToInt(ws);
1869                         Result.FTitle := Trim(CustomStringReplace(Result.FTitle, LeftK + ws + RightK, ''));
1870                         break;
1871                 end;
1872         end;
1873 end;
1874
1875 (*************************************************************************
1876  * dat\83t\83@\83C\83\8b\82Ì\88ê\83\89\83C\83\93\82ð\95ª\89ð
1877  *************************************************************************)
1878 function TGikoSys.DivideStrLine(Line: string): TResRec;
1879 var
1880         Delim: string;
1881                 bufbody : String;
1882 begin
1883         if AnsiPos('<>', Line) = 0 then begin
1884                 //Delim := ',';
1885                 //Result.FType := glt2chOld;
1886         Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
1887                 Line := CustomStringReplace(Line, ',', '<>');
1888                 Line := CustomStringReplace(Line, '\81\97\81M', ',');
1889         end;
1890         Delim := '<>';
1891         Result.FType := glt2chNew;
1892         {
1893         Result.FName := Trim(RemoveToken(Line, Delim));
1894         Result.FMailTo := Trim(RemoveToken(Line, Delim));
1895         Result.FDateTime := Trim(RemoveToken(Line, Delim));
1896         bufBody := Trim(RemoveToken(Line, Delim));
1897         }
1898         //Trim\82µ\82Ä\82Í\82¢\82¯\82È\82¢\8bC\82ª\82·\82é\81@by\82à\82\82ã
1899         Result.FName := RemoveToken(Line, Delim);
1900         Result.FMailTo := RemoveToken(Line, Delim);
1901         Result.FDateTime := RemoveToken(Line, Delim);
1902         Result.FBody := RemoveToken(Line, Delim);
1903         if Result.FBody = '' then begin
1904                 Result.FBody := '&nbsp;';
1905         end;
1906         //Result.FTitle := Trim(RemoveToken(Line, Delim));
1907         Result.FTitle := RemoveToken(Line, Delim);
1908
1909 end;
1910
1911 (*************************************************************************
1912  * URL\82©\82çBBSID\82ð\8eæ\93¾
1913  *************************************************************************)
1914 function TGikoSys.UrlToID(url: string): string;
1915 var
1916         i: integer;
1917 begin
1918         Result := '';
1919         url := Trim(url);
1920
1921         if url = '' then Exit;
1922
1923         url := Copy(url, 0, Length(url) - 1);
1924         for i := Length(url) downto 0 do begin
1925                 if url[i] = '/' then begin
1926                         Result := Copy(url, i + 1, Length(url));
1927                         Break;
1928                 end;
1929         end;
1930 end;
1931
1932 (*************************************************************************
1933  *URL\82©\82çBBSID\88È\8aO\82Ì\95\94\95ª(http://teri.2ch.net/)\82ð\8eæ\93¾
1934  *************************************************************************)
1935 function TGikoSys.UrlToServer(url: string): string;
1936 var
1937         i: integer;
1938         wsURL: WideString;
1939 begin
1940         Result := '';
1941         wsURL := url;
1942         wsURL := Trim(wsURL);
1943
1944         if wsURL = '' then exit;
1945
1946         if Copy(wsURL, Length(wsURL), 1) = '/' then
1947                 wsURL := Copy(wsURL, 0, Length(wsURL) - 1);
1948
1949         for i := Length(wsURL) downto 0 do begin
1950                 if wsURL[i] = '/' then begin
1951                         Result := Copy(wsURL, 0, i);
1952                         break;
1953                 end;
1954         end;
1955 end;
1956
1957 (*************************************************************************
1958  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91\8dÝ\82·\82é\82©\83`\83F\83b\83N
1959  *************************************************************************)
1960 function TGikoSys.DirectoryExistsEx(const Name: string): Boolean;
1961 var
1962         Code: Integer;
1963 begin
1964         Code := GetFileAttributes(PChar(Name));
1965         Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
1966 end;
1967
1968 (*************************************************************************
1969  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
1970  *************************************************************************)
1971 function TGikoSys.ForceDirectoriesEx(Dir: string): Boolean;
1972 begin
1973         Result := True;
1974         if Length(Dir) = 0 then
1975                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
1976         Dir := ExcludeTrailingPathDelimiter(Dir);
1977         if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
1978                 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
1979         Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
1980 end;
1981
1982 (*************************************************************************
1983  *\95\8e\9a\97ñ\82©\82ç\83g\81[\83N\83\93\82Ì\90Ø\82è\8fo\82µ\81i\8f\89\8aú\8f\88\97\9d\81j
1984  *FDelphi\82©\82ç\82Ì\83p\83N\83\8a
1985  *************************************************************************)
1986 function TGikoSys.StrTokFirst(const s:string; const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1987 begin
1988         Rec.Str := s;
1989         Rec.Pos := 1;
1990         Result := StrTokNext(sep, Rec);
1991 end;
1992
1993 (*************************************************************************
1994  *\95\8e\9a\97ñ\82©\82ç\83g\81[\83N\83\93\82Ì\90Ø\82è\8fo\82µ
1995  *FDelphi\82©\82ç\82Ì\83p\83N\83\8a
1996  *************************************************************************)
1997 function TGikoSys.StrTokNext(const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1998 var
1999         Len, I: Integer;
2000 begin
2001         with Rec do     begin
2002                 Len := Length(Str);
2003                 Result := '';
2004                 if Len >= Pos then begin
2005                         while (Pos <= Len) and (Str[Pos] in sep) do begin
2006                          Inc(Pos);
2007                         end;
2008                         I := Pos;
2009                         while (Pos<= Len) and not (Str[Pos] in sep) do begin
2010                                 if IsDBCSLeadByte(Byte(Str[Pos])) then begin
2011                                         Inc(Pos);
2012                                 end;
2013                                 Inc(Pos);
2014                         end;
2015                         Result := Copy(Str, I, Pos - I);
2016                         while (Pos <= Len) and (Str[Pos] in sep) do begin// \82±\82ê\82Í\82¨\8dD\82Ý
2017                                 Inc(Pos);
2018                         end;
2019                 end;
2020         end;
2021 end;
2022
2023 (*************************************************************************
2024  *\83t\83@\83C\83\8b\83T\83C\83Y\8eæ\93¾
2025  *************************************************************************)
2026 function TGikoSys.GetFileSize(FileName : string): longint;
2027 var
2028         F : File;
2029 begin
2030         try
2031                 if not FileExists(FileName) then begin
2032                         Result := 0;
2033                         Exit;
2034                 end;
2035                 Assign(F, FileName);
2036                 Reset(F, 1);
2037                 Result := FileSize(F);
2038                 CloseFile(F);
2039         except
2040                 Result := 0;
2041         end;
2042 end;
2043
2044 (*************************************************************************
2045  *\83t\83@\83C\83\8b\8ds\90\94\8eæ\93¾
2046  *************************************************************************)
2047 function TGikoSys.GetFileLineCount(FileName : string): longint;
2048 var
2049         sl: TStringList;
2050 begin
2051         sl := TStringList.Create;
2052         try
2053                 try
2054                         sl.LoadFromFile(FileName);
2055                         Result := sl.Count;
2056                 except
2057                         Result := 0;
2058                 end;
2059         finally
2060                 sl.Free;
2061         end;
2062
2063 end;
2064
2065 (*************************************************************************
2066  *\83X\83\8c\83b\83h\83t\83@\83C\83\8b\82©\82ç\8ew\92è\8ds\82ð\8eæ\93¾
2067  *************************************************************************)
2068 function TGikoSys.ReadThreadFile(FileName: string; Line: Integer): string;
2069 var
2070         fileTmp : TStringList;
2071 begin
2072         Result := '';
2073         if FileExists(FileName) then begin
2074                 fileTmp := TStringList.Create;
2075                 try
2076                         try
2077                                 fileTmp.LoadFromFile( FileName );
2078                                 if ( Line       >= 1 ) and ( Line       < fileTmp.Count + 1 ) then begin
2079                                         Result := fileTmp.Strings[ Line-1 ];
2080                                 end;
2081                         except
2082                                 //on EFOpenError do Result := '';
2083                         end;
2084                 finally
2085                         fileTmp.Free;
2086                 end;
2087         end;
2088 end;
2089
2090 (*************************************************************************
2091  *\83V\83X\83e\83\80\83\81\83j\83\85\81[\83t\83H\83\93\83g\82Ì\91®\90«\82ð\8eæ\93¾
2092  *************************************************************************)
2093 procedure TGikoSys.MenuFont(Font: TFont);
2094 var
2095         lf: LOGFONT;
2096         nm: NONCLIENTMETRICS;
2097 begin
2098         nm.cbSize := sizeof(NONCLIENTMETRICS);
2099
2100         SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0);
2101         lf := nm.lfMenuFont;
2102
2103         Font.Name := lf.lfFaceName;
2104         Font.Height := lf.lfHeight;
2105         Font.Style := [];
2106         if lf.lfWeight >= 700 then
2107                 Font.Style := Font.Style + [fsBold];
2108         if lf.lfItalic = 1 then
2109                 Font.Style := Font.Style + [fsItalic];
2110 end;
2111
2112 (*************************************************************************
2113  *
2114  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
2115  *************************************************************************)
2116 function TGikoSys.RemoveToken(var s: string;const delimiter: string): string;
2117 var
2118         p: Integer;
2119 begin
2120         p := AnsiPos(delimiter, s);
2121         if p = 0 then
2122                 Result := s
2123         else
2124                 Result := Copy(s, 1, p - 1);
2125         s := Copy(s, Length(Result) + Length(delimiter) + 1, Length(s));
2126 end;
2127
2128 (*************************************************************************
2129  *
2130  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
2131  *************************************************************************)
2132 function TGikoSys.GetTokenIndex(s: string; delimiter: string; index: Integer): string;
2133 var
2134         i: Integer;
2135 begin
2136         Result := '';
2137         for i := 0 to index do
2138                 Result := RemoveToken(s, delimiter);
2139 end;
2140
2141 (*************************************************************************
2142  *
2143  *************************************************************************)
2144 function TGikoSys.DeleteLink(const s: string): string;
2145 var
2146         s1: string;
2147         s2: string;
2148         idx: Integer;
2149         i: Integer;
2150 begin
2151         i := 0;
2152         Result := '';
2153         while True do begin
2154                 s1 := GetTokenIndex(s, '<a href="', i);
2155                 s2 := GetTokenIndex(s, '<a href="', i + 1);
2156
2157                 idx := Pos('">', s1);
2158                 if idx <> 0 then
2159                         Delete(s1, 1, idx + 1);
2160                 idx := Pos('">', s2);
2161                 if idx <> 0 then
2162                         Delete(s2, 1, idx + 1);
2163
2164                 Result := Result + s1 + s2;
2165
2166                 if s2 = '' then
2167                         Break;
2168
2169                 inc(i, 2);
2170         end;
2171 end;
2172
2173 //\83C\83\93\83f\83b\83N\83X\96¢\8dX\90V\83o\83b\83t\83@\82ð\83t\83\89\83b\83V\83\85\81I
2174 {procedure TGikoSys.FlashExitWrite;
2175 var
2176         i: Integer;
2177 begin
2178         //\83X\83\8c\83b\83h\83f\81[\83^\83t\83@\83C\83\8b\82ð\8dX\90V
2179         for i := 0 to FExitWrite.Count - 1 do
2180                 WriteThreadDat(FExitWrite[i]);
2181         FExitWrite.Clear;
2182 end;}
2183
2184 (*************************************************************************
2185  *\83X\83\8c\96¼\82È\82Ç\82ð\92Z\82¢\96¼\91O\82É\95Ï\8a·\82·\82é
2186  *from HotZonu
2187  *************************************************************************)
2188 function TGikoSys.GetShortName(const LongName: string; ALength: integer): string;
2189 const
2190         ERASECHAR : array [1..39] of string =
2191                 ('\81\99','\81\9a','\81¡','\81 ','\81\9f','\81\9e','\81Q','\81\94','\81£','\81¥',
2192                  '\81¢','\81¤','\81\9c','\81\9b','\81\9d','\81y','\81z','\81ô','\81s','\81t',
2193                  '\81g','\81h','\81k','\81l','\81e','\81f','\81\83','\81\84','\81á','\81â',
2194                  '\81o','\81p','\81q','\81r','\81w','\81x','\81¬','\81c', '\81@');
2195 var
2196         Chr : array [0..255]    of      char;
2197         S : string;
2198         i : integer;
2199 begin
2200         s := Trim(LongName);
2201         if (Length(s) <= ALength) then begin
2202                 Result := s;
2203         end else begin
2204                 S := s;
2205                 for i := Low(ERASECHAR) to      High(ERASECHAR) do      begin
2206                         S := CustomStringReplace(S, ERASECHAR[i], '');
2207                 end;
2208                 if (Length(S) <= ALength) then begin
2209                         Result := S;
2210                 end else begin
2211                         Windows.LCMapString(
2212                                         GetUserDefaultLCID(),
2213                                         LCMAP_HALFWIDTH,
2214                                         PChar(S),
2215                                         Length(S) + 1,
2216                                         chr,
2217                                         Sizeof(chr)
2218                                         );
2219                         S := Chr;
2220                         S := Copy(S,1,ALength);
2221                         while true do begin
2222                                 if (ByteType(S, Length(S)) = mbLeadByte ) then begin
2223                                         S := Copy(S, 1, Length(S) - 1);
2224                                 end else begin
2225                                         Break;
2226                                 end;
2227                         end;
2228                         Result := S;
2229                 end;
2230         end;
2231 end;
2232
2233 (*************************************************************************
2234  *
2235  * from HotZonu
2236  *************************************************************************)
2237 function TGikoSys.ConvRes(const Body, Bbs, Key,
2238         ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string;
2239         DatToHTML: boolean = false): string;
2240 type
2241         PIndex = ^TIndex;
2242         TIndex = record
2243                 FIndexFrom      : integer;
2244                 FIndexTo                : integer;
2245                 FNo                              : string;
2246         end;
2247 const
2248         GT      = '&gt;';
2249         SN      = '0123456789-';
2250         ZN      = '\82O\82P\82Q\82R\82S\82T\82U\82V\82W\82X\81|';
2251 var
2252         i : integer;
2253         s,r : string;
2254         b : TMbcsByteType;
2255         sw: boolean;
2256         sp: integer;
2257         No: string;
2258         sx: string;
2259         List: TList;
2260         oc      : string;
2261         st, et: string;
2262         chk : boolean;
2263         al : boolean;
2264         procedure Add(IndexFrom, IndexTo: integer; const No: string);
2265         var
2266                 FIndex : PIndex;
2267         begin
2268                 New(FIndex);
2269                 FIndex.FIndexFrom       := IndexFrom;
2270                 FIndex.FIndexTo         := IndexTo;
2271                 FIndex.FNo                               := No;
2272                 List.Add(FIndex);
2273         end;
2274         function ChooseString(const Text, Separator: string; Index: integer): string;
2275         var
2276                 S : string;
2277                 i, p : integer;
2278         begin
2279                 S :=    Text;
2280                 for i :=        0 to    Index - 1 do    begin
2281                         if      (AnsiPos(Separator, S) = 0) then        S :=    ''
2282                         else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
2283                 end;
2284                 p :=    AnsiPos(Separator, S);
2285                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;
2286         end;
2287 begin
2288         { v1.0 b2 - 03 }
2289         s        :=     Body;
2290         r        :=     Body;
2291         i        :=     1;
2292         sw      :=      False;
2293         No      :=      '';
2294         List:=  TList.Create;
2295         oc      :=      '';
2296         sp      :=      0;
2297         chk :=  False;
2298         al      :=      False;
2299         while true      do      begin
2300                 b :=    ByteType(s, i);
2301                 case    b of
2302                         mbSingleByte    : begin
2303                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2304                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2305                                                 sw      :=      True;
2306                                                 sp      :=      i;
2307                                                 i :=    i + 7;
2308                                                 oc:='';
2309                                                 chk :=  True;
2310                                         end;
2311                                 end else
2312                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2313                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin
2314                                                 i :=    i + 7;
2315                                                 oc:='';
2316                                                 chk :=  True;
2317                                         end;
2318                                 end else
2319                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin
2320                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2321                                                 sw      :=      True;
2322                                                 sp      :=      i;
2323                                                 i :=    i + 3;
2324                                                 oc:='';
2325                                                 chk :=  True;
2326                                         end;
2327                                 end else
2328                                 if      ((not sw) and (Copy(s,i,1) = ',')) or
2329                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin
2330                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
2331                                                         ((Chk) and      (oc = '')) or
2332                                                         ((not Chk) and (al)) then
2333                                         begin
2334                                                 sw      :=      True;
2335                                                 sp      :=      i;
2336                                                 //i :=  i + 1;
2337                                                 oc:='';
2338                                         end;
2339                                 end else
2340                                 if      (sw) then begin
2341                                         sx      :=      Copy(s,i,1);
2342                                         if      (AnsiPos(sx, SN) > 0)   then    begin
2343                                                 No      :=      No      + sx;
2344                                         end else begin
2345                                                 if      (No <> '') and (No <> '-')       then   begin
2346                                                         Add(sp, i, No);
2347                                                         al := True;
2348                                                 end;
2349                                                 sw      :=      False;
2350                                                 //
2351                                                 i := i - 1;
2352                                                 //
2353                                                 No      := '';
2354                                                 oc:='';
2355                                                 //chk :=        False;
2356                                         end;
2357                                 end else begin
2358                                         if      Copy(s,i,1) = '<' then  oc      :=      '';
2359                                         oc      :=      oc + Copy(s,i,1);
2360                                         chk :=  False;
2361                                         al      :=      False;
2362                                 end;
2363                         end;
2364                         mbLeadByte      : begin
2365                                 if      (not sw) and (Copy(s,i,4) = '\81\84\81\84') then        begin
2366                                         sw      :=      True;
2367                                         sp      :=      i;
2368                                         i :=    i + 3;
2369                                         chk :=  True;
2370                                 end else
2371                                 if      (not sw) and (Copy(s,i,2) = '\81\84') then  begin
2372                                         sw      :=      True;
2373                                         sp      :=      i;
2374                                         i :=    i + 1;
2375                                         chk :=  True;
2376                                 end else
2377                                 if      (sw) then begin
2378                                         sx      :=      Copy(s,i,2);
2379                                         if      (AnsiPos(sx, ZN) > 0)   then    begin
2380                                                 No      :=      No      + ZenToHan(sx);
2381                                         end else begin
2382                                                 if      (No <> '') and (No <> '-')      and (No <> '\81|') then   begin
2383                                                         Add(sp, i, No);
2384                                                 end;
2385                                                 sw      :=      False;
2386                                                 i := i - 1;
2387                                                 No      :=      '';
2388                                         end;
2389                                 end else begin
2390                                         oc      :=      '';
2391                                         chk :=  False;
2392                                 end;
2393                                 al      :=      False;
2394                         end;
2395                 end;
2396                 inc(i);
2397                 if      (i > Length(Body))      then    begin
2398                         if      (sw)    then    begin
2399                                 if      (No <> '')      then    Add(sp, i, No);
2400                         end;
2401                         Break;
2402                 end;
2403         end;
2404         for i :=        List.Count - 1  downto  0 do    begin
2405                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin
2406                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);
2407                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);
2408                 end else begin
2409                         st      :=      PIndex(List[i]).FNo;
2410                         et      :=      PIndex(List[i]).FNo;
2411                 end;
2412                 if not DatToHTML then
2413                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
2414                                         Format('<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">',
2415                                                                 [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
2416                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
2417                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r))
2418                 else
2419                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
2420                                         Format('<a href="#%s">', [st]) +
2421                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
2422                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));
2423
2424                 Dispose(PIndex(List[i]));
2425         end;
2426         List.Free;
2427         Result  :=      r;
2428 end;
2429
2430 function TGikoSys.ConvRes(
2431         const Body, Bbs, Key, ParamBBS, ParamKey,
2432     ParamStart, ParamTo, ParamNoFirst,
2433         ParamTrue, FullURL : string
2434 ): string;
2435 type
2436         PIndex = ^TIndex;
2437         TIndex = record
2438                 FIndexFrom      : integer;
2439                 FIndexTo                : integer;
2440                 FNo                              : string;
2441         end;
2442 const
2443         GT      = '&gt;';
2444         SN      = '0123456789-';
2445         ZN      = '\82O\82P\82Q\82R\82S\82T\82U\82V\82W\82X\81|';
2446 var
2447         i : integer;
2448         s,r : string;
2449         b : TMbcsByteType;
2450         sw: boolean;
2451         sp: integer;
2452         No: string;
2453         sx: string;
2454         List: TList;
2455         oc      : string;
2456         st, et: string;
2457         chk : boolean;
2458         al : boolean;
2459         procedure Add(IndexFrom, IndexTo: integer; const No: string);
2460         var
2461                 FIndex : PIndex;
2462         begin
2463                 New(FIndex);
2464                 FIndex.FIndexFrom       := IndexFrom;
2465                 FIndex.FIndexTo         := IndexTo;
2466                 FIndex.FNo                               := No;
2467                 List.Add(FIndex);
2468         end;
2469         function ChooseString(const Text, Separator: string; Index: integer): string;
2470         var
2471                 S : string;
2472                 i, p : integer;
2473         begin
2474                 S :=    Text;
2475                 for i :=        0 to    Index - 1 do    begin
2476                         if      (AnsiPos(Separator, S) = 0) then        S :=    ''
2477                         else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
2478                 end;
2479                 p :=    AnsiPos(Separator, S);
2480                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;
2481         end;
2482 begin
2483         { v1.0 b2 - 03 }
2484         s        :=     Body;
2485         r        :=     Body;
2486         i        :=     1;
2487         sw      :=      False;
2488         No      :=      '';
2489         List:=  TList.Create;
2490         oc      :=      '';
2491         sp      :=      0;
2492         chk :=  False;
2493         al      :=      False;
2494         while true      do      begin
2495                 b :=    ByteType(s, i);
2496                 case    b of
2497                         mbSingleByte    : begin
2498                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2499                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2500                                                 sw      :=      True;
2501                                                 sp      :=      i;
2502                                                 i :=    i + 7;
2503                                                 oc:='';
2504                                                 chk :=  True;
2505                                         end;
2506                                 end else
2507                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2508                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin
2509                                                 i :=    i + 7;
2510                                                 oc:='';
2511                                                 chk :=  True;
2512                                         end;
2513                                 end else
2514                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin
2515                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2516                                                 sw      :=      True;
2517                                                 sp      :=      i;
2518                                                 i :=    i + 3;
2519                                                 oc:='';
2520                                                 chk :=  True;
2521                                         end;
2522                                 end else
2523                                 if      ((not sw) and (Copy(s,i,1) = ',')) or
2524                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin
2525                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
2526                                                         ((Chk) and      (oc = '')) or
2527                                                         ((not Chk) and (al)) then
2528                                         begin
2529                                                 sw      :=      True;
2530                                                 sp      :=      i;
2531                                                 //i :=  i + 1;
2532                                                 oc:='';
2533                                         end;
2534                                 end else
2535                                 if      (sw) then begin
2536                                         sx      :=      Copy(s,i,1);
2537                                         if      (AnsiPos(sx, SN) > 0)   then    begin
2538                                                 No      :=      No      + sx;
2539                                         end else begin
2540                                                 if      (No <> '') and (No <> '-')       then   begin
2541                                                         Add(sp, i, No);
2542                                                         al := True;
2543                                                 end;
2544                                                 sw      :=      False;
2545                                                 //
2546                                                 i := i - 1;
2547                                                 //
2548                                                 No      := '';
2549                                                 oc:='';
2550                                                 //chk :=        False;
2551                                         end;
2552                                 end else begin
2553                                         if      Copy(s,i,1) = '<' then  oc      :=      '';
2554                                         oc      :=      oc + Copy(s,i,1);
2555                                         chk :=  False;
2556                                         al      :=      False;
2557                                 end;
2558                         end;
2559                         mbLeadByte      : begin
2560                                 if      (not sw) and (Copy(s,i,4) = '\81\84\81\84') then        begin
2561                                         sw      :=      True;
2562                                         sp      :=      i;
2563                                         i :=    i + 3;
2564                                         chk :=  True;
2565                                 end else
2566                                 if      (not sw) and (Copy(s,i,2) = '\81\84') then  begin
2567                                         sw      :=      True;
2568                                         sp      :=      i;
2569                                         i :=    i + 1;
2570                                         chk :=  True;
2571                                 end else
2572                                 if      (sw) then begin
2573                                         sx      :=      Copy(s,i,2);
2574                                         if      (AnsiPos(sx, ZN) > 0)   then    begin
2575                                                 No      :=      No      + ZenToHan(sx);
2576                                         end else begin
2577                                                 if      (No <> '') and (No <> '-')      and (No <> '\81|') then   begin
2578                                                         Add(sp, i, No);
2579                                                 end;
2580                                                 sw      :=      False;
2581                                                 i := i - 1;
2582                                                 No      :=      '';
2583                                         end;
2584                                 end else begin
2585                                         oc      :=      '';
2586                                         chk :=  False;
2587                                 end;
2588                                 al      :=      False;
2589                         end;
2590                 end;
2591                 inc(i);
2592                 if      (i > Length(Body))      then    begin
2593                         if      (sw)    then    begin
2594                                 if      (No <> '')      then    Add(sp, i, No);
2595                         end;
2596                         Break;
2597                 end;
2598         end;
2599         for i :=        List.Count - 1  downto  0 do    begin
2600         //plName := Copy(PluginName, LastDelimiter('\',PluginName) + 1, Length(PluginName) - LastDelimiter('/',PluginName) -1 );
2601                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin
2602                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);
2603                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);
2604                 end else begin
2605                         st      :=      PIndex(List[i]).FNo;
2606                         et      :=      PIndex(List[i]).FNo;
2607                 end;
2608                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
2609                                         Format('<a href="%s&%s=%s&%s=%s&%s=%s" target="_blank">',
2610                                                                 [FullURL, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
2611                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
2612                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));
2613                 Dispose(PIndex(List[i]));
2614         end;
2615         List.Free;
2616         Result  :=      r;
2617 end;
2618
2619
2620 function TGikoSys.BoolToInt(b: Boolean): Integer;
2621 begin
2622         Result := IfThen(b, 1, 0);
2623 end;
2624
2625 function TGikoSys.IntToBool(i: Integer): Boolean;
2626 begin
2627         Result := i = 1;
2628 end;
2629
2630 //gzip\82Å\88³\8fk\82³\82ê\82½\82Ì\82ð\96ß\82·
2631 function TGikoSys.GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
2632 const
2633         BUF_SIZE = 4096;
2634 var
2635         GZipStream: TGzipDecompressStream;
2636         TextStream: TStringStream;
2637         buf: array[0..BUF_SIZE - 1] of Byte;
2638         cnt: Integer;
2639         s: string;
2640         i: Integer;
2641 begin
2642         Result := '';
2643         TextStream := TStringStream.Create('');
2644         try
2645 //\83m\81[\83g\83\93\83E\83\93\83`\83E\83B\83\8b\83X2003\91Î\8dô(x-gzip\82Æ\82©\82É\82È\82é\82Ý\82½\82¢)
2646 //              if LowerCase(Trim(ContentEncoding)) = 'gzip' then begin
2647                 if AnsiPos('gzip', LowerCase(Trim(ContentEncoding))) > 0 then begin
2648                         ResStream.Position := 0;
2649                         GZipStream := TGzipDecompressStream.Create(TextStream);
2650                         try
2651                                 repeat
2652                                         FillChar(buf, BUF_SIZE, 0);
2653                                         cnt := ResStream.Read(buf, BUF_SIZE);
2654                                         if cnt > 0 then
2655                                                 GZipStream.Write(buf, BUF_SIZE);
2656                                 until cnt = 0;
2657                         finally
2658                                 GZipStream.Free;
2659                         end;
2660                 end else begin
2661                         ResStream.Position := 0;
2662                         repeat
2663                                 FillChar(buf, BUF_SIZE, 0);
2664                                 cnt := ResStream.Read(buf, BUF_SIZE);
2665                                 if cnt > 0 then
2666                                         TextStream.Write(buf, BUF_SIZE);
2667                         until cnt = 0;
2668                 end;
2669
2670                 //NULL\95\8e\9a\82ð"*"\82É\82·\82é
2671                 s := TextStream.DataString;
2672                 i := Length(s);
2673                 while (i > 0) and (s[i] = #0) do
2674                         Dec(i);
2675                 s := Copy(s, 1, i);
2676
2677                 i := Pos(#0, s);
2678                 while i <> 0 do begin
2679                         s[i] := '*';
2680                         i := Pos(#0, s);
2681                 end;
2682                 Result := s;
2683         finally
2684                 TextStream.Free;
2685         end;
2686 end;
2687
2688 procedure TGikoSys.LoadKeySetting(ActionList: TActionList);
2689 const
2690         STD_SEC = 'KeySetting';
2691 var
2692         i: Integer;
2693         ini: TMemIniFile;
2694         ActionName: string;
2695         ActionKey: Integer;
2696         SecList: TStringList;
2697         Component: TComponent;
2698 begin
2699         if not FileExists(GetConfigDir + KEY_SETTING_FILE_NAME) then
2700                 Exit;
2701         SecList := TStringList.Create;
2702         ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2703         try
2704                 ini.ReadSection(STD_SEC, SecList);
2705                 for i := 0 to SecList.Count - 1 do begin
2706                         ActionName := SecList[i];
2707                         ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
2708                         if ActionKey <> -1 then begin
2709                                 Component := ActionList.Owner.FindComponent(ActionName);
2710                                 if TObject(Component) is TAction then begin
2711                                         TAction(Component).ShortCut := ActionKey;
2712                                 end;
2713                         end;
2714                 end;
2715         finally
2716                 ini.Free;
2717                 SecList.Free;
2718         end;
2719 end;
2720
2721 procedure TGikoSys.SaveKeySetting(ActionList: TActionList);
2722 const
2723         STD_SEC = 'KeySetting';
2724 var
2725         i: Integer;
2726         ini: TMemIniFile;
2727 begin
2728         ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2729         try
2730                 for i := 0 to ActionList.ActionCount - 1 do begin
2731                         if ActionList.Actions[i].Tag = -1 then
2732                                 Continue;
2733                         ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
2734                 end;
2735                 ini.UpdateFile;
2736         finally
2737                 ini.Free;
2738         end;
2739 end;
2740
2741 procedure TGikoSys.LoadEditorKeySetting(ActionList: TActionList);
2742 const
2743         STD_SEC = 'KeySetting';
2744 var
2745         i: Integer;
2746         ini: TMemIniFile;
2747         ActionName: string;
2748         ActionKey: Integer;
2749         SecList: TStringList;
2750         Component: TComponent;
2751 begin
2752         if not FileExists(GetConfigDir + EKEY_SETTING_FILE_NAME) then
2753                 Exit;
2754         SecList := TStringList.Create;
2755         ini := TMemIniFile.Create(GetConfigDir + EKEY_SETTING_FILE_NAME);
2756         try
2757                 ini.ReadSection(STD_SEC, SecList);
2758                 for i := 0 to SecList.Count - 1 do begin
2759                         ActionName := SecList[i];
2760                         ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
2761                         if ActionKey <> -1 then begin
2762                                 Component := ActionList.Owner.FindComponent(ActionName);
2763                                 if TObject(Component) is TAction then begin
2764                                         TAction(Component).ShortCut := ActionKey;
2765                                 end;
2766                         end;
2767                 end;
2768         finally
2769                 ini.Free;
2770                 SecList.Free;
2771         end;
2772 end;
2773
2774 procedure TGikoSys.SaveEditorKeySetting(ActionList: TActionList);
2775 const
2776         STD_SEC = 'KeySetting';
2777 var
2778         i: Integer;
2779         ini: TMemIniFile;
2780 begin
2781         ini := TMemIniFile.Create(GetConfigDir + EKEY_SETTING_FILE_NAME);
2782         try
2783                 for i := 0 to ActionList.ActionCount - 1 do begin
2784                         if ActionList.Actions[i].Tag = -1 then
2785                                 Continue;
2786                         ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
2787                 end;
2788                 ini.UpdateFile;
2789         finally
2790                 ini.Free;
2791         end;
2792 end;
2793
2794 //
2795 procedure TGikoSys.CreateProcess(const AppPath: string; const Param: string);
2796 var
2797         PI: TProcessInformation;
2798         SI: TStartupInfo;
2799         Path: string;
2800 begin
2801         Path := '"' + AppPath + '"';
2802         if Param <> '' then
2803                 Path := Path + ' ' + Param;
2804
2805         SI.Cb := SizeOf(Si);
2806         SI.lpReserved   := nil;
2807         SI.lpDesktop     := nil;
2808         SI.lpTitle               := nil;
2809         SI.dwFlags               := 0;
2810         SI.cbReserved2 := 0;
2811         SI.lpReserved2 := nil;
2812         SI.dwysize               := 0;
2813         Windows.CreateProcess(nil,
2814                                                                 PChar(Path),
2815                                                                 nil,
2816                                                                 nil,
2817                                                                 False,
2818                                                                 0,
2819                                                                 nil,
2820                                                                 nil,
2821                                                                 SI,
2822                                                                 PI);
2823 end;
2824
2825 procedure TGikoSys.OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
2826 begin
2827         case BrowserType of
2828                 gbtIE:
2829                         HlinkNavigateString(nil, PWideChar(WideString(URL)));
2830                 gbtUserApp, gbtAuto:
2831                         if (Setting.URLApp) and (FileExists(Setting.URLAppFile)) then
2832                                 GikoSys.CreateProcess(Setting.URLAppFile, URL)
2833                         else
2834                                 HlinkNavigateString(nil, PWideChar(WideString(URL)));
2835         end;
2836 end;
2837
2838 function TGikoSys.HTMLDecode(const AStr: String): String;
2839 var
2840         Sp, Rp, Cp, Tp: PChar;
2841         S: String;
2842         I, Code: Integer;
2843         Num: Boolean;
2844 begin
2845         SetLength(Result, Length(AStr));
2846         Sp := PChar(AStr);
2847         Rp := PChar(Result);
2848         //Cp := Sp;
2849         try
2850                 while Sp^ <> #0 do begin
2851                         case Sp^ of
2852                                 '&': begin
2853                                                          //Cp := Sp;
2854                                                          Inc(Sp);
2855                                                          case Sp^ of
2856                                                                  'a': if AnsiStrPos(Sp, 'amp;') = Sp then
2857                                                                                         begin
2858                                                                                                 Inc(Sp, 3);
2859                                                                                                 Rp^ := '&';
2860                                                                                         end;
2861                                                                  'l',
2862                                                                  'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then
2863                                                                                         begin
2864                                                                                                 Cp := Sp;
2865                                                                                                 Inc(Sp, 2);
2866                                                                                                 while (Sp^ <> ';') and (Sp^ <> #0) do
2867                                                                                                         Inc(Sp);
2868                                                                                                 if Cp^ = 'l' then
2869                                                                                                         Rp^ := '<'
2870                                                                                                 else
2871                                                                                                         Rp^ := '>';
2872                                                                                         end;
2873                                                                  'q': if AnsiStrPos(Sp, 'quot;') = Sp then
2874                                                                                         begin
2875                                                                                                 Inc(Sp,4);
2876                                                                                                 Rp^ := '"';
2877                                                                                         end;
2878                                                                  '#': begin
2879                                                                                                 Tp := Sp;
2880                                                                                                 Inc(Tp);
2881                                                                                                 Num := IsNumeric(Copy(Tp, 1, 1));
2882                                                                                                 while (Sp^ <> ';') and (Sp^ <> #0) do begin
2883                                                                                                         if (Num) and (not IsNumeric(Copy(Sp, 1, 1))) then
2884                                                                                                                 Break;
2885                                                                                                         Inc(Sp);
2886                                                                                                 end;
2887                                                                                                 SetString(S, Tp, Sp - Tp);
2888                                                                                                 Val(S, I, Code);
2889                                                                                                 Rp^ := Chr((I));
2890                                                                                         end;
2891                                                          //      else
2892                                                                          //raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2893                                                                                  //[Cp^ + Sp^, Cp - PChar(AStr)])
2894                                                          end;
2895                                          end
2896                         else
2897                                 Rp^ := Sp^;
2898                         end;
2899                         Inc(Rp);
2900                         Inc(Sp);
2901                 end;
2902         except
2903 //              on E:EConvertError do
2904 //                      raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2905 //                              [Cp^ + Sp^, Cp - PChar(AStr)])
2906         end;
2907         SetLength(Result, Rp - PChar(Result));
2908 end;
2909
2910 function TGikoSys.GetHRefText(s: string): string;
2911 var
2912         Index: Integer;
2913         Index2: Integer;
2914 begin
2915         Result := '';
2916         s := Trim(s);
2917         if s = '' then
2918                 Exit;
2919
2920         Index := AnsiPos('href', LowerCase(s));
2921         if Index = 0 then
2922                 Exit;
2923         s := Trim(Copy(s, Index + 4, Length(s)));
2924         s := Trim(Copy(s, 2, Length(s)));
2925
2926         //\8en\82ß\82Ì\95\8e\9a\82ª'"'\82È\82ç\8eæ\82è\8f\9c\82­
2927         //if Copy(s, 1, 1) = '"' then begin
2928     if s[1]  = '"' then begin
2929                 s := Trim(Copy(s, 2, Length(s)));
2930         end;
2931
2932         Index := AnsiPos('"', s);
2933         if Index <> 0 then begin
2934                 //'"'\82Ü\82ÅURL\82Æ\82·\82é
2935                 s := Copy(s, 1, Index - 1);
2936         end else begin
2937                 //'"'\82ª\96³\82¯\82ê\82Î\83X\83y\81[\83X\82©">"\82Ì\91\81\82¢\95û\82Ü\82Å\82ðURL\82Æ\82·\82é
2938                 Index := AnsiPos(' ', s);
2939                 Index2 := AnsiPos('>', s);
2940                 if Index = 0 then
2941                         Index := Index2;
2942                 if Index > Index2 then
2943                         Index := Index2;
2944                 if Index <> 0 then
2945                         s := Copy(s, 1, Index - 1)
2946                 else
2947                         //\82±\82ê\88È\8fã\82à\82¤\92m\82ç\82ñ\82Ê
2948                         ;
2949         end;
2950         Result := Trim(s);
2951 end;
2952
2953 //\83z\83X\83g\96¼\82ª\82Q\82\83\82\88\82©\82Ç\82¤\82©\83`\83F\83b\83N\82·\82é
2954 function TGikoSys.Is2chHost(Host: string): Boolean;
2955 const
2956         HOST_NAME: array[0..1] of string = ('2ch.net', 'bbspink.com');
2957 var
2958         i: Integer;
2959 //      Len: Integer;
2960 begin
2961         Result := False;
2962         if RightStr( Host, 1 ) = '/' then
2963                 Host := Copy( Host, 1, Length( Host ) - 1 );
2964         OutputDebugString(pchar(HOST_NAME[0]));
2965         for i := 0 to Length(HOST_NAME) - 1 do begin
2966 //              Len := Length(HOST_NAME[i]);
2967                 if (AnsiPos(HOST_NAME[i], Host) > 0) and
2968                         (AnsiPos(HOST_NAME[i], Host) = (Length(Host) - Length(HOST_NAME[i]) + 1)) then begin
2969                         Result := True;
2970                         Exit;
2971                 end;
2972         end;
2973 end;
2974
2975 function TGikoSys.Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
2976 var
2977         Index: Integer;
2978         s: string;
2979         SList: TStringList;
2980 begin
2981         BBSID := '';
2982         BBSKey := '';
2983         Result := False;
2984
2985         Index := AnsiPos(READ_PATH, path);
2986         if Index <> 0 then begin
2987                 s := Copy(path, Index + Length(READ_PATH), Length(path));
2988                 if s[1] = '/' then
2989                         Delete(s, 1, 1);
2990                 BBSID := GetTokenIndex(s, '/', 0);
2991                 BBSKey := GetTokenIndex(s, '/', 1);
2992                 if BBSKey = '' then
2993                         BBSKey := Document;
2994                 Result := (BBSID <> '') or (BBSKey <> '');
2995                 Exit;
2996         end;
2997         Index := AnsiPos(KAKO_PATH, path);
2998         if Index <> 0 then begin
2999                 s := Copy(path, 2, Length(path));
3000                 BBSID := GetTokenIndex(s, '/', 0);
3001                 if (BBSID = 'log') and (GetTokenIndex(s, '/', 2) = 'kako') then
3002                         BBSID := GetTokenIndex(s, '/', 1);
3003                 BBSKey := ChangeFileExt(Document, '');
3004                 Result := (BBSID <> '') or (BBSKey <> '');
3005                 Exit;
3006         end;
3007         Index := AnsiPos('read.cgi?', URL);
3008         if Index <> 0 then begin
3009                 SList := TStringList.Create;
3010                 try
3011                         try
3012 //                              s := HTMLDecode(Document);
3013                                 ExtractHTTPFields(['?', '&'], [], PChar(URL), SList, False);
3014                                 BBSID := SList.Values['bbs'];
3015                                 BBSKey := SList.Values['key'];
3016                                 Result := (BBSID <> '') or (BBSKey <> '');
3017                                 Exit;
3018                         except
3019                                 Exit;
3020                         end;
3021                 finally
3022                         SList.Free;
3023                 end;
3024         end;
3025 end;
3026 procedure TGikoSys.GetPopupResNumber(URL : string; var stRes, endRes : Int64);
3027 var
3028         buf : String;
3029         convBuf : String;
3030         ps : Int64;
3031         pch : PChar;
3032 begin
3033         URL := Trim(LowerCase(URL));
3034         if (AnsiPos('&st=', URL ) <> 0) and ( AnsiPos( '&to=',URL) <> 0 ) then begin
3035                 stRes := 0;
3036                 endRes := 0;
3037                 try
3038                         buf := Copy( URL, AnsiPos('&st=', URL ) + 4, AnsiPos( '&to=',URL) - AnsiPos('&st=', URL ) - 4 );
3039                         if buf <> '' then
3040                                 stRes := StrToInt64( buf );
3041                         if AnsiPos( '&nofirst=',URL) <> 0 then begin
3042                                 buf := Copy( URL, AnsiPos('&to=', URL ) + 4, AnsiPos( '&nofirst=',URL) - AnsiPos('&to=', URL ) - 4);
3043                         end else begin
3044                                 buf := Copy( URL, AnsiPos('&to=', URL ) + 4, Length( URL ) - AnsiPos('&to=', URL ) - 4 + 1 );
3045                                 ps := 0;
3046                                 pch := PChar(buf);
3047                                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
3048                                 buf := Copy( buf, 1, ps );
3049                         end;
3050                         try
3051                                 if buf <> '' then
3052                                         endRes := StrToInt64(buf)
3053                         except
3054                                 endRes := 0;
3055                         end;
3056                 except
3057                         stRes := 0;
3058                 end;
3059                 if (stRes <> 0) and (endRes = 0) then
3060                         endRes := stRes + MAX_POPUP_RES
3061                 else if (stRes = 0) and (endRes <> 0) then begin
3062                         stRes := endRes - MAX_POPUP_RES;
3063                         if stRes < 1 then
3064                                 stRes := 1;
3065                 end;
3066                 GikoSys.GetBrowsableThreadURL( URL );
3067         end else if( AnsiPos('&res=', URL ) <> 0 ) then begin
3068                 endRes := 0;
3069                 buf := Copy( URL, AnsiPos('&res=', URL ) + 5, Length( URL ) - AnsiPos('&res=', URL ) - 5 + 1 );
3070                 ps := 0;
3071                 pch := PChar(buf);
3072                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
3073                 buf := Copy( buf, 1, ps );
3074                 try
3075                         if buf <> '' then
3076                                 stRes := StrToInt(buf)
3077                         else begin
3078                                 stRes := 0;
3079                         end;
3080                 except
3081                         stRes := 0;
3082                 end;
3083         end else if (AnsiPos('&start=', URL ) <> 0) and ( AnsiPos( '&end=',URL) <> 0 ) then begin
3084                 try
3085                         stRes := StrToInt64( Copy( URL, AnsiPos('&start=', URL ) + 7, AnsiPos( '&end=',URL) - AnsiPos('&start=', URL ) - 7 ) );
3086                         if AnsiPos( '&nofirst=',URL) <> 0 then begin
3087                                 buf := Copy( URL, AnsiPos('&end=', URL ) + 5, AnsiPos( '&nofirst=',URL) - AnsiPos('&end=', URL ) - 5);
3088                         end else begin
3089                                 buf := Copy( URL, AnsiPos('&end=', URL ) + 5, Length( URL ) - AnsiPos('&to=', URL ) - 5 + 1 );
3090                                 ps := 0;
3091                                 pch := PChar(buf);
3092                                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
3093                                 buf := Copy( buf, 1, ps );
3094                         end;
3095                         try
3096                                 if buf <> '' then
3097                                         endRes := StrToInt64(buf);
3098                         except
3099                                 endRes := 0;
3100                         end;
3101                 except
3102                         stRes := 0;
3103                 end;
3104         end else if ( AnsiPos('.html',URL) <> Length(URL) -4 ) and ( AnsiPos('.htm',URL) <> Length(URL) -3 ) then begin
3105                 buf := Copy(URL, LastDelimiter('/',URL)+1,Length(URL)-LastDelimiter('/',URL)+1);
3106                 if  Length(buf) > 0 then begin
3107                         if AnsiPos('-', buf) = 1 then begin
3108                                 stRes := 0;
3109                                 Delete(buf,1,1);
3110                                 ps := 0;
3111                                 pch := PChar(buf);
3112                                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
3113                                 try
3114                                         convBuf := Copy( buf, 1, ps );
3115                                         if convBuf <> '' then
3116                                                 endRes := StrToInt64(convBuf)
3117                                         else
3118                                                 endRes := 0;
3119                                 except
3120                                         endRes := 0;
3121                                 end;
3122                                 if endRes <> 0 then begin
3123                                         stRes := endRes - MAX_POPUP_RES;
3124                                         if stRes < 1 then
3125                                                 stRes := 1;
3126                                 end;
3127                         end else begin
3128                                 ps := 0;
3129                                 pch := PChar(buf);
3130                                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
3131                                 try
3132                                         convBuf := Copy( buf, 1, ps );
3133                                         if convBuf <> '' then begin
3134                                                 stRes := StrToInt64(convBuf);
3135                                                 Delete(buf,1,ps+1);
3136                                                 ps := 0;
3137                                                 pch := PChar(buf);
3138                                                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
3139                                                 try
3140                                                         convBuf := Copy( buf, 1, ps );
3141                                                         if convBuf <> '' then
3142                                                                 endRes := StrToInt64(convBuf)
3143                                                         else
3144                                                                 endRes := 0;
3145                                                 except
3146                                                         endRes := 0;
3147                                                 end;
3148                                         end else begin
3149                                                 stRes := 0;
3150                                         end;
3151                                 except
3152                                         stRes := 0;
3153                                         endRes := 0;
3154                                 end;
3155                         end;
3156                 end;
3157         end else begin
3158                 //stRes := 0;
3159                 //endRes := 0;
3160         end;
3161 end;
3162
3163 function TGikoSys.Parse2chURL2(URL: string): TPathRec;
3164 var
3165         i: Integer;
3166         s: string;
3167 //      buf : String;
3168 //      convBuf : String;
3169         wk: string;
3170         wkMin: Integer;
3171         wkMax: Integer;
3172         wkInt: Integer;
3173         RStart: Integer;
3174         RLength: Integer;
3175 //      ps : Integer;
3176 //      pch : PChar;
3177         SList: TStringList;
3178 begin
3179         URL := Trim(LowerCase(URL));
3180         Result.FBBS := '';
3181         Result.FKey := '';
3182         Result.FSt := 0;
3183         Result.FTo := 0;
3184         Result.FFirst := False;
3185         Result.FStBegin := False;
3186         Result.FToEnd := False;
3187         Result.FDone := False;
3188         Result.FNoParam := False;
3189
3190         wkMin := 0;
3191         wkMax := 1;
3192         if URL[length(URL)] = '\' then
3193                 URL := URL + 'n';
3194         FAWKStr.RegExp := 'http://.+\.(2ch\.net|bbspink\.com)/';
3195         if FAWKStr.Match(FAWKStr.ProcessEscSeq(URL), RStart, RLength) <> 0 then begin
3196                 s := Copy(URL, RStart + RLength - 1, Length(URL));
3197
3198                 //\95W\8f\80\8f\91\8e®
3199                 //\8dÅ\8cã\82Íl50, 10, 10-20, 10n, 10-20n, -10, 10-, 10n- \82È\82Ç
3200                 //http://xxx.2ch.net/test/read.cgi/bbsid/1000000000/
3201                 FAWKStr.RegExp := '/test/read.cgi/.+/[0-9]+/?.*';
3202                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3203                         s := Copy(s, 15, Length(s));
3204
3205                         SList := TStringList.Create;
3206                         try
3207                                 SList.Clear;
3208                                 FAWKStr.RegExp := '/';
3209                                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 3 then begin
3210                                         Result.FBBS := SList[1];
3211                                         Result.FKey := SList[2];
3212                                         if SList.Count >= 4 then
3213                                                 s := SList[3]
3214                                         else begin
3215                                                 s := '';
3216                                                 Result.FNoParam := true;
3217                                         end;
3218                                 end else
3219                                         Exit;
3220
3221                                 SList.Clear;
3222                                 FAWKStr.LineSeparator := mcls_CRLF;
3223                                 FAWKStr.RegExp := '-';
3224                                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) = 0 then begin
3225                                         Result.FFirst := True;
3226                                 end else begin
3227                                         FAWKStr.RegExp := 'l[0-9]+';
3228                                         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3229                                                 Result.FFirst := True;
3230                                         end else begin
3231                                                 for i := 0 to SList.Count - 1 do begin
3232                                                         if Trim(SList[i]) = '' then begin
3233                                                                 if i = 0 then
3234                                                                         Result.FStBegin := True;
3235                                                                 if i = (SList.Count - 1) then
3236                                                                         Result.FToEnd := True;
3237                                                         end else if IsNumeric(SList[i]) then begin
3238                                                                 wkInt := StrToInt(SList[i]);
3239                                                                 wkMax := Max(wkMax, wkInt);
3240                                                                 if wkMin = 0 then
3241                                                                         wkMin := wkInt
3242                                                                 else
3243                                                                         wkMin := Min(wkMin, wkInt);
3244                                                         end else if Trim(SList[i]) = 'n' then begin
3245                                                                 Result.FFirst := True;
3246                                                         end else begin
3247                                                                 FAWKStr.RegExp := '^n[0-9]+$|^[0-9]+n$';
3248                                                                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(SList[i]), RStart, RLength) > 0 then begin
3249                                                                         if Copy(SList[i], 1, 1) = 'n' then
3250                                                                                 wkInt := StrToInt(Copy(SList[i], 2, Length(SList[i])))
3251                                                                         else
3252                                                                                 wkInt := StrToInt(Copy(SList[i], 1, Length(SList[i]) - 1));
3253                                                                         Result.FFirst := True;
3254                                                                         wkMax := Max(wkMax, wkInt);
3255                                                                         if wkMin = 1 then
3256                                                                                 wkMin := wkInt
3257                                                                         else
3258                                                                                 wkMin := Min(wkMin, wkInt);
3259                                                                 end;
3260                                                         end;
3261                                                 end;
3262                                                 if Result.FStBegin and (not Result.FToEnd) then
3263                                                         Result.FSt := wkMin
3264                                                 else if (not Result.FStBegin) and Result.FToEnd then
3265                                                         Result.FTo := wkMax
3266                                                 else if (not Result.FStBegin) and (not Result.FToEnd) then begin
3267                                                         Result.FSt := wkMin;
3268                                                         Result.FTo := wkMax;
3269                                                 end;
3270                                                 //Result.FSt := wkMin;
3271                                                 //Result.FTo := wkMax;
3272                                         end;
3273                                 end;
3274                         finally
3275                                 SList.Free;
3276                         end;
3277                         Result.FDone := True;
3278                         Exit;
3279                 end;
3280
3281                 //\90Vkako\8f\91\8e®
3282                 //http://server.2ch.net/ITA_NAME/kako/1000/10000/1000000000.html
3283                 FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+/[0-9]+\.html';
3284                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3285                         SList := TStringList.Create;
3286                         try
3287                                 SList.Clear;
3288                                 FAWKStr.RegExp := '/';
3289                                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
3290                                         Result.FBBS := SList[1];
3291                                         Result.FKey := ChangeFileExt(SList[5], '');
3292                                         Result.FFirst := True;
3293                                 end else
3294                                         Exit;
3295                         finally
3296                                 SList.Free;
3297                         end;
3298                         Result.FDone := True;
3299                         Exit;
3300                 end;
3301
3302                 //\8b\8ckako\8f\91\8e®
3303                 //http://server.2ch.net/ITA_NAME/kako/999/999999999.html
3304                 FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+\.html';
3305                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3306                         SList := TStringList.Create;
3307                         try
3308                                 SList.Clear;
3309                                 FAWKStr.RegExp := '/';
3310                                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 5 then begin
3311                                         Result.FBBS := SList[1];
3312                                         Result.FKey := ChangeFileExt(SList[4], '');
3313                                         Result.FFirst := True;
3314                                 end else
3315                                         Exit;
3316                         finally
3317                                 SList.Free;
3318                         end;
3319                         Result.FDone := True;
3320                         Exit;
3321                 end;
3322
3323                 //log\8by\82Ñlog2\8f\91\8e®
3324                 //http://server.2ch.net/log/ITA_NAME/kako/999/999999999.html
3325                 //http://server.2ch.net/log2/ITA_NAME/kako/999/999999999.html
3326                 FAWKStr.RegExp := '/log2?/.+/kako/[0-9]+/[0-9]+\.html';
3327                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3328                         SList := TStringList.Create;
3329                         try
3330                                 SList.Clear;
3331                                 FAWKStr.RegExp := '/';
3332                                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
3333                                         Result.FBBS := SList[2];
3334                                         Result.FKey := ChangeFileExt(SList[5], '');
3335                                         Result.FFirst := True;
3336                                 end else
3337                                         Exit;
3338                         finally
3339                                 SList.Free;
3340                         end;
3341                         Result.FDone := True;
3342                         Exit;
3343                 end;
3344
3345
3346                 //\8b\8cURL\8f\91\8e®
3347                 //http://server.2ch.net/test/read.cgi?bbs=ITA_NAME&key=1000000000&st=1&to=5&nofirst=true
3348                 FAWKStr.RegExp := '/test/read\.cgi\?';
3349                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3350                         s := Copy(s, 16, Length(s));
3351                         SList := TStringList.Create;
3352                         try
3353                                 SList.Clear;
3354                                 FAWKStr.RegExp := '&';
3355                                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
3356                                         Result.FFirst := True;
3357                                         for i := 0 to SList.Count - 1 do begin
3358                                                 if Pos('bbs=', SList[i]) = 1 then begin
3359                                                         Result.FBBS := Copy(SList[i], 5, Length(SList[i]));
3360                                                 end else if Pos('key=', SList[i]) = 1 then begin
3361                                                         Result.FKey := Copy(SList[i], 5, Length(SList[i]));
3362                                                 end else if Pos('st=', SList[i]) = 1 then begin
3363                                                         wk := Copy(SList[i], 4, Length(SList[i]));
3364                                                         if IsNumeric(wk) then
3365                                                                 Result.FSt := StrToInt(wk)
3366                                                         else if wk = '' then
3367                                                                 Result.FStBegin := True;
3368                                                 end else if Pos('to=', SList[i]) = 1 then begin
3369                                                         wk := Copy(SList[i], 4, Length(SList[i]));
3370                                                         if IsNumeric(wk) then
3371                                                                 Result.FTo := StrToInt(wk)
3372                                                         else if wk = '' then
3373                                                                 Result.FToEnd := True;
3374                                                 end else if Pos('nofirst=', SList[i]) = 1 then begin
3375                                                         Result.FFirst := False;
3376                                                 end;
3377                                         end;
3378                                 end else
3379                                         Exit;
3380                         finally
3381                                 SList.Free;
3382                         end;
3383
3384                         if (Result.FBBS <> '') and (Result.FKey <> '') then begin
3385                                 Result.FDone := True;
3386                         end;
3387                         Exit;
3388                 end;
3389         end;
3390 end;
3391
3392 procedure TGikoSys.ParseURI(const URL : string; var Protocol, Host, Path, Document, Port, Bookmark: string);
3393 var
3394         URI: TIdURI;
3395 begin
3396         Protocol := '';
3397         Host := '';
3398         Path := '';
3399         Document := '';
3400         Port := '';
3401         Bookmark := '';
3402         URI := TIdURI.Create(URL);
3403         try
3404                 Protocol := URI.Protocol;
3405                 Host := URI.Host;
3406                 Path := URI.Path;
3407                 Document := URI.Document;
3408                 Port := URI.Port;
3409                 Bookmark := URI.Bookmark;
3410         finally
3411                 URI.Free;
3412         end;
3413 end;
3414
3415 function TGikoSys.GetVersionBuild: Integer;
3416 var
3417         FixedFileInfo: PVSFixedFileInfo;
3418         VersionHandle, VersionSize: DWORD;
3419         pVersionInfo: Pointer;
3420         ItemLen : UInt;
3421         AppFile: string;
3422 begin
3423         Result := 0;
3424         AppFile := Application.ExeName;
3425         VersionSize := GetFileVersionInfoSize(pChar(AppFile), VersionHandle);
3426         if VersionSize = 0 then
3427                 Exit;
3428         GetMem(pVersionInfo, VersionSize);
3429         try
3430                 if GetFileVersionInfo(PChar(AppFile),VersionHandle,VersionSize, pVersionInfo) then
3431                         if VerQueryValue(pVersionInfo, '\', Pointer(FixedFileInfo), ItemLen) then
3432                                 Result := LOWORD(FixedFileInfo^.dwFileVersionLS);
3433         finally
3434                 FreeMem(pVersionInfo, VersionSize);
3435         end;
3436 end;
3437
3438 function        TGikoSys.GetBrowsableThreadURL(
3439         inURL : string
3440 ) : string;
3441 var
3442         threadItem      : TThreadItem;
3443         boardPlugIn     : TBoardPlugIn;
3444         i                                               : Integer;
3445 begin
3446
3447         //===== \83v\83\89\83O\83C\83\93
3448         try
3449                 for i := Length( BoardPlugIns ) - 1 downto 0 do begin
3450                         if Assigned( Pointer( BoardPlugIns[ i ].Module ) ) then begin
3451                                 if BoardPlugIns[ i ].AcceptURL( inURL ) = atThread then begin
3452                                         boardPlugIn := BoardPlugIns[ i ];
3453                                         threadItem      := TThreadItem.Create( boardPlugIn, inURL );
3454                                         Result                  := threadItem.URL;
3455                                         threadItem.Free;
3456
3457                                         Break;
3458                                 end;
3459                         end;
3460                 end;
3461         except
3462                 // exception \82ª\94­\90\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
3463         end;
3464
3465         if Length( Result ) = 0 then
3466                 Result := GikoSys.Get2chBrowsableThreadURL( inURL );
3467
3468 end;
3469
3470 function        TGikoSys.GetThreadURL2BoardURL(
3471         inURL : string
3472 ) : string;
3473 var
3474         threadItem      : TThreadItem;
3475         boardPlugIn     : TBoardPlugIn;
3476         i                                               : Integer;
3477 begin
3478
3479         //===== \83v\83\89\83O\83C\83\93
3480         try
3481                 for i := Length( BoardPlugIns ) - 1 downto 0 do begin
3482                         if Assigned( Pointer( BoardPlugIns[ i ].Module ) ) then begin
3483                                 if BoardPlugIns[ i ].AcceptURL( inURL ) = atThread then begin
3484                                         boardPlugIn := BoardPlugIns[ i ];
3485                                         threadItem      := TThreadItem.Create( boardPlugIn, inURL );
3486                                         Result                  := BoardPlugIns[ i ].GetBoardURL( Longword( threadItem ) );
3487                                         threadItem.Free;
3488
3489                                         Break;
3490                                 end;
3491                         end;
3492                 end;
3493         except
3494                 // exception \82ª\94­\90\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
3495         end;
3496
3497         if Length( Result ) = 0 then
3498                 Result := GikoSys.Get2chThreadURL2BoardURL( inURL );
3499
3500 end;
3501
3502 function        TGikoSys.Get2chThreadURL2BoardURL(
3503         inURL : string
3504 ) : string;
3505 var
3506         Protocol, Host, Path, Document, Port, Bookmark : string;
3507         BBSID, BBSKey : string;
3508         foundPos                        : Integer;
3509 begin
3510
3511         ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
3512         Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
3513
3514         foundPos := Pos( '/test/read.cgi', inURL );
3515         if {(Is2chHost(Host)) and} (foundPos > 0) then
3516                 Result := Copy( inURL, 1, foundPos ) + BBSID + '/'
3517         else
3518                 Result := Protocol + '://' + Host + '/' + BBSID + '/';
3519
3520 end;
3521
3522 function        TGikoSys.Get2chBrowsableThreadURL(
3523         inURL                   : string
3524 ) : string;
3525 var
3526         Protocol, Host, Path, Document, Port, Bookmark : string;
3527         BBSID, BBSKey : string;
3528         foundPos        : Integer;
3529 begin
3530
3531 //      if Pos( KAKO_PATH, inURL ) > 0 then begin
3532 //              Result := inURL;
3533 //      end else begin
3534                 ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
3535                 Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
3536                 foundPos := Pos( '/test/read.cgi', inURL ) - 1;
3537
3538                 if Is2chHost( Host ) then begin
3539                         Result := Protocol + '://' + Host +
3540                                 READ_PATH + BBSID + '/' + BBSKey + '/l50';
3541                 end else begin
3542                         if foundPos > 0 then
3543                                 Result := Copy( inURL, 1, foundPos ) +
3544                                         OLD_READ_PATH + 'bbs=' + BBSID + '&key=' + BBSKey + '&ls=50'
3545                         else
3546                                 Result := Protocol + '://' + Host +
3547                                         OLD_READ_PATH + 'bbs=' + BBSID + '&key=' + BBSKey + '&ls=50';
3548                 end;
3549 //      end;
3550
3551 end;
3552
3553 function        TGikoSys.Get2chBoard2ThreadURL(
3554         inBoard : TBoard;
3555         inKey           : string
3556 ) : string;
3557 var
3558         server  : string;
3559 begin
3560
3561         server := UrlToServer( inBoard.URL );
3562         if Is2chHost( server ) then
3563                 Result := server + 'test/read.cgi/' + inBoard.BBSID + '/' + inKey + '/l50'
3564         else
3565                 Result := server + 'test/read.cgi?bbs=' + inBoard.BBSID + '&key=' + inKey + '&ls=50';
3566
3567 end;
3568
3569 (*************************************************************************
3570  *\8b@\94\\96¼\81@\81@\81F\83{\81[\83h\83t\83@\83C\83\8b\97ñ\8b\93
3571  *\89Â\8e\8b\81@\81@\81@\81FPublic
3572  *************************************************************************)
3573 procedure TGikoSys.ListBoardFile;
3574 var
3575         boardFileList   : TStringList;
3576         i, l, k                                 : Integer;
3577 begin
3578         // BBS \82Ì\8aJ\95ú
3579         try
3580           for i := 0 to Length( BBSs ) - 1 do
3581                 BBSs[ i ].Free;
3582         except
3583         end;
3584         SetLength( BBSs, 0 );
3585
3586         l := 0;
3587         // \94Â\83\8a\83X\83g\82Ì\97ñ\8b\93
3588         if FileExists( GikoSys.GetBoardFileName ) then begin
3589           SetLength( BBSs, l + 1 );
3590           BBSs[ l ]                             := TBBS.Create( GikoSys.GetBoardFileName );
3591           BBSs[ l ].Title       := '\82Q\82¿\82á\82ñ\82Ë\82é';
3592                   Inc( l );
3593         end;
3594
3595         if FileExists( GikoSys.GetCustomBoardFileName ) then begin
3596           SetLength( BBSs, l + 1 );
3597           BBSs[ l ]                             := TBBS.Create( GikoSys.GetCustomBoardFileName );
3598           BBSs[ l ].Title       := '\82»\82Ì\91¼';
3599                   Inc( l );
3600         end;
3601
3602         // Board \83t\83H\83\8b\83_
3603         if DirectoryExists( GikoSys.Setting.GetBoardDir ) then begin
3604           BoardFileList := TStringList.Create;
3605           try
3606                 GikoSys.GetFileList( GikoSys.Setting.GetBoardDir, '*', BoardFileList, True, True );
3607                 for k := BoardFileList.Count - 1 downto 0 do begin
3608                   if AnsiCompareText(ExtractFileExt(BoardFileList[ k ]), '.bak') = 0 then
3609                           BoardFileList.Delete(k);
3610                 end;
3611                           SetLength( BBSs, l + BoardFileList.Count );
3612                 for i := BoardFileList.Count - 1 downto 0 do begin
3613                   BBSs[ l ]                             := TBBS.Create( BoardFileList[ i ] );
3614                   BBSs[ l ].Title       := ChangeFileExt( ExtractFileName( BoardFileList[ i ] ), '' );
3615
3616                   Inc( l );
3617                 end;
3618           finally
3619                 BoardFileList.Free;
3620           end;
3621         end;
3622 end;
3623 (*************************************************************************
3624  *\8b@\94\\96¼\81@\81@\81F\83{\81[\83h\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
3625  *\89Â\8e\8b\81@\81@\81@\81FPublic
3626  *************************************************************************)
3627 procedure TGikoSys.ReadBoardFile( bbs : TBBS );
3628 var
3629         idx                                             : Integer;
3630         ini                                             : TMemIniFile;
3631         p : Integer;
3632         boardFile                       : TStringList;
3633         CategoryList    : TStringList;
3634         BoardList                       : TStringList;
3635         Category                        : TCategory;
3636         Board                                   : TBoard;
3637         inistr                          : string;
3638         RoundItem                       : TRoundItem;
3639
3640         i, iBound                       : Integer;
3641         j, jBound                       : Integer;
3642         k, kBound                       : Integer;
3643 begin
3644
3645   if not FileExists( bbs.FilePath ) then
3646         Exit;
3647         bbs.Clear;
3648   ini := TMemIniFile.Create('');
3649   boardFile := TStringList.Create;
3650   try
3651         boardFile.LoadFromFile( bbs.FilePath );
3652
3653     ini.SetStrings( boardFile );
3654     CategoryList        := TStringList.Create;
3655     BoardList                   := TStringList.Create;
3656     try
3657       ini.ReadSections( CategoryList );
3658
3659       iBound := CategoryList.Count - 1;
3660       for i := 0 to iBound do begin
3661                 ini.ReadSection( CategoryList[i], BoardList );
3662                 Category                                := TCategory.Create;
3663                 Category.No                     := i + 1;
3664                 Category.Title  := CategoryList[i];
3665
3666                 jBound := BoardList.Count - 1;
3667                 for j := 0 to jBound do begin
3668                   Board := nil;
3669                   inistr := ini.ReadString(CategoryList[i], BoardList[j], '');
3670                   p := FBoardURLList.IndexOf(inistr);
3671                   if p = -1 then begin
3672                           //===== \83v\83\89\83O\83C\83\93
3673                           try
3674                                 kBound := Length( BoardPlugIns ) - 1;
3675                                 for k := 0 to kBound do begin
3676                                   if Assigned( Pointer( BoardPlugIns[ k ].Module ) ) then begin
3677                                         if BoardPlugIns[ k ].AcceptURL( inistr ) = atBoard then begin
3678                                           Board := TBoard.Create( BoardPlugIns[ k ], inistr );
3679
3680                                           Break;
3681                                         end;
3682                                   end;
3683                                 end;
3684                           except
3685                                 // exception \82ª\94­\90\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
3686                           end;
3687
3688                           if Board = nil then
3689                                 Board := TBoard.Create( nil, inistr );
3690                           Board.BeginUpdate;
3691                           Board.No := j + 1;
3692                           Board.Title := BoardList[j];
3693                           Board.RoundDate := ZERO_DATE;
3694
3695                           idx := RoundList.Find(Board);
3696                           if idx <> -1 then begin
3697                                 RoundItem                               := RoundList.Items[idx, grtBoard];
3698                                 Board.Round                     := True;
3699                                 Board.RoundName := RoundItem.RoundName;
3700                           end;
3701                           Board.Multiplicity := 0;
3702                           Category.Add(Board);
3703                           Board.LoadSettings;
3704                           Board.EndUpdate;
3705                           FBoardURLList.AddObject(inistr, Board);
3706                   end else begin
3707                         Board := TBoard(FBoardURLList.Objects[p]);
3708                         Board.Multiplicity := Board.Multiplicity + 1;
3709                         Category.Add(Board);
3710                   end;
3711                 end;
3712
3713                 bbs.Add( Category );
3714           end;
3715                         bbs.IsBoardFileRead := True;
3716         finally
3717           BoardList.Free;
3718           CategoryList.Free;
3719         end;
3720   finally
3721         boardFile.Free;
3722         ini.Free;
3723   end;
3724
3725 end;
3726
3727 function        TGikoSys.GetUnknownCategory : TCategory;
3728 const
3729         UNKNOWN_CATEGORY = '(\96¼\8fÌ\95s\96¾)';
3730 begin
3731
3732         if Length( BBSs ) < 2 then begin
3733                 Result := nil;
3734                 Exit;
3735         end;
3736
3737         Result := BBSs[ 1 ].FindCategoryFromTitle( UNKNOWN_CATEGORY );
3738         if Result = nil then begin
3739                 Result                          := TCategory.Create;
3740                 Result.Title    := UNKNOWN_CATEGORY;
3741                 BBSs[ 1 ].Add( Result );
3742         end;
3743
3744 end;
3745
3746 function        TGikoSys.GetUnknownBoard( inPlugIn : TBoardPlugIn; inURL : string ) : TBoard;
3747 var
3748         category : TCategory;
3749 const
3750         UNKNOWN_BOARD = '(\96¼\8fÌ\95s\96¾)';
3751 begin
3752
3753         category := GetUnknownCategory;
3754         if category = nil then begin
3755                 Result := nil;
3756         end else begin
3757                 Result := category.FindBoardFromTitle( UNKNOWN_BOARD );
3758                 if Result = nil then begin
3759                         Result                          := TBoard.Create( inPlugIn, inURL );
3760                         Result.Title    := UNKNOWN_BOARD;
3761                         category.Add( Result );
3762                 end;
3763         end;
3764
3765 end;
3766 function TGikoSys.GetSambaFileName : string;
3767 begin
3768         Result := Setting.GetSambaFileName;
3769 end;
3770 procedure TGikoSys.SambaFileExists();
3771 var
3772         sambaTmp: string;
3773         sambaStrList: TStringList;
3774 begin
3775         if not FileExists(GikoSys.GetSambaFileName) then begin
3776                 sambaTmp := ChangeFileExt(GikoSys.GetSambaFileName, '.default');
3777                 sambaStrList := TStringList.Create;
3778                 try
3779                         if FileExists(sambaTmp) then begin
3780                                 sambaStrList.LoadFromFile(sambaTmp);
3781                                 sambaStrList.SaveToFile(GikoSys.GetSambaFileName);
3782                         end;
3783                 finally
3784                         sambaStrList.Free;
3785                 end;
3786         end;
3787 end;
3788 function TGikoSys.GetSameIDResAnchor(const AID : string; ThreadItem: TThreadItem):string;
3789 var
3790         i: integer;
3791         body: TStringList;
3792 begin
3793         Result := '';
3794         if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
3795                 body := TStringList.Create;
3796                 try
3797                         GetSameIDRes(AID, ThreadItem, body);
3798                         for i := 0 to body.Count - 1 do begin
3799                                 Result := Result + '&gt;' + body[i] + ' ';
3800                         end;
3801                 finally
3802                         body.Free;
3803                 end;
3804                 Result := ConvRes(Result, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', false);
3805         end;
3806 end;
3807 procedure TGikoSys.GetSameIDRes(const AID : string; ThreadItem: TThreadItem;var body: TStringList);
3808 var
3809         i: integer;
3810         ReadList: TStringList;
3811         Res: TResRec;
3812         boardPlugIn : TBoardPlugIn;
3813 begin
3814         if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
3815                 if ThreadItem.IsBoardPlugInAvailable then begin
3816                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
3817                         boardPlugIn             := ThreadItem.BoardPlugIn;
3818
3819                         for i := 0 to threadItem.Count - 1 do begin
3820                                 // \83\8c\83X
3821                                 Res := DivideStrLine(boardPlugIn.GetDat(DWORD( threadItem ), i + 1));
3822                                 if(AnsiPos(AID, Res.FDateTime) > 0) then begin
3823                                         body.Add(IntToStr(i+1));
3824                                 end;
3825                         end;
3826                 end else begin
3827                         ReadList := TStringList.Create;
3828                         try
3829                                 ReadList.LoadFromFile(ThreadItem.GetThreadFileName);
3830                                 for i := 0 to ReadList.Count - 1 do begin
3831                                         Res := DivideStrLine(ReadList[i]);
3832                                         if AnsiPos(AID, Res.FDateTime) > 0 then begin
3833                                                 body.Add(IntToStr(i+1));
3834                                         end;
3835                                 end;
3836                         finally
3837                                 ReadList.Free;
3838                         end;
3839                 end;
3840         end;
3841 end;
3842 function TGikoSys.GetSameIDResAnchor(AIDNum : Integer; ThreadItem: TThreadItem):string;
3843 var
3844         i: integer;
3845         body: TStringList;
3846 begin
3847         Result := '';
3848         if (ThreadItem <> nil) and (ThreadItem.IsLogFile) then begin
3849                 body := TStringList.Create;
3850                 try
3851                         GetSameIDRes(AIDNum, ThreadItem, body);
3852                         for i := 0 to body.Count - 1 do begin
3853                                 Result := Result + '&gt;' + body[i] + ' ';
3854                         end;
3855                 finally
3856                         body.Free;
3857                 end;
3858                 Result := ConvRes(Result, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', false);
3859         end;
3860 end;
3861
3862 procedure TGikoSys.GetSameIDRes(AIDNum : Integer; ThreadItem: TThreadItem;var body: TStringList);
3863 var
3864         Res: TResRec;
3865         boardPlugIn : TBoardPlugIn;
3866         AID : String;
3867         stList: TStringList;
3868         i : Integer;
3869 begin
3870         if (ThreadItem <> nil) and (ThreadItem.IsLogFile)
3871                 and (AIDNum > 0) and (AIDNum <= ThreadItem.Count) then begin
3872                 if ThreadItem.IsBoardPlugInAvailable then begin
3873                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
3874                         boardPlugIn             := ThreadItem.BoardPlugIn;
3875                         Res := DivideStrLine(boardPlugIn.GetDat(DWORD( threadItem ), AIDNum));
3876                 end else begin
3877                         Res := DivideStrLine( ReadThreadFile(ThreadItem.GetThreadFileName, AIDNum));
3878                 end;
3879                 AID := Res.FDateTime;
3880                 if AnsiPos('id', AnsiLowerCase(AID)) > 0 then
3881                         AID := Copy(AID, AnsiPos('id', AnsiLowerCase(AID)) - 1, 11)
3882                 else begin
3883                         stlist := TStringList.Create;
3884                         try
3885                                 stList.DelimitedText := AID;
3886                                 for i := 0 to stList.Count - 1 do
3887                                         if Length(WideString(stList[i])) = 8 then begin
3888                                                 if NotDateorTimeString(stList[i]) then begin
3889                                                         AID := stList[i];
3890                                                         break;
3891                                                 end;
3892                                         end;
3893                         finally
3894                                 stList.Free;
3895                         end;
3896                 end;
3897
3898                 GetSameIDRes(AID, ThreadItem, body);
3899         end;
3900 end;
3901 function TGikoSys.NotDateorTimeString(const AStr : string): boolean;
3902 begin
3903         Result := false;
3904         try
3905                 StrToDate(AStr);
3906         except
3907                 try
3908                         StrToTime(AStr);
3909                         Result := false;
3910                 except
3911                         Result := true;
3912                 end;
3913         end;
3914
3915 end;
3916
3917 procedure TGikoSys.SpamCountWord( const text : string; wordCount : TWordCount );
3918 begin
3919
3920         if Setting.SpamFilterAlgorithm = gsfaNone then Exit;
3921         Bayesian.CountWord( text, wordCount );
3922
3923 end;
3924
3925 procedure TGikoSys.SpamForget( wordCount : TWordCount; isSpam : Boolean );
3926 begin
3927
3928         if Setting.SpamFilterAlgorithm = gsfaNone then Exit;
3929         Bayesian.Forget( wordCount, isSpam );
3930
3931 end;
3932
3933 procedure TGikoSys.SpamLearn( wordCount : TWordCount; isSpam : Boolean );
3934 begin
3935
3936         if Setting.SpamFilterAlgorithm = gsfaNone then Exit;
3937         Bayesian.Learn( wordCount, isSpam );
3938
3939 end;
3940
3941 function TGikoSys.SpamParse( const text : string; wordCount : TWordCount ) : Extended;
3942 begin
3943
3944         case Setting.SpamFilterAlgorithm of
3945         gsfaNone:                                                               Result := 0;
3946         gsfaPaulGraham:                                 Result := Bayesian.Parse( text, wordCount, gbaPaulGraham );
3947         gsfaGaryRobinson:                               Result := Bayesian.Parse( text, wordCount, gbaGaryRobinson );
3948         gsfaGaryRobinsonFisher: Result := Bayesian.Parse( text, wordCount, gbaGaryRobinsonFisher );
3949         else                                                                            Result := 0;
3950         end;
3951
3952 end;
3953 function TGikoSys.SetUserOptionalStyle(): string;
3954 begin
3955     Result := '';
3956         if Length( GikoSys.Setting.BrowserFontName ) > 0 then
3957                 Result := 'font-family:"' + GikoSys.Setting.BrowserFontName + '";';
3958         if GikoSys.Setting.BrowserFontSize <> 0 then
3959                 Result := Result + 'font-size:' + IntToStr( GikoSys.Setting.BrowserFontSize ) + 'pt;';
3960         if GikoSys.Setting.BrowserFontColor <> -1 then
3961                 Result := Result + 'color:#' + IntToHex( GikoSys.Setting.BrowserFontColor, 6 ) + ';';
3962         if GikoSys.Setting.BrowserBackColor <> -1 then
3963                 Result := Result + 'background-color:#' + IntToHex( GikoSys.Setting.BrowserBackColor, 6 ) + ';';
3964         case GikoSys.Setting.BrowserFontBold of
3965                 -1: Result := Result + 'font-weight:normal;';
3966                 1:  Result := Result + 'font-weight:bold;';
3967         end;
3968         case GikoSys.Setting.BrowserFontItalic of
3969                 -1: Result := Result + 'font-style:normal;';
3970                 1:  Result := Result + 'font-style:italic;';
3971         end;
3972 end;
3973
3974 initialization
3975         GikoSys := TGikoSys.Create;
3976
3977 finalization
3978         if GikoSys <> nil then begin
3979                 GikoSys.Free;
3980                 GikoSys := nil;
3981         end;
3982 end.