OSDN Git Service

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