GikoSystem.pas

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