GikoSystem.pas

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