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
  18 type
  19         //BBS\83^\83C\83v
  20         TGikoBBSType = (gbt2ch);
  21         //\83\8d\83O\83^\83C\83v
  22         TGikoLogType = (glt2chNew, glt2chOld);
  23         //\83\81\83b\83Z\81[\83W\83A\83C\83R\83\93
  24         TGikoMessageIcon = (gmiOK, gmiSAD, gmiNG, gmiWhat, gmiNone);
  25         //URL\83I\81[\83v\83\93\83u\83\89\83E\83U\83^\83C\83v
  26         TGikoBrowserType = (gbtIE, gbtUserApp, gbtAuto);
  27
  28
  29         TStrTokSeparator = set of Char;
  30         TStrTokRec = record
  31                 Str: string;
  32                 Pos: Integer;
  33         end;
  34
  35         //\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b\83\8c\83R\81[\83h
  36         TIndexRec = record
  37                 FNo: Integer;
  38                 FFileName: string;
  39                 FTitle: string;
  40                 FCount: Integer;
  41                 FSize: Integer;
  42 //              FRoundNo: Integer;
  43                 FRoundDate: TDateTime;
  44                 FLastModified: TDateTime;
  45                 FKokomade: Integer;
  46                 FNewReceive: Integer;
  47                 FMishiyou: Boolean;     //\96¢\8eg\97p
  48                 FUnRead: Boolean;
  49                 FScrollTop: Integer;
  50                 //Index Ver 1.01
  51                 FAllResCount: Integer;
  52                 FNewResCount: Integer;
  53                 FAgeSage: TGikoAgeSage;
  54         end;
  55
  56         //\83T\83u\83W\83F\83N\83g\83\8c\83R\81[\83h
  57         TSubjectRec = record
  58                 FFileName: string;
  59                 FTitle: string;
  60                 FCount: Integer;
  61         end;
  62
  63         //\83\8c\83X\83\8c\83R\81[\83h
  64         TResRec = record
  65                 FTitle: string;
  66                 FMailTo: string;
  67                 FName: string;
  68                 FDateTime: string;
  69                 FBody: string;
  70                 FType: TGikoLogType;
  71         end;
  72
  73         //URLPath\83\8c\83R\81[\83h
  74         TPathRec = record
  75                 FBBS: string;                           //BBSID
  76                 FKey: string;                           //ThreadID
  77                 FSt: Integer;                           //\8aJ\8en\83\8c\83X\94Ô
  78                 FTo: Integer;                           //\8fI\97¹\83\8c\83X\94Ô
  79                 FFirst: Boolean;                //>>1\82Ì\95\\8e¦
  80                 FStBegin: Boolean;      //1\81`\95\\8e¦
  81                 FToEnd: Boolean;                //\81`\8dÅ\8cã\82Ü\82Å\95\\8e¦
  82                 FDone: Boolean;                 //\90¬\8c÷
  83         end;
  84
  85         TGikoSys = class(TObject)
  86         private
  87                 { Private \90é\8c¾ }
  88                 FSetting: TSetting;
  89                 FDolib: TDolib;
  90                 FAWKStr: TAWKStr;
  91                 FOnlyAHundredRes : Boolean;
  92 //              FExitWrite: TStringList;
  93 //              function StrToFloatDef(s: string; Default: Double): Double;
  94
  95         public
  96                 { Public \90é\8c¾ }
  97                 FAbon : TAbon;
  98                 FSelectResFilter : TAbon;
  99                 constructor Create;
 100
 101                 destructor Destroy; override;
 102                 property OnlyAHundredRes : Boolean read FOnlyAHundredRes write FOnlyAHundredRes;
 103
 104 //              function MsgBox(Msg: string; Title: string; Flags: Longint): integer; overload;
 105 //              function MsgBox(Handle: THandle; Msg: string; Title: string; Flags: Longint): integer; overload;
 106                 function IsNumeric(s: string): boolean;
 107                 function IsFloat(s: string): boolean;
 108                 function DirectoryExistsEx(const Name: string): Boolean;
 109                 function ForceDirectoriesEx(Dir: string): Boolean;
 110 //              function GetVersion: string;
 111
 112                 function GetBoardFileName: string;
 113                 function GetCustomBoardFileName: string;
 114                 function GetHtmlTempFileName: string;
 115                 function GetAppDir: string;
 116                 function GetTempFolder: string;
 117                 function GetSentFileName: string;
 118                 function GetConfigDir: string;
 119                 function GetSkinDir: string;
 120                 function GetSkinHeaderFileName: string;
 121                 function GetSkinFooterFileName: string;
 122                 function GetSkinResFileName: string;
 123                 function GetSkinNewResFileName: string;
 124                 function GetSkinBookmarkFileName: string;
 125                 function GetSkinNewmarkFileName: string;
 126                 function GetStyleSheetDir: string;
 127                 function GetOutBoxFileName: string;
 128                 function GetUserAgent: string;
 129
 130                 procedure ReadSubjectFile(Board: TBoard);
 131                 procedure CreateThreadDat(Board: TBoard);
 132                 procedure WriteThreadDat(Board: TBoard);
 133                 function ParseIndexLine(Line: string): TIndexRec;
 134                 procedure GetFileList(Path: string; Mask: string; List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
 135                 procedure GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
 136
 137                 procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
 138                 function AddAnchorTag(s: string): string;
 139
 140                 function DivideSubject(Line: string): TSubjectRec;
 141                 function DivideStrLine(Line: string): TResRec;
 142
 143                 property Setting: TSetting read FSetting write FSetting;
 144                 property Dolib: TDolib read FDolib write FDolib;
 145
 146                 function UrlToID(url: string): string;
 147                 function UrlToServer(url: string): string;
 148
 149                 function StrTokFirst(const s:string; const sep:TStrTokSeparator; var Rec:TStrTokRec):string;
 150                 function StrTokNext(const sep:TStrTokSeparator; var Rec:TStrTokRec): string;
 151
 152                 function GetFileSize(FileName : string) : longint;
 153                 function GetFileLineCount(FileName : string): longint;
 154                 function Get2chDate(aDate: TDateTime): string;
 155                 function IntToDateTime(val: Int64): TDateTime;
 156                 function DateTimeToInt(ADate: TDateTime): Integer;
 157
 158                 function ReadThreadFile(FileName: string; Line: Integer): string;
 159
 160                 procedure MenuFont(Font: TFont);
 161
 162                 function RemoveToken(var s:string;delimiter:string):string;
 163                 function GetTokenIndex(s: string; delimiter: string; index: Integer): string;
 164
 165                 function DeleteLink(const s: string): string;
 166
 167                 function GetShortName(const LongName: string; ALength: integer): string;
 168                 function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string): string;
 169
 170                 function ZenToHan(const s: string): string;
 171                 function VaguePos(const Substr, S: string): Integer;
 172                 function BoolToInt(b: Boolean): Integer;
 173                 function IntToBool(i: Integer): Boolean;
 174                 function GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
 175                 procedure LoadKeySetting(ActionList: TActionList);
 176                 procedure SaveKeySetting(ActionList: TActionList);
 177                 procedure CreateProcess(const AppPath: string; const Param: string);
 178                 procedure OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
 179                 function HTMLDecode(const AStr: String): String;
 180                 function GetHRefText(s: string): string;
 181                 function Is2chHost(Host: string): Boolean;
 182                 function Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
 183                 function Parse2chURL2(URL: string): TPathRec;
 184                 procedure ParseURI(var URL, Protocol, Host, Path, Document, Port, Bookmark: string);
 185                 function GetVersionBuild: Integer;
 186                 function        Get2chThreadURL2BoardURL( inURL : string ) : string;
 187                 function        Get2chBrowsableThreadURL( inURL : string ) : string;
 188                 function        Get2chBoard2ThreadURL( inBoard : TBoard; inKey : string ) : string;
 189                 procedure ReadBoardFile;
 190
 191                 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
 192                 function LoadFromSkin( fileName: string; ThreadItem: TThreadItem; SizeByte: Integer ): string;
 193         // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
 194                 function SkinedRes( skin: string; Res: TResRec; No: string ): string;
 195
 196         end;
 197
 198 var
 199         GikoSys: TGikoSys;
 200 const
 201         LENGTH_RESTITLE                 = 40;
 202         ZERO_DATE: Integer      = 25569;
 203         BETA_VERSION_NAME_E = 'beta';
 204         BETA_VERSION_NAME_J = 'ÊÞÀ';
 205         BETA_VERSION                            = 44;
 206         BETA_VERSION_BUILD      = '';                           //debug\94Å\82È\82Ç
 207         APP_NAME                                                = 'gikoNavi';
 208
 209 implementation
 210
 211 uses
 212         Giko, RoundData, ExternalBoardManager, ExternalBoardPlugInMain;
 213
 214 const
 215         FOLDER_INDEX_VERSION                                    = '1.01';
 216         USER_AGENT                                                                              = 'Monazilla';
 217         DEFAULT_NGWORD_FILE_NAME : String = 'NGword.txt';
 218         NGWORDs_DIR_NAME : String               = 'NGwords';
 219
 220 (*************************************************************************
 221  *GikoSys\83R\83\93\83X\83g\83\89\83N\83^
 222  *************************************************************************)
 223 constructor TGikoSys.Create;
 224 begin
 225         FSetting := TSetting.Create;
 226         FDolib := TDolib.Create;
 227         FAWKStr := TAWKStr.Create(nil);
 228         if DirectoryExists(GetConfigDir) = false then begin
 229                 CreateDir(GetConfigDir);
 230         end;
 231         FAbon := TAbon.Create;
 232         FAbon.Setroot(GetConfigDir+NGWORDs_DIR_NAME);
 233         FAbon.GoHome;
 234         FAbon.ReturnNGwordLineNum := FSetting.ShowNGLinesNum;
 235         FAbon.SetNGResAnchor := FSetting.AddResAnchor;
 236         FAbon.Deleterlo := FSetting.AbonDeleterlo;
 237         FAbon.Replaceul := FSetting.AbonReplaceul;
 238         FAbon.AbonPopupRes := FSetting.PopUpAbon;
 239
 240         FSelectResFilter := TAbon.Create;
 241         // \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
 242         FSelectResFilter.AbonString := '';
 243         //
 244         OnlyAHundredRes := FSetting.OnlyAHundredRes;
 245 end;
 246
 247 (*************************************************************************
 248  *GikoSys\83f\83X\83g\83\89\83N\83^
 249  *************************************************************************)
 250 destructor TGikoSys.Destroy;
 251 var
 252         i: Integer;
 253         FileList: TStringList;
 254 begin
 255         //\83X\83\8c\83b\83h\83f\81[\83^\83t\83@\83C\83\8b\82ð\8dX\90V
 256 //      FlashExitWrite;
 257
 258 //      FExitWrite.Free;
 259         FAWKStr.Free;
 260         FSetting.Free;
 261         FDolib.Free;
 262
 263         //\83e\83\93\83|\83\89\83\8aHTML\82ð\8dí\8f\9c
 264         FileList := TStringList.Create;
 265         try
 266                 GetFileList(GetTempFolder, '*.html', FileList, False, True);
 267                 for i := 0 to FileList.Count - 1 do begin
 268                         DeleteFile(FileList[i]);
 269                 end;
 270         finally
 271                 FileList.Free;
 272         end;
 273         inherited;
 274 end;
 275
 276 (*************************************************************************
 277  *\95¶\8e\9a\97ñ\90\94\8e\9a\83`\83F\83b\83N
 278  *************************************************************************)
 279 {$HINTS OFF}
 280 function TGikoSys.IsNumeric(s: string): boolean;
 281 var
 282         e: integer;
 283         v: integer;
 284 begin
 285         Val(s, v, e);
 286         Result := e = 0;
 287 end;
 288 {$HINTS ON}
 289
 290 (*************************************************************************
 291  *\95¶\8e\9a\97ñ\95\82\93®\8f¬\90\94\93_\90\94\8e\9a\83`\83F\83b\83N
 292  *************************************************************************)
 293 function TGikoSys.IsFloat(s: string): boolean;
 294 var
 295         v: Extended;
 296 begin
 297         Result := TextToFloat(PChar(s), v, fvExtended);
 298 end;
 299
 300 (*************************************************************************
 301  *\83{\81[\83h\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 302  *************************************************************************)
 303 function TGikoSys.GetBoardFileName: string;
 304 begin
 305         Result := Setting.GetBoardFileName;
 306 end;
 307
 308 (*************************************************************************
 309  *\83{\81[\83h\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 310  *************************************************************************)
 311 function TGikoSys.GetCustomBoardFileName: string;
 312 begin
 313         Result := Setting.GetCustomBoardFileName;
 314 end;
 315
 316 (*************************************************************************
 317  *\83e\83\93\83|\83\89\83\8a\83t\83H\83\8b\83_\81[\96¼\8eæ\93¾
 318  *************************************************************************)
 319 function TGikoSys.GetHtmlTempFileName: string;
 320 begin
 321         Result := Setting.GetHtmlTempFileName;
 322 end;
 323
 324
 325 (*************************************************************************
 326  *\8eÀ\8ds\83t\83@\83C\83\8b\83t\83H\83\8b\83_\8eæ\93¾
 327  *************************************************************************)
 328 function TGikoSys.GetAppDir: string;
 329 begin
 330         Result := Setting.GetAppDir;
 331 end;
 332
 333 (*************************************************************************
 334  *TempHtml\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 335  *************************************************************************)
 336 function TGikoSys.GetTempFolder: string;
 337 begin
 338         Result := Setting.GetTempFolder;
 339 end;
 340
 341 (*************************************************************************
 342  *sent.ini\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 343  *************************************************************************)
 344 function TGikoSys.GetSentFileName: string;
 345 begin
 346         Result := Setting.GetSentFileName;
 347 end;
 348
 349 (*************************************************************************
 350  *outbox.ini\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 351  *************************************************************************)
 352 function TGikoSys.GetOutBoxFileName: string;
 353 begin
 354         Result := Setting.GetOutBoxFileName;
 355 end;
 356
 357 (*************************************************************************
 358  *Config\83t\83H\83\8b\83_\8eæ\93¾
 359  *************************************************************************)
 360 function TGikoSys.GetConfigDir: string;
 361 begin
 362         Result := Setting.GetConfigDir;
 363 end;
 364
 365 function TGikoSys.GetStyleSheetDir: string;
 366 begin
 367         Result := Setting.GetStyleSheetDir;
 368 end;
 369
 370 function TGikoSys.GetSkinDir: string;
 371 begin
 372         Result := Setting.GetSkinDir;
 373 end;
 374
 375 function TGikoSys.GetSkinHeaderFileName: string;
 376 begin
 377         Result := Setting.GetSkinHeaderFileName;
 378 end;
 379
 380 function TGikoSys.GetSkinFooterFileName: string;
 381 begin
 382         Result := Setting.GetSkinFooterFileName;
 383 end;
 384
 385 function TGikoSys.GetSkinNewResFileName: string;
 386 begin
 387         Result := Setting.GetSkinNewResFileName;
 388 end;
 389
 390 function TGikoSys.GetSkinResFileName: string;
 391 begin
 392         Result := Setting.GetSkinResFileName;
 393 end;
 394
 395 function TGikoSys.GetSkinBookmarkFileName: string;
 396 begin
 397         Result := Setting.GetSkinBookmarkFileName;
 398 end;
 399
 400 function TGikoSys.GetSkinNewmarkFileName: string;
 401 begin
 402         Result := Setting.GetSkinNewmarkFileName;
 403 end;
 404
 405 // UserAgent\8eæ\93¾
 406 function TGikoSys.GetUserAgent: string;
 407 begin
 408         if Dolib.Connected then begin
 409                 Result := Format('%s %s/%s%d%s', [
 410                                                                 Dolib.UserAgent,
 411                                                                 APP_NAME,
 412                                                                 //MAJOR_VERSION,
 413                                                                 //MINOR_VERSION,
 414                                                                 BETA_VERSION_NAME_E,
 415                                                                 BETA_VERSION,
 416                                                                 BETA_VERSION_BUILD]);
 417         end else begin
 418                 Result := Format('%s/%s %s/%s%d%s', [
 419                                                                 USER_AGENT,
 420                                                                 Dolib.Version,
 421                                                                 APP_NAME,
 422                                                                 //MAJOR_VERSION,
 423                                                                 //MINOR_VERSION,
 424                                                                 BETA_VERSION_NAME_E,
 425                                                                 BETA_VERSION,
 426                                                                 BETA_VERSION_BUILD]);
 427         end;
 428 end;
 429
 430 (*************************************************************************
 431  *\82Q\82¿\82á\82ñ\82Ë\82é\95û\8e®\8e\9e\8d\8f\8eæ\93¾
 432  *************************************************************************)
 433 function TGikoSys.Get2chDate(aDate: TDateTime): string;
 434 var
 435         d1: TDateTime;
 436         d2: TDateTime;
 437 begin
 438         d1 := EncodeDate(1970, 1, 1);
 439         d2 := aDate - EncodeTime(9, 0, 0, 0);
 440         Result := FloatToStr(Trunc((d2 - d1) * 24 * 60 * 60));
 441 end;
 442
 443
 444 function TGikoSys.IntToDateTime(val: Int64): TDateTime;
 445 var
 446         d1: tdatetime;
 447         d2: tdatetime;
 448 begin
 449         d1 := EncodeDate(1970, 1, 1);
 450         d2 := (val * 1000) / (24 * 60 * 60 * 1000);
 451         Result := d1 + d2;
 452 end;
 453
 454 function TGikoSys.DateTimeToInt(ADate: TDateTime): Integer;
 455 var
 456         d: TDateTime;
 457         c: Currency;
 458 begin
 459         d := EncodeDate(1970, 1, 1);
 460         c := (ADate - d) * 24 * 60 * 60;
 461         Result := Trunc(c);
 462 end;
 463
 464
 465 (*************************************************************************
 466  *Subject\83t\83@\83C\83\8bRead
 467  *************************************************************************)
 468 procedure TGikoSys.ReadSubjectFile(Board: TBoard);
 469 var
 470         ThreadItem: TThreadItem;
 471         FileName: string;
 472         FileList: TStringList;
 473         TmpFileList: TStringList;
 474 //      SrchRec: TSearchRec;
 475 //      R: integer;
 476         Index: Integer;
 477         sl: TStringList;
 478         i: Integer;
 479         Rec: TIndexRec;
 480         UnRead: Integer;
 481 //      TmpUpdate: Boolean;
 482         ini: TMemIniFile;
 483         ResRec: TResRec;
 484         RoundItem: TRoundItem;
 485         idx: Integer;
 486         usePlugIn : Boolean;
 487 begin
 488         Board.Clear;
 489         UnRead := 0;
 490 //      TmpUpdate := False;
 491
 492         usePlugIn := Board.IsBoardPlugInAvailable;
 493
 494         FileName := Board.GetFolderIndexFileName;
 495         if not FileExists(FileName) then CreateThreadDat(Board);
 496 //      if not FileExists(FileName) then Exit;
 497
 498         {       R := FindFirst(ExtractFileDir(Board.GetFolderIndexFileName) + '\*.dat', 0, SrchRec);
 499                 while R = 0 do begin
 500                         FileList.Add(SrchRec.Name);
 501                         R := FindNext(SrchRec);
 502                 end;
 503                 FindClose(SrchRec);}
 504
 505         FileList := TStringList.Create;
 506         FileList.Sorted := True;
 507         TmpFileList := TStringList.Create;
 508         TmpFileList.Sorted := True;
 509
 510         //IsLogFile\97pDAT\83t\83@\83C\83\8b\83\8a\83X\83g
 511         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.dat', FileList, False, False);
 512
 513         //\91O\89ñ\88Ù\8fí\8fI\97¹\8e\9e\97pTmp\83t\83@\83C\83\8b\83\8a\83X\83g
 514         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, False, False);
 515
 516
 517         sl := TStringList.Create;
 518         try
 519                 if FileExists(FileName) then
 520                         sl.LoadFromFile(FileName);
 521
 522                 //\82Q\8ds\96Ú\82©\82ç\81i\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93\81j
 523                 for i := 1 to sl.Count - 1 do begin
 524                         Rec := ParseIndexLine(sl[i]);
 525
 526                         if usePlugIn then
 527                                 ThreadItem := TThreadItem.Create(
 528                                         Board.BoardPlugIn,
 529                                         Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), Rec.FFileName ) )
 530                         else
 531                                 ThreadItem := TThreadItem.Create(
 532                                         nil,
 533                                         Get2chBoard2ThreadURL( Board, ChangeFileExt( Rec.FFileName, '' ) ) );
 534                         ThreadItem.BeginUpdate;
 535                         ThreadItem.No := Rec.FNo;
 536                         ThreadItem.FileName := Rec.FFileName;
 537                         ThreadItem.Title := Rec.FTitle;
 538                         ThreadItem.Count := Rec.FCount;
 539                         ThreadItem.Size := Rec.FSize;
 540 //                      ThreadItem.RoundNo := Rec.FRoundNo;
 541                         ThreadItem.RoundDate := Rec.FRoundDate;
 542                         ThreadItem.LastModified := Rec.FLastModified;
 543                         ThreadItem.Kokomade := Rec.FKokomade;
 544                         ThreadItem.NewReceive := Rec.FNewReceive;
 545 //                      ThreadItem.Round := Rec.FRound;
 546                         ThreadItem.UnRead := Rec.FUnRead;
 547                         ThreadItem.ScrollTop := Rec.FScrollTop;
 548                         ThreadItem.AllResCount := Rec.FAllResCount;
 549                         ThreadItem.NewResCount := Rec.FNewResCount;
 550                         ThreadItem.AgeSage := Rec.FAgeSage;
 551                         ThreadItem.ParentBoard := Board;
 552
 553                         //IsLogFile\83`\83F\83b\83N
 554                         ThreadItem.IsLogFile := False;
 555                         if FileList.Count <> 0 then begin
 556                                 if FileList.Find(ThreadItem.FileName, Index) then begin
 557                                         ThreadItem.IsLogFile := True;
 558                                         FileList.Delete(Index);
 559                                 end;
 560                         end;
 561
 562                         //\8f\84\89ñ\83\8a\83X\83g\82É\91¶\8dÝ\82µ\82½\82ç\8f\84\89ñ\83t\83\89\83O\83Z\83b\83g
 563                         if ThreadItem.IsLogFile then begin
 564                                 idx := RoundList.Find(ThreadItem);
 565                                 if idx <> -1 then begin
 566                                         RoundItem := RoundList.Items[idx, grtItem];
 567                                         ThreadItem.RoundName := RoundItem.RoundName;
 568                                         ThreadItem.Round := True;
 569                                 end;
 570                         end;
 571
 572                         //\91O\89ñ\88Ù\8fí\8fI\97¹\8e\9e\83`\83F\83b\83N
 573                         if TmpFileList.Count <> 0 then begin
 574                                 if TmpFileList.Find(ChangeFileExt(ThreadItem.FileName, '.tmp'), Index) then begin
 575                                         ini := TMemIniFile.Create(ChangeFileExt(ThreadItem.GetThreadFileName, '.tmp'));
 576                                         try
 577                                                 ThreadItem.RoundDate := ini.ReadDateTime('Setting', 'RoundDate', ZERO_DATE);
 578                                                 ThreadItem.LastModified := ini.ReadDateTime('Setting', 'LastModified', ZERO_DATE);
 579                                                 ThreadItem.Size := ini.ReadInteger('Setting', 'Size', 0);
 580                                                 ThreadItem.Count := ini.ReadInteger('Setting', 'Count', 0);
 581                                                 ThreadItem.NewReceive := ini.ReadInteger('Setting', 'NewReceive', 0);
 582                                                 ThreadItem.Round := ini.ReadBool('Setting', 'Round', False);
 583                                                 ThreadItem.UnRead := False;//ini.ReadBool('Setting', 'UnRead', False);
 584                                                 ThreadItem.ScrollTop := ini.ReadInteger('Setting', 'ScrollTop', 0);
 585                                                 ThreadItem.AllResCount := ini.ReadInteger('Setting', 'AllResCount', 0);
 586                                                 ThreadItem.NewResCount := ini.ReadInteger('Setting', 'NewResCount', 0);
 587                                                 ThreadItem.AgeSage := TGikoAgeSage(ini.ReadInteger('Setting', 'AgeSage', Ord(gasNone)));
 588                                         finally
 589                                                 ini.Free;
 590                                         end;
 591                                         TmpFileList.Delete(Index);
 592                                 end;
 593                         end;
 594
 595                         ThreadItem.EndUpdate;
 596                         Board.Add(ThreadItem);
 597
 598 //                      if (ThreadItem.IsLogFile) and (ThreadItem.Count > ThreadItem.Kokomade) then
 599                         if (ThreadItem.IsLogFile) and (ThreadItem.UnRead) then
 600                                 Inc(UnRead);
 601                 end;
 602
 603                 if UnRead <> Board.UnRead then
 604                         Board.UnRead := UnRead;
 605
 606                 //\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
 607                 for i := 0 to FileList.Count - 1 do begin
 608                         FileName := ExtractFileDir(Board.GetFolderIndexFileName) + '\' + FileList[i];
 609
 610                         ResRec := DivideStrLine(ReadThreadFile(FileName, 1));
 611                         if usePlugIn then
 612                                 ThreadItem := TThreadItem.Create(
 613                                         Board.BoardPlugIn,
 614                                         Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), Rec.FFileName ) )
 615                         else
 616                                 ThreadItem := TThreadItem.Create(
 617                                         nil, Get2chBoard2ThreadURL( Board, ChangeFileExt( Rec.FFileName, '' ) ) );
 618                         ThreadItem.No := Board.Count + 1;
 619                         ThreadItem.FileName := FileList[i];
 620                         ThreadItem.Title := ResRec.FTitle;
 621                         ThreadItem.Count := GetFileLineCount(FileName);
 622                         ThreadItem.AllResCount := ThreadItem.Count;
 623                         ThreadItem.NewResCount := 0;
 624                         ThreadItem.Size := 0;
 625                         ThreadItem.RoundDate := ZERO_DATE;
 626                         ThreadItem.LastModified := ZERO_DATE;
 627                         ThreadItem.Kokomade := -1;
 628                         ThreadItem.NewReceive := 0;
 629                         ThreadItem.ParentBoard := Board;
 630                         ThreadItem.IsLogFile := True;
 631                         ThreadItem.Round := False;
 632                         ThreadItem.UnRead := False;
 633                         ThreadItem.ScrollTop := 0;
 634                         ThreadItem.AgeSage := gasNone;
 635                         Board.Add(ThreadItem);
 636                 end;
 637         finally
 638                 sl.Free;
 639         end;
 640         FileList.Free;
 641         TmpFileList.Free;
 642         Board.IsThreadDatRead := True;
 643 end;
 644
 645 (*************************************************************************
 646  *\83X\83\8c\83b\83h\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b(Folder.idx)\8dì\90¬
 647  *************************************************************************)
 648 procedure TGikoSys.CreateThreadDat(Board: TBoard);
 649 var
 650         i: integer;
 651         s: string;
 652         SubjectList: TStringList;
 653         sl: TStringList;
 654         Rec: TSubjectRec;
 655         FileName: string;
 656         cnt: Integer;
 657 begin
 658         if not FileExists(Board.GetSubjectFileName) then Exit;
 659         FileName := Board.GetFolderIndexFileName;
 660
 661         SubjectList := TStringList.Create;
 662         try
 663                 SubjectList.LoadFromFile(Board.GetSubjectFileName);
 664                 sl := TStringList.Create;
 665                 try
 666                         cnt := 1;
 667                         sl.Add(FOLDER_INDEX_VERSION);
 668                         for i := 0 to SubjectList.Count - 1 do begin
 669                                 Rec := DivideSubject(SubjectList[i]);
 670
 671                                 if (Trim(Rec.FFileName) = '') or (Trim(Rec.FTitle) = '') then
 672                                         Continue;
 673
 674                                 s := Format('%x', [cnt]) + #1                                   //\94Ô\8d\86
 675                                          + Rec.FFileName + #1                                                           //\83t\83@\83C\83\8b\96¼
 676                                          + Rec.FTitle + #1                                                                      //\83^\83C\83g\83\8b
 677                                          + Format('%x', [Rec.FCount]) + #1      //\83J\83E\83\93\83g
 678                                          + Format('%x', [0]) + #1                                               //size
 679                                          + Format('%x', [0]) + #1                                               //RoundDate
 680                                          + Format('%x', [0]) + #1                                               //LastModified
 681                                          + Format('%x', [0]) + #1                                               //Kokomade
 682                                          + Format('%x', [0]) + #1                                               //NewReceive
 683                                          + '0' + #1                                                                                             //\96¢\8eg\97p
 684                                          + Format('%x', [0]) + #1                                               //UnRead
 685                                          + Format('%x', [0]) + #1                                               //ScrollTop
 686                                          + Format('%x', [Rec.FCount]) + #1      //AllResCount
 687                                          + Format('%x', [0]) + #1                                               //NewResCount
 688                                          + Format('%x', [0]);                                                           //AgeSage
 689
 690                                 sl.Add(s);
 691                                 inc(cnt);
 692                         end;
 693                         sl.SaveToFile(FileName);
 694                 finally
 695                         sl.Free;
 696                 end;
 697         finally
 698                 SubjectList.Free;
 699         end;
 700 end;
 701
 702 (*************************************************************************
 703  *\83X\83\8c\83b\83h\83C\83\93\83f\83b\83N\83X(Thread.dat)\8f\91\82«\8d\9e\82Ý
 704  *Public
 705  *************************************************************************)
 706 procedure TGikoSys.WriteThreadDat(Board: TBoard);
 707 //const
 708 //      Values: array[Boolean] of string = ('0', '1');
 709 var
 710         i: integer;
 711         FileName: string;
 712         sl: TStringList;
 713         s: string;
 714         FileList: TStringList;
 715 begin
 716         if not Board.IsThreadDatRead then
 717                 Exit;
 718         FileName := Board.GetFolderIndexFileName;
 719         ForceDirectoriesEx( ExtractFilePath( FileName ) );
 720
 721         sl := TStringList.Create;
 722         try
 723                 sl.Add(FOLDER_INDEX_VERSION);
 724                 for i := 0 to Board.Count - 1 do begin
 725                         if Board.Items[i].No = 0 then
 726                                 Board.Items[i].No := i + 1;
 727
 728                         s := Format('%x', [Board.Items[i].No]) + #1
 729                                  + Board.Items[i].FileName + #1
 730                                  + Board.Items[i].Title + #1
 731                                  + Format('%x', [Board.Items[i].Count]) + #1
 732                                  + Format('%x', [Board.Items[i].Size]) + #1
 733                                  + Format('%x', [DateTimeToInt(Board.Items[i].RoundDate)]) + #1
 734                                  + Format('%x', [DateTimeToInt(Board.Items[i].LastModified)]) + #1
 735                                  + Format('%x', [Board.Items[i].Kokomade]) + #1
 736                                  + Format('%x', [Board.Items[i].NewReceive]) + #1
 737                                  + '0' + #1     //\96¢\8eg\97p
 738                                  + Format('%x', [BoolToInt(Board.Items[i].UnRead)]) + #1
 739                                  + Format('%x', [Board.Items[i].ScrollTop]) + #1
 740                                  + Format('%x', [Board.Items[i].AllResCount]) + #1
 741                                  + Format('%x', [Board.Items[i].NewResCount]) + #1
 742                                  + Format('%x', [Ord(Board.Items[i].AgeSage)]);
 743
 744                         sl.Add(s);
 745                 end;
 746
 747                 sl.SaveToFile(FileName);
 748
 749                 FileList := TStringList.Create;
 750                 try
 751                         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', FileList, False, True);
 752                         for i := 0 to FileList.Count - 1 do begin
 753                                 DeleteFile(FileList[i]);
 754                         end;
 755                 finally
 756                         FileList.Free;
 757                 end;
 758         finally
 759                 sl.Free;
 760         end;
 761 end;
 762
 763 function TGikoSys.ParseIndexLine(Line: string): TIndexRec;
 764 var
 765         s: string;
 766         i: Integer;
 767 begin
 768         for i := 0 to 14 do begin
 769                 s := GetTokenIndex(Line, #1, i);
 770                 case i of
 771                         0: Result.FNo := StrToIntDef('$' + s, 0);
 772                         1: Result.FFileName := s;
 773                         2: Result.FTitle := s;
 774                         3: Result.FCount := StrToIntDef('$' + s, 0);
 775                         4: Result.FSize := StrToIntDef('$' + s, 0);
 776                         5: Result.FRoundDate := IntToDateTime(StrToIntDef('$' + s, ZERO_DATE));
 777                         6: Result.FLastModified := IntToDateTime(StrToIntDef('$' + s, ZERO_DATE));
 778                         7: Result.FKokomade := StrToIntDef('$' + s, -1);
 779                         8: Result.FNewReceive := StrToIntDef('$' + s, 0);
 780                         9: ;    //\96¢\8eg\97p
 781                         10: Result.FUnRead := IntToBool(StrToIntDef('$' + s, 0));
 782                         11: Result.FScrollTop := StrToIntDef('$' + s, 0);
 783                         12: Result.FAllResCount := StrToIntDef('$' + s, 0);
 784                         13: Result.FNewResCount := StrToIntDef('$' + s, 0);
 785                         14: Result.FAgeSage := TGikoAgeSage(StrToIntDef('$' + s, 0));
 786                 end;
 787         end;
 788 end;
 789
 790 //\8ew\92è\83t\83H\83\8b\83_\93à\82Ì\8ew\92è\83t\83@\83C\83\8b\88ê\97\97\82ð\8eæ\93¾\82·\82é
 791 // ListFiles('c:\', '*.txt', list, True);
 792 procedure TGikoSys.GetFileList(Path: string; Mask: string; List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
 793 var
 794         rc: Integer;
 795         SearchRec : TSearchRec;
 796         s: string;
 797 begin
 798         Path := IncludeTrailingPathDelimiter(Path);
 799         rc := FindFirst(Path + '*.*', faAnyfile, SearchRec);
 800         try
 801                 while rc = 0 do begin
 802                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
 803                                 s := Path + SearchRec.Name;
 804                                 //if (SearchRec.Attr and faDirectory > 0) then
 805                                 //      s := IncludeTrailingPathDelimiter(s)
 806
 807                                 if (SearchRec.Attr and faDirectory = 0) and (MatchesMask(s, Mask)) then
 808                                         if IsPathAdd then
 809                                                 List.Add(s)
 810                                         else
 811                                                 List.Add(SearchRec.Name);
 812                                 if SubDir and (SearchRec.Attr and faDirectory > 0) then
 813                                         GetFileList(s, Mask, List, True, IsPathAdd);
 814                         end;
 815                         rc := FindNext(SearchRec);
 816                 end;
 817         finally
 818                 SysUtils.FindClose(SearchRec);
 819         end;
 820 end;
 821
 822 //\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é
 823 procedure TGikoSys.GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
 824 var
 825         rc: Integer;
 826         SearchRec : TSearchRec;
 827         s: string;
 828 begin
 829         Path := IncludeTrailingPathDelimiter(Path);
 830         rc := FindFirst(Path + '*.*', faDirectory, SearchRec);
 831         try
 832                 while rc = 0 do begin
 833                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
 834                                 s := Path + SearchRec.Name;
 835                                 //if (SearchRec.Attr and faDirectory > 0) then
 836                                 //      s := IncludeTrailingPathDelimiter(s)
 837
 838                                 if (SearchRec.Attr and faDirectory > 0) and (MatchesMask(s, Mask)) then
 839                                         List.Add( IncludeTrailingPathDelimiter( s ) );
 840                                 if SubDir and (SearchRec.Attr and faDirectory > 0) then
 841                                         GetDirectoryList(s, Mask, List, True);
 842                         end;
 843                         rc := FindNext(SearchRec);
 844                 end;
 845         finally
 846                 SysUtils.FindClose(SearchRec);
 847         end;
 848 end;
 849
 850 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
 851 function TGikoSys.LoadFromSkin(
 852         fileName: string;
 853         ThreadItem: TThreadItem;
 854         SizeByte: Integer
 855 ): string;
 856 var
 857         Skin: TStringList;
 858 begin
 859
 860         Skin := TStringList.Create;
 861         try
 862                 if FileExists( fileName ) then begin
 863                         Skin.LoadFromFile( fileName );
 864
 865                         // \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
 866                         try
 867                                 if ThreadItem.ParentBoard <> nil then
 868                                         if ThreadItem.ParentBoard.ParentCategory <> nil then
 869                                                 Skin.Text := StringReplace( Skin.Text, '<BBSNAME/>', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title, [rfReplaceAll] );
 870                                 Skin.Text := StringReplace( Skin.Text, '<THREADURL/>', ThreadItem.URL, [rfReplaceAll] );
 871                         except end;
 872                         Skin.Text := StringReplace( Skin.Text, '<BOARDNAME/>', ThreadItem.ParentBoard.Title, [rfReplaceAll] );
 873                         Skin.Text := StringReplace( Skin.Text, '<BOARDURL/>', ThreadItem.ParentBoard.URL, [rfReplaceAll] );
 874                         Skin.Text := StringReplace( Skin.Text, '<THREADNAME/>', ThreadItem.Title, [rfReplaceAll] );
 875                         Skin.Text := StringReplace( Skin.Text, '<SKINPATH/>', Setting.CSSFileName, [rfReplaceAll] );
 876                         Skin.Text := StringReplace( Skin.Text, '<GETRESCOUNT/>', IntToStr( ThreadItem.NewReceive - 1 ), [rfReplaceAll] );
 877                         Skin.Text := StringReplace( Skin.Text, '<NEWRESCOUNT/>', IntToStr( ThreadItem.NewResCount ), [rfReplaceAll] );
 878                         Skin.Text := StringReplace( Skin.Text, '<ALLRESCOUNT/>', IntToStr( ThreadItem.AllResCount ), [rfReplaceAll] );
 879
 880                         Skin.Text := StringReplace( Skin.Text, '<NEWDATE/>',
 881                         FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate), [rfReplaceAll] );
 882                         Skin.Text := StringReplace( Skin.Text, '<SIZEKB/>', IntToStr( Floor( SizeByte / 1024 ) ), [rfReplaceAll] );
 883                         Skin.Text := StringReplace( Skin.Text, '<SIZE/>', IntToStr( SizeByte ), [rfReplaceAll] );
 884
 885                         //----- \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µ
 886                         // \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
 887                         try
 888                                 if ThreadItem.ParentBoard <> nil then
 889                                         if ThreadItem.ParentBoard.ParentCategory <> nil then
 890                                                 Skin.Text := StringReplace( Skin.Text, '&BBSNAME', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title, [rfReplaceAll] );
 891                                 Skin.Text := StringReplace( Skin.Text, '&THREADURL', ThreadItem.URL, [rfReplaceAll] );
 892                         except end;
 893                         Skin.Text := StringReplace( Skin.Text, '&BOARDNAME', ThreadItem.ParentBoard.Title, [rfReplaceAll] );
 894                         Skin.Text := StringReplace( Skin.Text, '&BOARDURL', ThreadItem.ParentBoard.URL, [rfReplaceAll] );
 895                         Skin.Text := StringReplace( Skin.Text, '&THREADNAME', ThreadItem.Title, [rfReplaceAll] );
 896                         Skin.Text := StringReplace( Skin.Text, '&SKINPATH', Setting.CSSFileName, [rfReplaceAll] );
 897                         Skin.Text := StringReplace( Skin.Text, '&GETRESCOUNT', IntToStr( ThreadItem.NewReceive - 1 ), [rfReplaceAll] );
 898                         Skin.Text := StringReplace( Skin.Text, '&NEWRESCOUNT', IntToStr( ThreadItem.NewResCount ), [rfReplaceAll] );
 899                         Skin.Text := StringReplace( Skin.Text, '&ALLRESCOUNT', IntToStr( ThreadItem.AllResCount ), [rfReplaceAll] );
 900
 901                         Skin.Text := StringReplace( Skin.Text, '&NEWDATE',
 902                                         FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate), [rfReplaceAll] );
 903                         Skin.Text := StringReplace( Skin.Text, '&SIZEKB', IntToStr( Floor( SizeByte / 1024 ) ), [rfReplaceAll] );
 904                         Skin.Text := StringReplace( Skin.Text, '&SIZE', IntToStr( SizeByte ), [rfReplaceAll] );
 905                         //----- \82±\82±\82Ü\82Å
 906                 end;
 907                 Result := Skin.Text;
 908         finally
 909                 Skin.Free;
 910         end;
 911 end;
 912
 913 // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
 914 function TGikoSys.SkinedRes(
 915         skin: string;
 916         Res: TResRec;
 917         No: string
 918 ): string;
 919 begin
 920
 921         try
 922                 Skin := StringReplace( Skin, '<NUMBER/>',
 923                         '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>', [rfReplaceAll] );
 924                 Skin := StringReplace( Skin, '<PLAINNUMBER/>', No, [rfReplaceAll] );
 925                 Skin := StringReplace( Skin, '<NAME/>', '<b>' + Res.FName + '</b>', [rfReplaceAll] );
 926                 Skin := StringReplace( Skin, '<MAILNAME/>',
 927                         '<a href="mailo:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>', [rfReplaceAll] );
 928                 Skin := StringReplace( Skin, '<MAIL/>', Res.FMailTo, [rfReplaceAll] );
 929                 Skin := StringReplace( Skin, '<DATE/>', Res.FDateTime, [rfReplaceAll] );
 930                 Skin := StringReplace( Skin, '<MESSAGE/>', Res.FBody, [rfReplaceAll] );
 931
 932                 //----- \82©\82¿\82ã\81`\82µ\82á\8cÝ\8a·\97p\81B\83R\83\81\83\93\83g\83A\83E\83g\82µ\82Ä\82à\82æ\82µ
 933                 Skin := StringReplace( Skin, '&NUMBER',
 934                         '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>', [rfReplaceAll] );
 935                 Skin := StringReplace( Skin, '&PLAINNUMBER', No, [rfReplaceAll] );
 936                 Skin := StringReplace( Skin, '&NAME', '<b>' + Res.FName + '</b>', [rfReplaceAll] );
 937                 Skin := StringReplace( Skin, '&MAILNAME',
 938                         '<a href="mailo:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>', [rfReplaceAll] );
 939                 Skin := StringReplace( Skin, '&MAIL', Res.FMailTo, [rfReplaceAll] );
 940                 Skin := StringReplace( Skin, '&DATE', Res.FDateTime, [rfReplaceAll] );
 941                 Skin := StringReplace( Skin, '&MESSAGE', Res.FBody, [rfReplaceAll] );
 942                 //----- \82±\82±\82Ü\82Å
 943
 944                 Result := Skin;
 945         finally
 946         end;
 947
 948 end;
 949
 950 procedure TGikoSys.CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
 951 var
 952         i: integer;
 953         No: string;
 954         //bufList : TStringList;
 955         ReadList: TStringList;
 956         SaveList: TStringList;
 957         CSSFileName: string;
 958         BBSID: string;
 959         FileName: string;
 960         NewReceiveNo: Integer;
 961         Res: TResRec;
 962         boardPlugIn : TBoardPlugIn;
 963
 964         UserOptionalStyle: string;
 965         SkinHeader: string;
 966         SkinNewRes: string;
 967         SkinRes: string;
 968         SizeByte: Integer;
 969
 970         function LoadSkin( fileName: string ): string;
 971         begin
 972                 Result := LoadFromSkin( fileName, ThreadItem, SizeByte );
 973         end;
 974         function ReplaceRes( skin: string ): string;
 975         begin
 976                 Result := SkinedRes( skin, Res, No );
 977         end;
 978 begin
 979         if ThreadItem <> nil then begin
 980                 if ThreadItem.IsBoardPlugInAvailable then begin
 981                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
 982                         boardPlugIn             := ThreadItem.BoardPlugIn;
 983                         NewReceiveNo    := ThreadItem.NewReceive;
 984
 985                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
 986                         if Length( GikoSys.Setting.BrowserFontName ) > 0 then
 987                                 UserOptionalStyle := UserOptionalStyle +
 988                                                                 'font-family:"' + GikoSys.Setting.BrowserFontName + '";';
 989                         if GikoSys.Setting.BrowserFontSize <> 0 then
 990                                 UserOptionalStyle := UserOptionalStyle +
 991                                                                 'font-size:' + IntToStr( GikoSys.Setting.BrowserFontSize ) + 'pt;';
 992                         if GikoSys.Setting.BrowserFontColor <> -1 then
 993                                 UserOptionalStyle := UserOptionalStyle +
 994                                                                 'color:#' + IntToHex( GikoSys.Setting.BrowserFontColor, 6 ) + ';';
 995                         if GikoSys.Setting.BrowserBackColor <> -1 then
 996                                 UserOptionalStyle := UserOptionalStyle +
 997                                                                 'background-color:#' + IntToHex( GikoSys.Setting.BrowserBackColor, 6 ) + ';';
 998                         case GikoSys.Setting.BrowserFontBold of
 999                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-weight:normal;';
