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