GikoSystem.pas

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