OSDN Git Service

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