OSDN Git Service

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