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