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