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