GikoSystem.pas

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