OSDN Git Service

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