OSDN Git Service

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