GikoSystem.pas

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