GikoSystem.pas

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