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