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