GikoSystem.pas

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