1000                                 1: UserOptionalStyle := UserOptionalStyle + 'font-weight:bold;';
1001                         end;
1002                         case GikoSys.Setting.BrowserFontItalic of
1003                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-style:normal;';
1004                                 1: UserOptionalStyle := UserOptionalStyle + 'font-style:italic;';
1005                         end;
1006
1007                         SaveList := TStringList.Create;
1008                         try
1009                                 doc.open;
1010                                 // \95¶\8e\9a\83R\81[\83h\82Í\83v\83\89\83O\83C\83\93\82É\94C\82¹\82é
1011                                 // doc.charset := 'Shift_JIS';
1012                                 threadItem.SizeByte := 0;
1013
1014                                 // \83w\83b\83_
1015                                 SaveList.Add( boardPlugIn.GetHeader( DWORD( threadItem ),
1016                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ) );
1017
1018                                 for i := 0 to threadItem.Count - 1 do begin
1019                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (threadItem.Count-i) > 101 ) then begin
1020                                                 Continue;
1021                                         end;
1022
1023                                         // \90V\92\85\83}\81[\83N
1024                                         if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1025                                                 try
1026                                                         if GikoSys.Setting.UseSkin then begin
1027                                                                 SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) );
1028                                                         end else if GikoSys.Setting.UseCSS then begin
1029                                                                 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>');
1030                                                         end else begin
1031                                                                 SaveList.Add('</dl>');
1032                                                                 SaveList.Add('<a name="new"></a>');
1033                                                                 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>');
1034                                                                 SaveList.Add('<dl>');
1035                                                         end;
1036                                                 except
1037                                                         SaveList.Add( '<a name="new"></a>' );
1038                                                 end;
1039                                         end;
1040
1041                                         // \83\8c\83X
1042                                         SaveList.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) );
1043
1044                                         if ThreadItem.Kokomade = (i + 1) then begin
1045                                                 // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
1046                                                 try
1047                                                         if GikoSys.Setting.UseSkin then begin
1048                                                                 SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) );
1049                                                         end else if GikoSys.Setting.UseCSS then begin
1050                                                                 SaveList.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
1051                                                         end else begin
1052                                                                 SaveList.Add('</dl>');
1053                                                                 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>');
1054                                                                 SaveList.Add('<dl>');
1055                                                         end;
1056                                                 except
1057                                                         SaveList.Add( '<a name="koko"></a>' );
1058                                                 end;
1059                                         end;
1060
1061                                         threadItem.SizeByte := threadItem.SizeByte + Length( SaveList.Text );
1062                                         doc.Write(SaveList.Text);
1063                                         SaveList.Clear;
1064                                 end;
1065
1066                                 threadItem.SizeByte := threadItem.SizeByte + Length( SaveList.Text );
1067
1068                                 // \83X\83L\83\93(\83t\83b\83^)
1069                                 SaveList.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1070
1071                                 doc.Write(SaveList.Text);
1072                         finally
1073                                 SaveList.Free;
1074                                 doc.Close;
1075                         end;
1076
1077                         Exit;
1078                 end;
1079         end;
1080         ShortDayNames[1] := '\93ú';               ShortDayNames[2] := '\8c\8e';
1081         ShortDayNames[3] := '\89Î';               ShortDayNames[4] := '\90\85';
1082         ShortDayNames[5] := '\96Ø';               ShortDayNames[6] := '\8bà';
1083         ShortDayNames[7] := '\93y';
1084         SizeByte := 0;
1085         BBSID := ThreadItem.ParentBoard.BBSID;
1086         NewReceiveNo := ThreadItem.NewReceive;
1087         ReadList := TStringList.Create;
1088         try
1089                 if ThreadItem.IsLogFile then begin
1090                         FileName := ThreadItem.GetThreadFileName;
1091                         ReadList.LoadFromFile(FileName);
1092                         FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1093                         FAbon.Execute(ReadList);                //       \82 \82Ú\81`\82ñ\82µ\82Ä
1094                         FSelectResFilter.Execute(ReadList); //\83\8c\83X\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\82·\82é
1095                         Res := DivideStrLine(ReadList[0]);
1096                         Res.FTitle := StringReplace(Res.FTitle, '\81\97\81M', ',', [rfReplaceAll]);
1097                         sTitle := Res.FTitle;
1098                 end else begin
1099                         sTitle := StringReplace(ThreadItem.Title, '\81\97\81M', ',', [rfReplaceAll]);
1100                 end;
1101                 SaveList := TStringList.Create;
1102                 try
1103                         doc.open;
1104                         doc.charset := 'Shift_JIS';
1105
1106                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1107                         if Length( GikoSys.Setting.BrowserFontName ) > 0 then
1108                                 UserOptionalStyle := UserOptionalStyle +
1109                                                                 'font-family:"' + GikoSys.Setting.BrowserFontName + '";';
1110                         if GikoSys.Setting.BrowserFontSize <> 0 then
1111                                 UserOptionalStyle := UserOptionalStyle +
1112                                                                 'font-size:' + IntToStr( GikoSys.Setting.BrowserFontSize ) + 'pt;';
1113                         if GikoSys.Setting.BrowserFontColor <> -1 then
1114                                 UserOptionalStyle := UserOptionalStyle +
1115                                                                 'color:#' + IntToHex( GikoSys.Setting.BrowserFontColor, 6 ) + ';';
1116                         if GikoSys.Setting.BrowserBackColor <> -1 then
1117                                 UserOptionalStyle := UserOptionalStyle +
1118                                                                 'background-color:#' + IntToHex( GikoSys.Setting.BrowserBackColor, 6 ) + ';';
1119                         case GikoSys.Setting.BrowserFontBold of
1120                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-weight:normal;';
1121                                 1: UserOptionalStyle := UserOptionalStyle + 'font-weight:bold;';
1122                         end;
1123                         case GikoSys.Setting.BrowserFontItalic of
1124                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-style:normal;';
1125                                 1: UserOptionalStyle := UserOptionalStyle + 'font-style:italic;';
1126                         end;
1127
1128                         CSSFileName := GetStyleSheetDir + Setting.CSSFileName;
1129                         if GikoSys.Setting.UseSkin then begin
1130                                 // \83X\83L\83\93\8eg\97p
1131                                 // \83X\83L\83\93\82Ì\90Ý\92è
1132                                 try
1133                                         SkinHeader := LoadSkin( GetSkinHeaderFileName );
1134                                         if Length( UserOptionalStyle ) > 0 then
1135                                                 SkinHeader := StringReplace( SkinHeader, '</head>',
1136                                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>', [rfReplaceAll] );
1137                                         SaveList.Add( SkinHeader );
1138                                 except
1139                                 end;
1140                                 try
1141                                         SkinNewRes := LoadSkin( GetSkinNewResFileName );
1142                                 except
1143                                                                 end;
1144                                 try
1145                                         SkinRes := LoadSkin( GetSkinResFileName );
1146                                 except
1147                                 end;
1148
1149                                 SaveList.Add('<a name="top"></a>');
1150
1151                                 for i := 0 to ReadList.Count - 1 do begin
1152                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1153                                                 Continue;
1154                                         end;
1155                                         if (Trim(ReadList[i]) <> '') then begin
1156                                                 No := IntToStr(i + 1);
1157
1158                                                 Res := DivideStrLine(ReadList[i]);
1159                                                 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1160
1161                                                 if Res.FType = glt2chOld then begin
1162                                                         Res.FMailTo := StringReplace(Res.FMailTo, '\81\97\81M', ',', [rfReplaceAll]);
1163                                                         Res.FName := StringReplace(Res.FName, '\81\97\81M', ',', [rfReplaceAll]);
1164                                                         Res.FBody := StringReplace(Res.FBody, '\81\97\81M', ',', [rfReplaceAll]);
1165                                                 end;
1166
1167                                                 Res.FBody := AddAnchorTag(Res.FBody);
1168                                                 if Res.FName = '' then
1169                                                         Res.FName := '&nbsp;';
1170
1171                                                 // \90V\92\85\83}\81[\83N
1172                                                 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1173                                                         try
1174                                                                 SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) );
1175                                                         except
1176                                                                 SaveList.Add( '<a name="new"></a>' );
1177                                                         end;
1178                                                 end;
1179                                                 try
1180                                                         if NewReceiveNo <= (i + 1) then
1181                                                                 // \90V\92\85\83\8c\83X
1182                                                                 SaveList.Add( ReplaceRes( SkinNewRes ) )
1183                                                         else
1184                                                                 // \92Ê\8fí\82Ì\83\8c\83X
1185                                                                 SaveList.Add( ReplaceRes( SkinRes ) );
1186                                                 except
1187                                                 end;
1188                                                 if ThreadItem.Kokomade = (i + 1) then begin
1189                                                         // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
1190                                                         try
1191                                                                 SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) );
1192                                                         except
1193                                                                 SaveList.Add( '<a name="koko"></a>' );
1194                                                         end;
1195                                                 end;
1196                                         end;
1197                                         SizeByte := SizeByte + Length( SaveList.Text );
1198                                         doc.Write(SaveList.Text);
1199                                         SaveList.Clear;
1200                                 end;
1201                                 SaveList.Add('<a name="bottom"></a>');
1202                                 SizeByte := SizeByte + Length( SaveList.Text );
1203                                 // \83X\83L\83\93(\83t\83b\83^)
1204                                 try
1205                                         SaveList.Add( LoadSkin( GetSkinFooterFileName ) );
1206                                 except
1207                                 end;
1208                                 doc.Write(SaveList.Text);
1209
1210                         end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1211                                 //CSS\8eg\97p
1212                                 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1213 //                              SaveList.Add('<html lang="ja"><head>');
1214                                 SaveList.Add('<html><head>');
1215                                 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1216                                 SaveList.Add('<title>' + sTitle + '</title>');
1217                                 SaveList.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1218                                 if Length( UserOptionalStyle ) > 0 then
1219                                         SaveList.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1220                                 SaveList.Add('</head>');
1221                                 SaveList.Add('<body>');
1222                                 SaveList.Add('<a name="top"></a>');
1223                                 SaveList.Add('<div class="title">' + sTitle + '</div>');
1224                                 doc.Write(SaveList.Text);
1225                                 SaveList.Clear;
1226                                 //Application.ProcessMessages;
1227                                 for i := 0 to ReadList.Count - 1 do begin
1228                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1229                                                 Continue;
1230                                         end;
1231                                         if (Trim(ReadList[i]) <> '') then begin
1232                                                 No := IntToStr(i + 1);
1233                                                 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1234                                                         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>');
1235                                                 end;
1236                                                 Res := DivideStrLine(ReadList[i]);
1237                                                 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1238                                                 Res.FBody := AddAnchorTag(Res.FBody);
1239                                                 if Res.FName = '' then
1240                                                         Res.FName := '&nbsp;';
1241                                                 if Res.FMailTo = '' then
1242                                                         SaveList.Add('<a name="' + No + '"></a>'
1243                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1244                                                                                         + '<span class="name_label">\96¼\91O\81F</span> '
1245                                                                                         + '<span class="name"><b>' + Res.FName + '</b></span> '
1246                                                                                         + '<span class="date_label">\93\8a\8de\93ú\81F</span> '
1247                                                                                         + '<span class="date">' + Res.FDateTime+ '</span></div>'
1248                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>')
1249                                                 else if GikoSys.Setting.ShowMail then
1250                                                         SaveList.Add('<a name="' + No + '"></a>'
1251                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1252                                                                                                                                                                                 + '<span class="name_label"> \96¼\91O\81F </span>'
1253                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1254                                                                                         + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1255                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1256                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1257                                                                                         + '<div class="mes">' + Res.FBody + ' </div>')
1258                                                 else
1259                                                         SaveList.Add('<a name="' + No + '"></a>'
1260                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1261                                                                                         + '<span class="name_label"> \96¼\91O\81F </span>'
1262                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1263                                                                                         + '<b>' + Res.FName + '</b></a>'
1264                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1265                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1266                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>');
1267                                                 if ThreadItem.Kokomade = (i + 1) then begin
1268                                                         SaveList.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
1269                                                 end;
1270                                         end;
1271
1272                                         doc.Write(SaveList.Text);
1273                                         SaveList.Clear;
1274                                 end;
1275                                 //FOnlyAHundredRes
1276                                 SaveList.Add('<a name="bottom"></a>');
1277                                 SaveList.Add('</body></html>');
1278                                 SaveList.Add('<a name="last"></a>');
1279                                 SaveList.Add('</body></html>');
1280
1281                                 doc.Write(SaveList.Text);
1282                         end else begin
1283                                 //CSS\94ñ\8eg\97p
1284 //                              SaveList.Add('<html lang="ja"><head>');
1285                                 SaveList.Add('<html><head>');
1286                                 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1287                                 SaveList.Add('<title>' + sTitle + '</title></head>');
1288                                 SaveList.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1289                                 SaveList.Add('<a name="top"></a>');
1290                                 SaveList.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1291                                 SaveList.Add('<dl>');
1292                                 doc.Write(SaveList.Text);
1293                                 SaveList.Clear;
1294                                 //Application.ProcessMessages;
1295                                 for i := 0 to ReadList.Count - 1 do begin
1296                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1297                                                 Continue;
1298                                         end;
1299                                         if (Trim(ReadList[i]) <> '') then begin
1300                                                 No := IntToStr(i + 1);
1301
1302                                                 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1303                                                         SaveList.Add('</dl>');
1304                                                         SaveList.Add('<a name="new"></a>');
1305                                                         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>');
1306                                                         SaveList.Add('<dl>');
1307                                                 end;
1308                                                 Res := DivideStrLine(ReadList[i]);
1309                                                 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1310                                                 if Res.FType = glt2chOld then begin
1311                                                         Res.FMailTo := StringReplace(Res.FMailTo, '\81\97\81M', ',', [rfReplaceAll]);
1312                                                         Res.FName := StringReplace(Res.FName, '\81\97\81M', ',', [rfReplaceAll]);
1313                                                         Res.FBody := StringReplace(Res.FBody, '\81\97\81M', ',', [rfReplaceAll]);
1314                                                 end;
1315                                                 Res.FBody := AddAnchorTag(Res.FBody);
1316                                                 if Res.FMailTo = '' then
1317                                                         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>')
1318                                                 else if GikoSys.Setting.ShowMail then
1319                                                         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>')
1320                                                 else
1321                                                         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>');
1322                                                 if ThreadItem.Kokomade = (i + 1) then begin
1323                                                         SaveList.Add('</dl>');
1324                                                         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>');
1325                                                         SaveList.Add('<dl>');
1326                                                 end;
1327                                         end;
1328                                         //if SaveList.Count > 50 then begin
1329                                                 doc.Write(SaveList.Text);
1330                                                 SaveList.Clear;
1331                                                 //Application.ProcessMessages;
1332                                         //end;
1333                                 end;
1334                                 SaveList.Add('</dl>');
1335                                 SaveList.Add('<a name="bottom"></a>');
1336                                 SaveList.Add('</body></html>');
1337                                 doc.Write(SaveList.Text);
1338                         end;
1339                 finally
1340                         SaveList.Free;
1341                         doc.Close;
1342                 end;
1343         finally
1344                 ReadList.Free;
1345         end;
1346 end;
1347 (*************************************************************************
1348  *http://\82Ì\95¶\8e\9a\97ñ\82ðanchor\83^\83O\95t\82«\82É\82·\82é\81B
1349  *************************************************************************)
1350 function TGikoSys.AddAnchorTag(s: string): string;
1351 const
1352         URL_CHAR: string = '0123456789'
1353                                                                          + 'abcdefghijklmnopqrstuvwxyz'
1354                                                                          + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1355                                                                          + '#$%&()*+,-./:;=?@[]^_`{|}~!''\';
1356         ANCHOR_REF      = 'href=';
1357         RES_REF                 = '&gt;&gt;';
1358 var
1359         wkIdx: array[0..9] of Integer;
1360         url: string;
1361         href: string;
1362         i: Integer;
1363         idx: Integer;
1364         anchorLen : Integer;
1365 begin
1366         Result := '';
1367         // + 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ß
1368         anchorLen := Length( ANCHOR_REF ) + 3;
1369
1370         while True do begin
1371                 wkIdx[0] := AnsiPos('http://', s);
1372                 wkIdx[1] := AnsiPos('ttp://', s);
1373                 wkIdx[2] := AnsiPos('tp://', s);
1374                 wkIdx[3] := AnsiPos('ms-help://', s);
1375                 wkIdx[4] := AnsiPos('p://', s);
1376                 wkIdx[5] := AnsiPos('https://', s);
1377                 wkIdx[6] := AnsiPos('www.', s);
1378                 wkIdx[7] := AnsiPos('ftp://', s);
1379                 wkIdx[8] := AnsiPos('news://', s);
1380                 wkIdx[9] := AnsiPos('rtsp://', s);
1381
1382                 idx := MaxInt;
1383                 for i := 0 to 9 do
1384                         if wkIdx[i] <> 0 then idx := Min(wkIdx[i], idx);
1385
1386                 if idx = MaxInt then begin
1387                         //\83\8a\83\93\83N\82ª\96³\82¢\82æ\81B
1388                         Result := Result + s;
1389                         Break;
1390                 end;
1391
1392                 if (idx > 1) and
1393                         (Pos( ANCHOR_REF, Copy(s, idx - anchorLen, anchorLen ) ) > 0) then begin
1394                         //\8aù\82É\83\8a\83\93\83N\83^\83O\82ª\82Â\82¢\82Ä\82¢\82é\82Á\82Û\82¢\82Æ\82«\82Í\83\80\83V
1395                         href := Copy( s, idx, Length( s ) );
1396                         Result := Result + Copy( s, 1, idx + Pos( '</a>', href ) + Length( '</a>' ) - 2 );
1397                         s := href;
1398                         s := Copy( s, Pos( '</a>', s ) + Length( '</a>' ), Length( s ) );
1399
1400                         Continue;
1401                 end;
1402
1403                 Result := Result + Copy(s, 0, idx - 1);
1404
1405                 s := Copy(s, idx, length(s));
1406
1407                 for i := 0 to Length(s) do begin
1408                         idx := AnsiPos(s[i + 1], URL_CHAR);
1409                         if (idx = 0) or (i = (Length(s))) then begin
1410                                 //URL\82¶\82á\82È\82¢\95¶\8e\9a\94\8c©\81I\82Æ\82©\81A\95¶\8e\9a\82ª\82È\82\82È\82Á\82½\81B
1411                                 url := Copy(s, 0, i);
1412
1413                                 if AnsiPos('ttp://', url) = 1 then
1414                                         href := 'h' + url
1415                                 else if AnsiPos('tp://', url) = 1 then
1416                                         href := 'ht' + url
1417                                 else if AnsiPos('p://', url) = 1 then
1418                                         href := 'htt' + url
1419                                 else if AnsiPos('www.', url) = 1 then
1420                                         href := 'http://' + url
1421                                 else
1422                                         href := url;
1423                                 Result := Result + '<a href="' + href + '" target="_blank">' + url + '</a>';
1424                                 s := Copy(s, i + 1, Length(s));
1425                                 Break;
1426                         end;
1427                 end;
1428         end;
1429 end;
1430
1431 (*************************************************************************
1432  *\83T\83u\83W\83F\83N\83g\88ê\8ds\82ð\95ª\8a\84
1433  *************************************************************************)
1434 function TGikoSys.DivideSubject(Line: string): TSubjectRec;
1435 var
1436         i: integer;
1437         ws: WideString;
1438         Delim: string;
1439         LeftK: string;
1440         RightK: string;
1441 begin
1442         Result.FCount := 0;
1443
1444         if Pos('<>', Line) = 0 then
1445                 Delim := ','
1446         else
1447                 Delim := '<>';
1448
1449         Result.FFileName := GetTokenIndex(Line, Delim, 0);
1450         Result.FTitle := GetTokenIndex(Line, Delim, 1);
1451
1452         ws := Trim(Result.FTitle);
1453
1454         if Copy(ws, Length(ws), 1) = ')' then begin
1455                 LeftK := '(';
1456                 RightK := ')';
1457         end else if Copy(ws, Length(ws), 1) = '\81j' then begin
1458                 LeftK := '\81i';
1459                 RightK := '\81j';
1460         end else if Copy(ws, Length(ws), 1) = '<' then begin
1461                 LeftK := '<';
1462                 RightK := '>';
1463         end;
1464
1465         for i := Length(ws) - 1 downto 1 do begin
1466                 if ws[i] = LeftK then begin
1467                         ws := Copy(ws, i + 1, Length(ws) - i - 1);
1468                         if IsNumeric(ws) then
1469                                 Result.FCount := StrToInt(ws);
1470                         Result.FTitle := Trim(StringReplace(Result.FTitle, LeftK + ws + RightK, '', [rfReplaceAll]));
1471                         break;
1472                 end;
1473         end;
1474 end;
1475
1476 (*************************************************************************
1477  * dat\83t\83@\83C\83\8b\82Ì\88ê\83\89\83C\83\93\82ð\95ª\89ð
1478  *************************************************************************)
1479 function TGikoSys.DivideStrLine(Line: string): TResRec;
1480 var
1481         Delim: string;
1482                 bufbody : String;
1483 begin
1484         if Pos('<>', Line) = 0 then begin
1485                 Delim := ',';
1486                 Result.FType := glt2chOld;
1487         end else begin
1488                 Delim := '<>';
1489                 Result.FType := glt2chNew;
1490         end;
1491         Result.FName := Trim(GetTokenIndex(Line, Delim, 0));
1492         Result.FMailTo := Trim(GetTokenIndex(Line, Delim, 1));
1493         Result.FDateTime := Trim(GetTokenIndex(Line, Delim, 2));
1494         bufBody := Trim(GetTokenIndex(Line, Delim, 3));
1495         if bufbody = '' then begin
1496                 Insert('&nbsp;',bufbody, 1);
1497         end;
1498         Result.FBody := bufBody;
1499         Result.FTitle := Trim(GetTokenIndex(Line, Delim, 4));
1500
1501 end;
1502
1503 (*************************************************************************
1504  * URL\82©\82çBBSID\82ð\8eæ\93¾
1505  *************************************************************************)
1506 function TGikoSys.UrlToID(url: string): string;
1507 var
1508         i: integer;
1509 begin
1510         Result := '';
1511         url := Trim(url);
1512
1513         if url = '' then Exit;
1514
1515         url := Copy(url, 0, Length(url) - 1);
1516         for i := Length(url) downto 0 do begin
1517                 if url[i] = '/' then begin
1518                         Result := Copy(url, i + 1, Length(url));
1519                         Break;
1520                 end;
1521         end;
1522 end;
1523
1524 (*************************************************************************
1525  *URL\82©\82çBBSID\88È\8aO\82Ì\95\94\95ª(http://teri.2ch.net/)\82ð\8eæ\93¾
1526  *************************************************************************)
1527 function TGikoSys.UrlToServer(url: string): string;
1528 var
1529         i: integer;
1530         wsURL: WideString;
1531 begin
1532         Result := '';
1533         wsURL := url;
1534         wsURL := Trim(wsURL);
1535
1536         if wsURL = '' then exit;
1537
1538         if Copy(wsURL, Length(wsURL), 1) = '/' then
1539                 wsURL := Copy(wsURL, 0, Length(wsURL) - 1);
1540
1541         for i := Length(wsURL) downto 0 do begin
1542                 if wsURL[i] = '/' then begin
1543                         Result := Copy(wsURL, 0, i);
1544                         break;
1545                 end;
1546         end;
1547 end;
1548
1549 (*************************************************************************
1550  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
1551  *************************************************************************)
1552 function TGikoSys.DirectoryExistsEx(const Name: string): Boolean;
1553 var
1554         Code: Integer;
1555 begin
1556         Code := GetFileAttributes(PChar(Name));
1557         Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
1558 end;
1559
1560 (*************************************************************************
1561  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
1562  *************************************************************************)
1563 function TGikoSys.ForceDirectoriesEx(Dir: string): Boolean;
1564 begin
1565         Result := True;
1566         if Length(Dir) = 0 then
1567                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
1568         Dir := ExcludeTrailingPathDelimiter(Dir);
1569         if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
1570                 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
1571         Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
1572 end;
1573
1574 (*************************************************************************
1575  *\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
1576  *FDelphi\82©\82ç\82Ì\83p\83N\83\8a
1577  *************************************************************************)
1578 function TGikoSys.StrTokFirst(const s:string; const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1579 begin
1580         Rec.Str := s;
1581         Rec.Pos := 1;
1582         Result := StrTokNext(sep, Rec);
1583 end;
1584
1585 (*************************************************************************
1586  *\95¶\8e\9a\97ñ\82©\82ç\83g\81[\83N\83\93\82Ì\90Ø\82è\8fo\82µ
1587  *FDelphi\82©\82ç\82Ì\83p\83N\83\8a
1588  *************************************************************************)
1589 function TGikoSys.StrTokNext(const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1590 var
1591         Len, I: Integer;
1592 begin
1593         with Rec do     begin
1594                 Len := Length(Str);
1595                 Result := '';
1596                 if Len >= Pos then begin
1597                         while (Pos <= Len) and (Str[Pos] in sep) do begin
1598                          Inc(Pos);
1599                         end;
1600                         I := Pos;
1601                         while (Pos<= Len) and not (Str[Pos] in sep) do begin
1602                                 if IsDBCSLeadByte(Byte(Str[Pos])) then begin
1603                                         Inc(Pos);
1604                                 end;
1605                                 Inc(Pos);
1606                         end;
1607                         Result := Copy(Str, I, Pos - I);
1608                         while (Pos <= Len) and (Str[Pos] in sep) do begin// \82±\82ê\82Í\82¨\8dD\82Ý
1609                                 Inc(Pos);
1610                         end;
1611                 end;
1612         end;
1613 end;
1614
1615 (*************************************************************************
1616  *\83t\83@\83C\83\8b\83T\83C\83Y\8eæ\93¾
1617  *************************************************************************)
1618 function TGikoSys.GetFileSize(FileName : string): longint;
1619 var
1620         F : File;
1621 begin
1622         try
1623                 if not FileExists(FileName) then begin
1624                         Result := 0;
1625                         Exit;
1626                 end;
1627                 Assign(F, FileName);
1628                 Reset(F, 1);
1629                 Result := FileSize(F);
1630                 CloseFile(F);
1631         except
1632                 Result := 0;
1633         end;
1634 end;
1635
1636 (*************************************************************************
1637  *\83t\83@\83C\83\8b\8ds\90\94\8eæ\93¾
1638  *************************************************************************)
1639 function TGikoSys.GetFileLineCount(FileName : string): longint;
1640 var
1641         sl: TStringList;
1642 begin
1643         sl := TStringList.Create;
1644         try
1645                 try
1646                         sl.LoadFromFile(FileName);
1647                         Result := sl.Count;
1648                 except
1649                         Result := 0;
1650                 end;
1651         finally
1652                 sl.Free;
1653         end;
1654
1655 end;
1656
1657 (*************************************************************************
1658  *\83X\83\8c\83b\83h\83t\83@\83C\83\8b\82©\82ç\8ew\92è\8ds\82ð\8eæ\93¾
1659  *************************************************************************)
1660 function TGikoSys.ReadThreadFile(FileName: string; Line: Integer): string;
1661 var
1662         fileTmp : TStringList;
1663 begin
1664         Result := '';
1665         if FileExists(FileName) then begin
1666                 fileTmp := TStringList.Create;
1667                 try
1668                         try
1669                                 fileTmp.LoadFromFile( FileName );
1670                                 if ( Line       >= 1 ) and ( Line       < fileTmp.Count + 1 ) then begin
1671                                         Result := fileTmp.Strings[ Line-1 ];
1672                                 end;
1673                         except
1674                                 //on EFOpenError do Result := '';
1675                         end;
1676                 finally
1677                         fileTmp.Free;
1678                 end;
1679         end;
1680 end;
1681
1682 (*************************************************************************
1683  *\83V\83X\83e\83\80\83\81\83j\83\85\81[\83t\83H\83\93\83g\82Ì\91®\90«\82ð\8eæ\93¾
1684  *************************************************************************)
1685 procedure TGikoSys.MenuFont(Font: TFont);
1686 var
1687         lf: LOGFONT;
1688         nm: NONCLIENTMETRICS;
1689 begin
1690         nm.cbSize := sizeof(NONCLIENTMETRICS);
1691
1692         SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0);
1693         lf := nm.lfMenuFont;
1694
1695         Font.Name := lf.lfFaceName;
1696         Font.Height := lf.lfHeight;
1697         Font.Style := [];
1698         if lf.lfWeight >= 700 then
1699                 Font.Style := Font.Style + [fsBold];
1700         if lf.lfItalic = 1 then
1701                 Font.Style := Font.Style + [fsItalic];
1702 end;
1703
1704 (*************************************************************************
1705  *
1706  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
1707  *************************************************************************)
1708 function TGikoSys.RemoveToken(var s: string; delimiter: string): string;
1709 var
1710         p: Integer;
1711 begin
1712         p := AnsiPos(delimiter, s);
1713         if p = 0 then
1714                 Result := s
1715         else
1716                 Result := Copy(s, 1, p - 1);
1717         s := Copy(s, Length(Result) + Length(delimiter) + 1, Length(s));
1718 end;
1719
1720 (*************************************************************************
1721  *
1722  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
1723  *************************************************************************)
1724 function TGikoSys.GetTokenIndex(s: string; delimiter: string; index: Integer): string;
1725 var
1726         i: Integer;
1727 begin
1728         Result := '';
1729         for i := 0 to index do
1730                 Result := RemoveToken(s, delimiter);
1731 end;
1732
1733 (*************************************************************************
1734  *
1735  *************************************************************************)
1736 function TGikoSys.DeleteLink(const s: string): string;
1737 var
1738         s1: string;
1739         s2: string;
1740         idx: Integer;
1741         i: Integer;
1742 begin
1743         i := 0;
1744         Result := '';
1745         while True do begin
1746                 s1 := GetTokenIndex(s, '<a href="', i);
1747                 s2 := GetTokenIndex(s, '<a href="', i + 1);
1748
1749                 idx := Pos('">', s1);
1750                 if idx <> 0 then
1751                         Delete(s1, 1, idx + 1);
1752                 idx := Pos('">', s2);
1753                 if idx <> 0 then
1754                         Delete(s2, 1, idx + 1);
1755
1756                 Result := Result + s1 + s2;
1757
1758                 if s2 = '' then
1759                         Break;
1760
1761                 inc(i, 2);
1762         end;
1763 end;
1764
1765 //\83C\83\93\83f\83b\83N\83X\96¢\8dX\90V\83o\83b\83t\83@\82ð\83t\83\89\83b\83V\83\85\81I
1766 {procedure TGikoSys.FlashExitWrite;
1767 var
1768         i: Integer;
1769 begin
1770         //\83X\83\8c\83b\83h\83f\81[\83^\83t\83@\83C\83\8b\82ð\8dX\90V
1771         for i := 0 to FExitWrite.Count - 1 do
1772                 WriteThreadDat(FExitWrite[i]);
1773         FExitWrite.Clear;
1774 end;}
1775
1776 (*************************************************************************
1777  *\83X\83\8c\96¼\82È\82Ç\82ð\92Z\82¢\96¼\91O\82É\95Ï\8a·\82·\82é
1778  *from HotZonu
1779  *************************************************************************)
1780 function TGikoSys.GetShortName(const LongName: string; ALength: integer): string;
1781 const
1782         ERASECHAR : array [1..39] of string =
1783                 ('\81\99','\81\9a','\81¡','\81 ','\81\9f','\81\9e','\81Q','\81\94','\81£','\81¥',
1784                  '\81¢','\81¤','\81\9c','\81\9b','\81\9d','\81y','\81z','\81ô','\81s','\81t',
1785                  '\81g','\81h','\81k','\81l','\81e','\81f','\81\83','\81\84','\81á','\81â',
1786                  '\81o','\81p','\81q','\81r','\81w','\81x','\81¬','\81c', '\81@');
1787 var
1788         Chr : array [0..255]    of      char;
1789         S : string;
1790         i : integer;
1791 begin
1792         s := Trim(LongName);
1793         if (Length(s) <= ALength) then begin
1794                 Result := s;
1795         end else begin
1796                 S := s;
1797                 for i := Low(ERASECHAR) to      High(ERASECHAR) do      begin
1798                         S := StringReplace(S, ERASECHAR[i], '', [rfReplaceAll]);
1799                 end;
1800                 if (Length(S) <= ALength) then begin
1801                         Result := S;
1802                 end else begin
1803                         Windows.LCMapString(
1804                                         GetUserDefaultLCID(),
1805                                         LCMAP_HALFWIDTH,
1806                                         PChar(S),
1807                                         Length(S) + 1,
1808                                         chr,
1809                                         Sizeof(chr)
1810                                         );
1811                         S := Chr;
1812                         S := Copy(S,1,ALength);
1813                         while true do begin
1814                                 if (ByteType(S, Length(S)) = mbLeadByte ) then begin
1815                                         S := Copy(S, 1, Length(S) - 1);
1816                                 end else begin
1817                                         Break;
1818                                 end;
1819                         end;
1820                         Result := S;
1821                 end;
1822         end;
1823 end;
1824
1825 (*************************************************************************
1826  *
1827  * from HotZonu
1828  *************************************************************************)
1829 function TGikoSys.ConvRes(const Body, Bbs, Key,
1830         ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string): string;
1831 type
1832         PIndex = ^TIndex;
1833         TIndex = record
1834                 FIndexFrom      : integer;
1835                 FIndexTo                : integer;
1836                 FNo                              : string;
1837         end;
1838 const
1839         GT      = '&gt;';
1840         SN      = '0123456789-';
1841         ZN      = '\82O\82P\82Q\82R\82S\82T\82U\82V\82W\82X\81|';
1842 var
1843         i : integer;
1844         s,r : string;
1845         b : TMbcsByteType;
1846         sw: boolean;
1847         sp: integer;
1848         No: string;
1849         sx: string;
1850         List: TList;
1851         oc      : string;
1852         st, et: string;
1853         chk : boolean;
1854         al : boolean;
1855         procedure Add(IndexFrom, IndexTo: integer; const No: string);
1856         var
1857                 FIndex : PIndex;
1858         begin
1859                 New(FIndex);
1860                 FIndex.FIndexFrom       := IndexFrom;
1861                 FIndex.FIndexTo         := IndexTo;
1862                 FIndex.FNo                               := No;
1863                 List.Add(FIndex);
1864         end;
1865         function ChooseString(const Text, Separator: string; Index: integer): string;
1866         var
1867                 S : string;
1868                 i, p : integer;
1869         begin
1870                 S :=    Text;
1871                 for i :=        0 to    Index - 1 do    begin
1872                         if      (AnsiPos(Separator, S) = 0) then        S :=    ''
1873                         else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
1874                 end;
1875                 p :=    AnsiPos(Separator, S);
1876                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;
1877         end;
1878 begin
1879         { v1.0 b2 - 03 }
1880         s        :=     Body;
1881         r        :=     Body;
1882         i        :=     1;
1883         sw      :=      False;
1884         No      :=      '';
1885         List:=  TList.Create;
1886         oc      :=      '';
1887         sp      :=      0;
1888         chk :=  False;
1889         al      :=      False;
1890         while true      do      begin
1891                 b :=    ByteType(s, i);
1892                 case    b of
1893                         mbSingleByte    : begin
1894                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
1895                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
1896                                                 sw      :=      True;
1897                                                 sp      :=      i;
1898                                                 i :=    i + 7;
1899                                                 oc:='';
1900                                                 chk :=  True;
1901                                         end;
1902                                 end else
1903                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
1904                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin
1905                                                 i :=    i + 7;
1906                                                 oc:='';
1907                                                 chk :=  True;
1908                                         end;
1909                                 end else
1910                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin
1911                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
1912                                                 sw      :=      True;
1913                                                 sp      :=      i;
1914                                                 i :=    i + 3;
1915                                                 oc:='';
1916                                                 chk :=  True;
1917                                         end;
1918                                 end else
1919                                 if      ((not sw) and (Copy(s,i,1) = ',')) or
1920                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin
1921                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
1922                                                         ((Chk) and      (oc = '')) or
1923                                                         ((not Chk) and (al)) then
1924                                         begin
1925                                                 sw      :=      True;
1926                                                 sp      :=      i;
1927                                                 //i :=  i + 1;
1928                                                 oc:='';
1929                                         end;
1930                                 end else
1931                                 if      (sw) then begin
1932                                         sx      :=      Copy(s,i,1);
1933                                         if      (AnsiPos(sx, SN) > 0)   then    begin
1934                                                 No      :=      No      + sx;
1935                                         end else begin
1936                                                 if      (No <> '') and (No <> '-')       then   begin
1937                                                         Add(sp, i, No);
1938                                                         al := True;
1939                                                 end;
1940                                                 sw      :=      False;
1941                                                 //
1942                                                 i := i - 1;
1943                                                 //
1944                                                 No      := '';
1945                                                 oc:='';
1946                                                 //chk :=        False;
1947                                         end;
1948                                 end else begin
1949                                         if      Copy(s,i,1) = '<' then  oc      :=      '';
1950                                         oc      :=      oc + Copy(s,i,1);
1951                                         chk :=  False;
1952                                         al      :=      False;
1953                                 end;
1954                         end;
1955                         mbLeadByte      : begin
1956                                 if      (not sw) and (Copy(s,i,4) = '\81\84\81\84') then        begin
1957                                         sw      :=      True;
1958                                         sp      :=      i;
1959                                         i :=    i + 3;
1960                                         chk :=  True;
1961                                 end else
1962                                 if      (not sw) and (Copy(s,i,2) = '\81\84') then  begin
1963                                         sw      :=      True;
1964                                         sp      :=      i;
1965                                         i :=    i + 1;
1966                                         chk :=  True;
1967                                 end else
1968                                 if      (sw) then begin
1969                                         sx      :=      Copy(s,i,2);
1970                                         if      (AnsiPos(sx, ZN) > 0)   then    begin
1971                                                 No      :=      No      + ZenToHan(sx);
1972                                         end else begin
1973                                                 if      (No <> '') and (No <> '-')      and (No <> '\81|') then   begin
1974                                                         Add(sp, i, No);
1975                                                 end;
1976                                                 sw      :=      False;
1977                                                 i := i - 1;
1978                                                 No      :=      '';
1979                                         end;
1980                                 end else begin
1981                                         oc      :=      '';
1982                                         chk :=  False;
1983                                 end;
1984                                 al      :=      False;
1985                         end;
1986                 end;
1987                 inc(i);
1988                 if      (i > Length(Body))      then    begin
1989                         if      (sw)    then    begin
1990                                 if      (No <> '')      then    Add(sp, i, No);
1991                         end;
1992                         Break;
1993                 end;
1994         end;
1995         for i :=        List.Count - 1  downto  0 do    begin
1996                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin
1997                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);
1998                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);
1999                 end else begin
2000                         st      :=      PIndex(List[i]).FNo;
2001                         et      :=      PIndex(List[i]).FNo;
2002                 end;
2003                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
2004                                         Format('<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">',
2005                                                                 [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
2006                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
2007                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));
2008                 Dispose(PIndex(List[i]));
2009         end;
2010         List.Free;
2011         Result  :=      r;
2012 end;
2013
2014 (*************************************************************************
2015  * \91S\8ap\81¨\94¼\8ap
2016  * from HotZonu
2017  *************************************************************************)
2018 function TGikoSys.ZenToHan(const s: string): string;
2019 var
2020         Chr: array [0..255] of char;
2021 begin
2022         Windows.LCMapString(
2023                  GetUserDefaultLCID(),
2024 //               LCMAP_HALFWIDTH,
2025                  LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
2026                  PChar(s),
2027                  Length(s) + 1,
2028                  chr,
2029                  Sizeof(chr)
2030                  );
2031         Result := Chr;
2032 end;
2033
2034 (*************************************************************************
2035  * \91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\82©\82½\82©\82È\82ð\8bæ\95Ê\82µ\82È\82¢\90¦\82¢Pos
2036  *************************************************************************)
2037 function TGikoSys.VaguePos(const Substr, S: string): Integer;
2038 begin
2039         Result := Pos(ZenToHan(Substr), ZenToHan(S));
2040 end;
2041
2042 function TGikoSys.BoolToInt(b: Boolean): Integer;
2043 begin
2044         Result := IfThen(b, 1, 0);
2045 end;
2046
2047 function TGikoSys.IntToBool(i: Integer): Boolean;
2048 begin
2049         Result := i = 1;
2050 end;
2051
2052 //gzip\82Å\88³\8fk\82³\82ê\82½\82Ì\82ð\96ß\82·
2053 function TGikoSys.GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
2054 const
2055         BUF_SIZE = 4096;
2056 var
2057         GZipStream: TGzipDecompressStream;
2058         TextStream: TStringStream;
2059         buf: array[0..BUF_SIZE - 1] of Byte;
2060         cnt: Integer;
2061         s: string;
2062         i: Integer;
2063 begin
2064         Result := '';
2065         TextStream := TStringStream.Create('');
2066         try
2067 //\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¢)
2068 //              if LowerCase(Trim(ContentEncoding)) = 'gzip' then begin
2069                 if AnsiPos('gzip', LowerCase(Trim(ContentEncoding))) > 0 then begin
2070                         ResStream.Position := 0;
2071                         GZipStream := TGzipDecompressStream.Create(TextStream);
2072                         try
2073                                 repeat
2074                                         FillChar(buf, BUF_SIZE, 0);
2075                                         cnt := ResStream.Read(buf, BUF_SIZE);
2076                                         if cnt > 0 then
2077                                                 GZipStream.Write(buf, BUF_SIZE);
2078                                 until cnt = 0;
2079                         finally
2080                                 GZipStream.Free;
2081                         end;
2082                 end else begin
2083                         ResStream.Position := 0;
2084                         repeat
2085                                 FillChar(buf, BUF_SIZE, 0);
2086                                 cnt := ResStream.Read(buf, BUF_SIZE);
2087                                 if cnt > 0 then
2088                                         TextStream.Write(buf, BUF_SIZE);
2089                         until cnt = 0;
2090                 end;
2091
2092                 //NULL\95¶\8e\9a\82ð"*"\82É\82·\82é
2093                 s := TextStream.DataString;
2094                 i := Length(s);
2095                 while (i > 0) and (s[i] = #0) do
2096                         Dec(i);
2097                 s := Copy(s, 1, i);
2098
2099                 i := Pos(#0, s);
2100                 while i <> 0 do begin
2101                         s[i] := '*';
2102                         i := Pos(#0, s);
2103                 end;
2104                 Result := s;
2105         finally
2106                 TextStream.Free;
2107         end;
2108 end;
2109
2110 procedure TGikoSys.LoadKeySetting(ActionList: TActionList);
2111 const
2112         STD_SEC = 'KeySetting';
2113 var
2114         i: Integer;
2115         ini: TMemIniFile;
2116         ActionName: string;
2117         ActionKey: Integer;
2118         SecList: TStringList;
2119         Component: TComponent;
2120 begin
2121         if not FileExists(GetConfigDir + KEY_SETTING_FILE_NAME) then
2122                 Exit;
2123         SecList := TStringList.Create;
2124         ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2125         try
2126                 ini.ReadSection(STD_SEC, SecList);
2127                 for i := 0 to SecList.Count - 1 do begin
2128                         ActionName := SecList[i];
2129                         ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
2130                         if ActionKey <> -1 then begin
2131                                 Component := ActionList.Owner.FindComponent(ActionName);
2132                                 if TObject(Component) is TAction then begin
2133                                         TAction(Component).ShortCut := ActionKey;
2134                                 end;
2135                         end;
2136                 end;
2137         finally
2138                 ini.Free;
2139                 SecList.Free;
2140         end;
2141 end;
2142
2143 procedure TGikoSys.SaveKeySetting(ActionList: TActionList);
2144 const
2145         STD_SEC = 'KeySetting';
2146 var
2147         i: Integer;
2148         ini: TMemIniFile;
2149 begin
2150         ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2151         try
2152                 for i := 0 to ActionList.ActionCount - 1 do begin
2153                         if ActionList.Actions[i].Tag = -1 then
2154                                 Continue;
2155                         ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
2156                 end;
2157                 ini.UpdateFile;
2158         finally
2159                 ini.Free;
2160         end;
2161 end;
2162
2163 //
2164 procedure TGikoSys.CreateProcess(const AppPath: string; const Param: string);
2165 var
2166         PI: TProcessInformation;
2167         SI: TStartupInfo;
2168         Path: string;
2169 begin
2170         Path := '"' + AppPath + '"';
2171         if Param <> '' then
2172                 Path := Path + ' ' + Param;
2173
2174         SI.Cb := SizeOf(Si);
2175         SI.lpReserved   := nil;
2176         SI.lpDesktop     := nil;
2177         SI.lpTitle               := nil;
2178         SI.dwFlags               := 0;
2179         SI.cbReserved2 := 0;
2180         SI.lpReserved2 := nil;
2181         SI.dwysize               := 0;
2182         Windows.CreateProcess(nil,
2183                                                                 PChar(Path),
2184                                                                 nil,
2185                                                                 nil,
2186                                                                 False,
2187                                                                 0,
2188                                                                 nil,
2189                                                                 nil,
2190                                                                 SI,
2191                                                                 PI);
2192 end;
2193
2194 procedure TGikoSys.OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
2195 begin
2196         case BrowserType of
2197                 gbtIE:
2198                         HlinkNavigateString(nil, PWideChar(WideString(URL)));
2199                 gbtUserApp, gbtAuto:
2200                         if (Setting.URLApp) and (FileExists(Setting.URLAppFile)) then
2201                                 GikoSys.CreateProcess(Setting.URLAppFile, URL)
2202                         else
2203                                 HlinkNavigateString(nil, PWideChar(WideString(URL)));
2204         end;
2205 end;
2206
2207 function TGikoSys.HTMLDecode(const AStr: String): String;
2208 var
2209         Sp, Rp, Cp, Tp: PChar;
2210         S: String;
2211         I, Code: Integer;
2212         Num: Boolean;
2213 begin
2214         SetLength(Result, Length(AStr));
2215         Sp := PChar(AStr);
2216         Rp := PChar(Result);
2217         //Cp := Sp;
2218         try
2219                 while Sp^ <> #0 do begin
2220                         case Sp^ of
2221                                 '&': begin
2222                                                          //Cp := Sp;
2223                                                          Inc(Sp);
2224                                                          case Sp^ of
2225                                                                  'a': if AnsiStrPos(Sp, 'amp;') = Sp then
2226                                                                                         begin
2227                                                                                                 Inc(Sp, 3);
2228                                                                                                 Rp^ := '&';
2229                                                                                         end;
2230                                                                  'l',
2231                                                                  'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then
2232                                                                                         begin
2233                                                                                                 Cp := Sp;
2234                                                                                                 Inc(Sp, 2);
2235                                                                                                 while (Sp^ <> ';') and (Sp^ <> #0) do
2236                                                                                                         Inc(Sp);
2237                                                                                                 if Cp^ = 'l' then
2238                                                                                                         Rp^ := '<'
2239                                                                                                 else
2240                                                                                                         Rp^ := '>';
2241                                                                                         end;
2242                                                                  'q': if AnsiStrPos(Sp, 'quot;') = Sp then
2243                                                                                         begin
2244                                                                                                 Inc(Sp,4);
2245                                                                                                 Rp^ := '"';
2246                                                                                         end;
2247                                                                  '#': begin
2248                                                                                                 Tp := Sp;
2249                                                                                                 Inc(Tp);
2250                                                                                                 Num := IsNumeric(Copy(Tp, 1, 1));
2251                                                                                                 while (Sp^ <> ';') and (Sp^ <> #0) do begin
2252                                                                                                         if (Num) and (not IsNumeric(Copy(Sp, 1, 1))) then
2253                                                                                                                 Break;
2254                                                                                                         Inc(Sp);
2255                                                                                                 end;
2256                                                                                                 SetString(S, Tp, Sp - Tp);
2257                                                                                                 Val(S, I, Code);
2258                                                                                                 Rp^ := Chr((I));
2259                                                                                         end;
2260                                                          //      else
2261                                                                          //raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2262                                                                                  //[Cp^ + Sp^, Cp - PChar(AStr)])
2263                                                          end;
2264                                          end
2265                         else
2266                                 Rp^ := Sp^;
2267                         end;
2268                         Inc(Rp);
2269                         Inc(Sp);
2270                 end;
2271         except
2272 //              on E:EConvertError do
2273 //                      raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2274 //                              [Cp^ + Sp^, Cp - PChar(AStr)])
2275         end;
2276         SetLength(Result, Rp - PChar(Result));
2277 end;
2278
2279 function TGikoSys.GetHRefText(s: string): string;
2280 var
2281         Index: Integer;
2282         Index2: Integer;
2283 begin
2284         Result := '';
2285         s := Trim(s);
2286         if s = '' then
2287                 Exit;
2288
2289         Index := AnsiPos('href', LowerCase(s));
2290         if Index = 0 then
2291                 Exit;
2292         s := Trim(Copy(s, Index + 4, Length(s)));
2293         s := Trim(Copy(s, 2, Length(s)));
2294
2295         //\8en\82ß\82Ì\95¶\8e\9a\82ª'"'\82È\82ç\8eæ\82è\8f\9c\82
2296         if Copy(s, 1, 1) = '"' then begin
2297                 s := Trim(Copy(s, 2, Length(s)));
2298         end;
2299
2300         Index := AnsiPos('"', s);
2301         if Index <> 0 then begin
2302                 //'"'\82Ü\82ÅURL\82Æ\82·\82é
2303                 s := Copy(s, 1, Index - 1);
2304         end else begin
2305                 //'"'\82ª\96³\82¯\82ê\82Î\83X\83y\81[\83X\82©">"\82Ì\91\81\82¢\95û\82Ü\82Å\82ðURL\82Æ\82·\82é
2306                 Index := AnsiPos(' ', s);
2307                 Index2 := AnsiPos('>', s);
2308                 if Index = 0 then
2309                         Index := Index2;
2310                 if Index > Index2 then
2311                         Index := Index2;
2312                 if Index <> 0 then
2313                         s := Copy(s, 1, Index - 1)
2314                 else
2315                         //\82±\82ê\88È\8fã\82à\82¤\92m\82ç\82ñ\82Ê
2316                         ;
2317         end;
2318         Result := Trim(s);
2319 end;
2320
2321 //\83z\83X\83g\96¼\82ª\82Q\82\83\82\88\82©\82Ç\82¤\82©\83`\83F\83b\83N\82·\82é
2322 function TGikoSys.Is2chHost(Host: string): Boolean;
2323 const
2324         HOST_NAME: array[0..1] of string = ('2ch.net', 'bbspink.com');
2325 var
2326         i: Integer;
2327 //      Len: Integer;
2328 begin
2329         Result := False;
2330         if RightStr( Host, 1 ) = '/' then
2331                 Host := Copy( Host, 1, Length( Host ) - 1 );
2332         OutputDebugString(pchar(HOST_NAME[0]));
2333         for i := 0 to Length(HOST_NAME) - 1 do begin
2334 //              Len := Length(HOST_NAME[i]);
2335                 if AnsiPos(HOST_NAME[i], Host) = (Length(Host) - Length(HOST_NAME[i]) + 1) then begin
2336                         Result := True;
2337                         Exit;
2338                 end;
2339         end;
2340 end;
2341
2342 function TGikoSys.Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
2343 const
2344         READ_PATH: string =                     '/test/read.cgi/';
2345         OLD_READ_PATH: string =         '/test/read.cgi?';
2346         KAKO_PATH: string =                     '/kako/';
2347 var
2348         Index: Integer;
2349         s: string;
2350         SList: TStringList;
2351 begin
2352         BBSID := '';
2353         BBSKey := '';
2354         Result := False;
2355
2356         Index := AnsiPos(READ_PATH, path);
2357         if Index <> 0 then begin
2358                 s := Copy(path, Length(READ_PATH) + 1, Length(path));
2359                 BBSID := GetTokenIndex(s, '/', 0);
2360                 BBSKey := GetTokenIndex(s, '/', 1);
2361                 if BBSKey = '' then
2362                         BBSKey := Document;
2363                 Result := (BBSID <> '') or (BBSKey <> '');
2364                 Exit;
2365         end;
2366         Index := AnsiPos(KAKO_PATH, path);
2367         if Index <> 0 then begin
2368                 s := Copy(path, 2, Length(path));
2369                 BBSID := GetTokenIndex(s, '/', 0);
2370                 if (BBSID = 'log') and (GetTokenIndex(s, '/', 2) = 'kako') then
2371                         BBSID := GetTokenIndex(s, '/', 1);
2372                 BBSKey := ChangeFileExt(Document, '');
2373                 Result := (BBSID <> '') or (BBSKey <> '');
2374                 Exit;
2375         end;
2376         Index := AnsiPos('read.cgi?', URL);
2377         if Index <> 0 then begin
2378                 SList := TStringList.Create;
2379                 try
2380                         try
2381 //                              s := HTMLDecode(Document);
2382                                 ExtractHTTPFields(['?', '&'], [], PChar(URL), SList, False);
2383                                 BBSID := SList.Values['bbs'];
2384                                 BBSKey := SList.Values['key'];
2385                                 Result := (BBSID <> '') or (BBSKey <> '');
2386                                 Exit;
2387                         except
2388                                 Exit;
2389                         end;
2390                 finally
2391                         SList.Free;
2392                 end;
2393         end;
2394 end;
2395
2396 function TGikoSys.Parse2chURL2(URL: string): TPathRec;
2397 var
2398         i: Integer;
2399         s: string;
2400         wk: string;
2401         wkMin: Integer;
2402         wkMax: Integer;
2403         wkInt: Integer;
2404         RStart: Integer;
2405         RLength: Integer;
2406         SList: TStringList;
2407 begin
2408         URL := Trim(LowerCase(URL));
2409         Result.FBBS := '';
2410         Result.FKey := '';
2411         Result.FSt := 0;
2412         Result.FTo := 0;
2413         Result.FFirst := False;
2414         Result.FStBegin := False;
2415         Result.FToEnd := False;
2416         Result.FDone := False;
2417
2418         wkMin := 0;
2419         wkMax := 1;
2420
2421         FAWKStr.RegExp := 'http://.+\.(2ch\.net|bbspink\.com)/';
2422         if FAWKStr.Match(FAWKStr.ProcessEscSeq(URL), RStart, RLength) = 0 then
2423                 Exit;
2424         s := Copy(URL, RStart + RLength - 1, Length(URL));
2425
2426         //\95W\8f\80\8f\91\8e®
2427         //\8dÅ\8cã\82Íl50, 10, 10-20, 10n, 10-20n, -10, 10-, 10n- \82È\82Ç
2428         //http://xxx.2ch.net/test/read.cgi/bbsid/1000000000/
2429         FAWKStr.RegExp := '/test/read.cgi/.+/[0-9]+/.*';
2430         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2431                 s := Copy(s, 15, Length(s));
2432
2433                 SList := TStringList.Create;
2434                 try
2435                         SList.Clear;
2436                         FAWKStr.RegExp := '/';
2437                         if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
2438                                 Result.FBBS := SList[1];
2439                                 Result.FKey := SList[2];
2440                                 if SList.Count >= 3 then
2441                                         s := SList[3]
2442                                 else
2443                                         s := '';
2444                         end else
2445                                 Exit;
2446
2447                         SList.Clear;
2448                         FAWKStr.LineSeparator := mcls_CRLF;
2449                         FAWKStr.RegExp := '-';
2450                         if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) = 0 then begin
2451                                 Result.FFirst := True;
2452                         end else begin
2453                                 FAWKStr.RegExp := 'l[0-9]+';
2454                                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2455                                         Result.FFirst := True;
2456                                 end else begin
2457                                         for i := 0 to SList.Count - 1 do begin
2458                                                 if Trim(SList[i]) = '' then begin
2459                                                         if i = 0 then
2460                                                                 Result.FStBegin := True;
2461                                                         if i = (SList.Count - 1) then
2462                                                                 Result.FToEnd := True;
2463                                                 end else if IsNumeric(SList[i]) then begin
2464                                                         wkInt := StrToInt(SList[i]);
2465                                                         wkMax := Max(wkMax, wkInt);
2466                                                         if wkMin = 0 then
2467                                                                 wkMin := wkInt
2468                                                         else
2469                                                                 wkMin := Min(wkMin, wkInt);
2470                                                 end else if Trim(SList[i]) = 'n' then begin
2471                                                         Result.FFirst := True;
2472                                                 end else begin
2473                                                         FAWKStr.RegExp := '^n[0-9]+$|^[0-9]+n$';
2474                                                         if FAWKStr.Match(FAWKStr.ProcessEscSeq(SList[i]), RStart, RLength) > 0 then begin
2475                                                                 if Copy(SList[i], 1, 1) = 'n' then
2476                                                                         wkInt := StrToInt(Copy(SList[i], 2, Length(SList[i])))
2477                                                                 else
2478                                                                         wkInt := StrToInt(Copy(SList[i], 1, Length(SList[i]) - 1));
2479                                                                 Result.FFirst := True;
2480                                                                 wkMax := Max(wkMax, wkInt);
2481                                                                 if wkMin = 1 then
2482                                                                         wkMin := wkInt
2483                                                                 else
2484                                                                         wkMin := Min(wkMin, wkInt);
2485                                                         end;
2486                                                 end;
2487                                         end;
2488                                         if Result.FStBegin and (not Result.FToEnd) then
2489                                                 Result.FSt := wkMin
2490                                         else if (not Result.FStBegin) and Result.FToEnd then
2491                                                 Result.FTo := wkMax
2492                                         else if (not Result.FStBegin) and (not Result.FToEnd) then begin
2493                                                 Result.FSt := wkMin;
2494                                                 Result.FTo := wkMax;
2495                                         end;
2496                                         //Result.FSt := wkMin;
2497                                         //Result.FTo := wkMax;
2498                                 end;
2499                         end;
2500                 finally
2501                         SList.Free;
2502                 end;
2503                 Result.FDone := True;
2504                 Exit;
2505         end;
2506
2507         //\90Vkako\8f\91\8e®
2508         //http://server.2ch.net/ITA_NAME/kako/1000/10000/1000000000.html
2509         FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+/[0-9]+\.html';
2510         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2511                 SList := TStringList.Create;
2512                 try
2513                         SList.Clear;
2514                         FAWKStr.RegExp := '/';
2515                         if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
2516                                 Result.FBBS := SList[1];
2517                                 Result.FKey := ChangeFileExt(SList[5], '');
2518                                 Result.FFirst := True;
2519                         end else
2520                                 Exit;
2521                 finally
2522                         SList.Free;
2523                 end;
2524                 Result.FDone := True;
2525                 Exit;
2526         end;
2527
2528         //\8b\8ckako\8f\91\8e®
2529         //http://server.2ch.net/ITA_NAME/kako/999/999999999.html
2530         FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+\.html';
2531         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2532                 SList := TStringList.Create;
2533                 try
2534                         SList.Clear;
2535                         FAWKStr.RegExp := '/';
2536                         if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 5 then begin
2537                                 Result.FBBS := SList[1];
2538                                 Result.FKey := ChangeFileExt(SList[4], '');
2539                                 Result.FFirst := True;
2540                         end else
2541                                 Exit;
2542                 finally
2543                         SList.Free;
2544                 end;
2545                 Result.FDone := True;
2546                 Exit;
2547         end;
2548
2549         //log\8by\82Ñlog2\8f\91\8e®
2550         //http://server.2ch.net/log/ITA_NAME/kako/999/999999999.html
2551         //http://server.2ch.net/log2/ITA_NAME/kako/999/999999999.html
2552         FAWKStr.RegExp := '/log2?/.+/kako/[0-9]+/[0-9]+\.html';
2553         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2554                 SList := TStringList.Create;
2555                 try
2556                         SList.Clear;
2557                         FAWKStr.RegExp := '/';
2558                         if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
2559                                 Result.FBBS := SList[2];
2560                                 Result.FKey := ChangeFileExt(SList[5], '');
2561                                 Result.FFirst := True;
2562                         end else
2563                                 Exit;
2564                 finally
2565                         SList.Free;
2566                 end;
2567                 Result.FDone := True;
2568                 Exit;
2569         end;
2570
2571
2572         //\8b\8cURL\8f\91\8e®
2573         //http://server.2ch.net/test/read.cgi?bbs=ITA_NAME&key=1000000000&st=1&to=5&nofirst=true
2574         FAWKStr.RegExp := '/test/read\.cgi\?';
2575         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2576                 s := Copy(s, 16, Length(s));
2577                 SList := TStringList.Create;
2578                 try
2579                         SList.Clear;
2580                         FAWKStr.RegExp := '&';
2581                         if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
2582                                 Result.FFirst := True;
2583                                 for i := 0 to SList.Count - 1 do begin
2584                                         if Pos('bbs=', SList[i]) = 1 then begin
2585                                                 Result.FBBS := Copy(SList[i], 5, Length(SList[i]));
2586                                         end else if Pos('key=', SList[i]) = 1 then begin
2587                                                 Result.FKey := Copy(SList[i], 5, Length(SList[i]));
2588                                         end else if Pos('st=', SList[i]) = 1 then begin
2589                                                 wk := Copy(SList[i], 4, Length(SList[i]));
2590                                                 if IsNumeric(wk) then
2591                                                         Result.FSt := StrToInt(wk)
2592                                                 else if wk = '' then
2593                                                         Result.FStBegin := True;
2594                                         end else if Pos('to=', SList[i]) = 1 then begin
2595                                                 wk := Copy(SList[i], 4, Length(SList[i]));
2596                                                 if IsNumeric(wk) then
2597                                                         Result.FTo := StrToInt(wk)
2598                                                 else if wk = '' then
2599                                                         Result.FToEnd := True;
2600                                         end else if Pos('nofirst=', SList[i]) = 1 then begin
2601                                                 Result.FFirst := False;
2602                                         end;
2603                                 end;
2604                         end else
2605                                 Exit;
2606                 finally
2607                         SList.Free;
2608                 end;
2609
2610                 if (Result.FBBS <> '') and (Result.FKey <> '') then begin
2611                         Result.FDone := True;
2612                 end;
2613                 Exit;
2614         end;
2615 end;
2616
2617 procedure TGikoSys.ParseURI(var URL, Protocol, Host, Path, Document, Port, Bookmark: string);
2618 var
2619         URI: TIdURI;
2620 begin
2621         Protocol := '';
2622         Host := '';
2623         Path := '';
2624         Document := '';
2625         Port := '';
2626         Bookmark := '';
2627         URI := TIdURI.Create(URL);
2628         try
2629                 Protocol := URI.Protocol;
2630                 Host := URI.Host;
2631                 Path := URI.Path;
2632                 Document := URI.Document;
2633                 Port := URI.Port;
2634                 Bookmark := URI.Bookmark;
2635         finally
2636                 URI.Free;
2637         end;
2638 end;
2639
2640 function TGikoSys.GetVersionBuild: Integer;
2641 var
2642         FixedFileInfo: PVSFixedFileInfo;
2643         VersionHandle, VersionSize: DWORD;
2644         pVersionInfo: Pointer;
2645         ItemLen : UInt;
2646         AppFile: string;
2647 begin
2648         Result := 0;
2649         AppFile := Application.ExeName;
2650         VersionSize := GetFileVersionInfoSize(pChar(AppFile), VersionHandle);
2651         if VersionSize = 0 then
2652                 Exit;
2653         GetMem(pVersionInfo, VersionSize);
2654         try
2655                 if GetFileVersionInfo(PChar(AppFile),VersionHandle,VersionSize, pVersionInfo) then
2656                         if VerQueryValue(pVersionInfo, '\', Pointer(FixedFileInfo), ItemLen) then
2657                                 Result := LOWORD(FixedFileInfo^.dwFileVersionLS);
2658         finally
2659                 FreeMem(pVersionInfo, VersionSize);
2660         end;
2661 end;
2662
2663 function        TGikoSys.Get2chThreadURL2BoardURL(
2664         inURL : string
2665 ) : string;
2666 var
2667         Protocol, Host, Path, Document, Port, Bookmark : string;
2668         BBSID, BBSKey : string;
2669 begin
2670
2671         ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
2672         Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
2673
2674         Result := Protocol + '://' + Host + '/' + BBSID + '/';
2675
2676 end;
2677
2678 function        TGikoSys.Get2chBrowsableThreadURL(
2679         inURL : string
2680 ) : string;
2681 var
2682         Protocol, Host, Path, Document, Port, Bookmark : string;
2683         BBSID, BBSKey : string;
2684 begin
2685
2686         ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
2687         Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
2688
2689         Result := Protocol + '://' + Host + '/test/read.cgi/' + BBSID + '/' + BBSKey + '/l50';
2690
2691 end;
2692
2693 function        TGikoSys.Get2chBoard2ThreadURL(
2694         inBoard : TBoard;
2695         inKey           : string
2696 ) : string;
2697 var
2698         url : string;
2699         Protocol, Host, Path, Document, Port, Bookmark : string;
2700 begin
2701
2702         url := inBoard.URL;
2703         ParseURI( url, Protocol, Host, Path, Document, Port, Bookmark );
2704
2705         Result := Protocol + '://' + Host + '/test/read.cgi/' + inBoard.BBSID + '/' + inKey + '/l50';
2706
2707 end;
2708
2709 (*************************************************************************
2710  *\8b@\94\\96¼\81@\81@\81F\83{\81[\83h\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
2711  *\89Â\8e\8b\81@\81@\81@\81FPublic
2712  *\97\9a\97ð\82P\81@\81@\81F\90V\8bK\8dì\90¬
2713  *************************************************************************)
2714 procedure TGikoSys.ReadBoardFile;
2715 var
2716         i, j, k: integer;
2717         kbound: Integer;
2718         idx: Integer;
2719         ini: TMemIniFile;
2720         CategoryList: TStringList;
2721         BoardList: TStringList;
2722         Category: TCategory;
2723         Board: TBoard;
2724         inistr: string;
2725         RoundItem: TRoundItem;
2726         BBSList: TStringList;
2727         CustomList: TStringList;
2728         BoardFileList: TStringList;
2729
2730         plugInBBSs                              : array of TBBS;
2731         agent                           : string;
2732         major                           : DWORD;
2733         minor                           : DWORD;
2734         release                 : string;
2735         revision                : DWORD;
2736         plugInIndex     : Integer;
2737         bbs2channel     : TBBS;
2738         bbsCustom               : TBBS;
2739 begin
2740         ini := TMemIniFile.Create('');
2741         BBSList := TStringList.Create;
2742         CustomList := TStringList.Create;
2743         BoardFileList := TStringList.Create;
2744         try
2745                 // \94Â\83\8a\83X\83g\82Ì\93Ç\82Ý\8d\9e\82Ý
2746
2747                 // \82Q\82¿\82á\82ñ\82Ë\82é
2748                 if FileExists(GikoSys.GetBoardFileName) then
2749                         BBSList.LoadFromFile(GikoSys.GetBoardFileName);
2750                 // \83J\83X\83^\83\80
2751                 if FileExists(GikoSys.GetCustomBoardFileName) then
2752                         CustomList.LoadFromFile(GikoSys.GetCustomBoardFileName);
2753                 BBSList.AddStrings(CustomList);
2754                 // Board \83t\83H\83\8b\83_
2755                 if DirectoryExists(GikoSys.Setting.GetBoardDir) then begin
2756                         GikoSys.GetFileList( GikoSys.Setting.GetBoardDir, '*', BoardFileList, True, True );
2757                         for i := BoardFileList.Count - 1 downto 0 do begin
2758                                 CustomList.Clear;
2759                                 CustomList.LoadFromFile( BoardFileList[ i ] );
2760                                 BBSList.AddStrings( CustomList );
2761                         end;
2762                 end;
2763                 ini.SetStrings(BBSList);
2764
2765                 try
2766                         for i := 0 to Length( BBSs ) - 1 do
2767                                 BBSs[ i ].Free;
2768                 except
2769                 end;
2770                 SetLength( BBSs, 0 );
2771
2772                 // \82Q\82¿\82á\82ñ\82Ë\82é\82ð\90¶\90¬
2773                 bbs2channel := TBBS.Create( GikoSys.Setting.LogFolder );
2774                 bbs2channel.Title := '\82Q\82¿\82á\82ñ\82Ë\82é';
2775                 i := Length( BBSs );
2776                 SetLength( BBSs, i + 1 );
2777                 BBSs[ i ] := bbs2channel;
2778
2779                 // \83J\83X\83^\83\80 BBS \82ð\90¶\90¬
2780                 bbsCustom := TBBS.Create( GikoSys.Setting.LogFolder );
2781                 bbsCustom.Title := '\82»\82Ì\91¼';
2782                 i := Length( BBSs );
2783                 SetLength( BBSs, i + 1 );
2784                 BBSs[ i ] := bbsCustom;
2785
2786                 // \83v\83\89\83O\83C\83\93\97p BBS \82ð\90¶\90¬
2787                 try
2788                         kbound  := Length( BoardPlugIns );
2789                         SetLength( plugInBBSs, kbound );
2790                         i := Length( BBSs );
2791                         SetLength( BBSs, i + kbound );
2792                         Dec( kbound );
2793                         for k := 0 to kbound do begin
2794                                 if Assigned( Pointer( BoardPlugIns[ k ].Module ) ) then begin
2795                                         // BBS \96¼\82Ì\91ã\82í\82è\82É\82Æ\82è\82 \82¦\82¸\83v\83\89\83O\83C\83\93\96¼\82ð\93ü\82ê\82Ä\82¨\82
2796                                         // \81¦\8d¡\8cã BBS \96¼\82ð\93ü\82ê\82é\82æ\82¤\82É\89ü\97Ç\82·\82é\82±\82Æ
2797                                         BoardPlugIns[ k ].VersionInfo( agent, major, minor, release, revision );
2798                                         plugInBBSs[ k ] := TBBS.Create( GikoSys.Setting.LogFolder );
2799                                         plugInBBSs[ k ].Title   := agent;
2800                                         BBSs[ i + k ] := plugInBBSs[ k ];
2801                                 end;
2802                         end;
2803                 except
2804                 end;
2805
2806                 CategoryList := TStringList.Create;
2807                 BoardList := TStringList.Create;
2808                 try
2809                         ini.ReadSections(CategoryList);
2810                         for i := 0 to CategoryList.Count - 1 do begin
2811
2812                                 ini.ReadSection(CategoryList[i], BoardList);
2813                                 Category := TCategory.Create;
2814                                 Category.No := i + 1;
2815                                 Category.Title := CategoryList[i];
2816                                 // \82¿\82å\82Á\82Æ\83g\83\8a\83b\83L\81[\82¾\82ª\81A
2817                                 // plugInIndex >= 0 \81c\81c \83v\83\89\83O\83C\83\93\82ð\8eg\97p\81BBoardPlugIns \82Ì\93Y\82¦\8e\9a\82É\82È\82é
2818                                 // plugInIndex = -1 \81c\81c \82Q\82¿\82á\82ñ\82Ë\82é
2819                                 // other \81c\81c \82»\82Ì\91¼
2820                                 plugInIndex := -99999;
2821
2822                                 for j := 0 to BoardList.Count - 1 do begin
2823                                         Board := nil;
2824                                         inistr := ini.ReadString(CategoryList[i], BoardList[j], '');
2825
2826                                         //===== \83v\83\89\83O\83C\83\93
2827                                         try
2828                                                 kbound := High( BoardPlugIns );
2829                                                 for k := Low( BoardPlugIns ) to kbound do begin
2830                                                         if Assigned( Pointer( BoardPlugIns[ k ].Module ) ) then begin
2831                                                                 if BoardPlugIns[ k ].AcceptURL( inistr ) = atBoard then begin
2832                                                                         Board := TBoard.Create( BoardPlugIns[ k ], inistr );
2833                                                                         plugInIndex := k;
2834
2835                                                                         Break;
2836                                                                 end;
2837                                                         end;
2838                                                 end;
2839                                         except
2840                                                 // 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¢
2841                                         end;
2842
2843                                         if Board = nil then begin
2844                                                 Board := TBoard.Create( nil, inistr );
2845                                                 if GikoSys.Is2chHost( GikoSys.UrlToServer( inistr ) ) then
2846                                                         plugInIndex := -1;
2847                                         end;
2848                                         Board.BeginUpdate;
2849                                         Board.No := j + 1;
2850                                         Board.Title := BoardList[j];
2851                                         Board.BBSID := GikoSys.UrlToID(inistr);
2852                                         Board.RoundDate := ZERO_DATE;
2853
2854                                         idx := RoundList.Find(Board);
2855                                         if idx <> -1 then begin
2856                                                 RoundItem := RoundList.Items[idx, grtBoard];
2857                                                 Board.Round := True;
2858                                                 Board.RoundName := RoundItem.RoundName;
2859                                         end;
2860                                         Category.Add(Board);
2861                                         Board.EndUpdate;
2862                                 end;
2863                                 if plugInIndex >= 0 then begin
2864                                         plugInBBSs[ plugInIndex ].Add( Category );
2865                                 end else if plugInIndex = -1 then begin
2866                                         bbs2channel.Add( Category );
2867                                 end else begin
2868                                         bbsCustom.Add( Category );
2869                                 end;
2870                         end;
2871                 finally
2872                         BoardList.Free;
2873                         CategoryList.Free;
2874                 end;
2875         finally
2876                 BBSList.Free;
2877                 CustomList.Free;
2878                 BoardFileList.Free;
2879                 ini.Free;
2880         end;
2881 end;
2882
2883 initialization
2884         GikoSys := TGikoSys.Create;
2885
2886 finalization
2887         if GikoSys <> nil then begin
2888                 GikoSys.Free;
2889                 GikoSys := nil;
2890         end;
2891 end.