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