OSDN Git Service

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