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