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