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