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