GikoSystem.pas

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