OSDN Git Service

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