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         MojuUtils, ExternalBoardManager, ExternalBoardPlugInMain;
  18
  19 type
  20         //BBS\83^\83C\83v
  21         TGikoBBSType = (gbt2ch);
  22         //\83\8d\83O\83^\83C\83v
  23         TGikoLogType = (glt2chNew, glt2chOld);
  24         //\83\81\83b\83Z\81[\83W\83A\83C\83R\83\93
  25         TGikoMessageIcon = (gmiOK, gmiSAD, gmiNG, gmiWhat, gmiNone);
  26         //URL\83I\81[\83v\83\93\83u\83\89\83E\83U\83^\83C\83v
  27         TGikoBrowserType = (gbtIE, gbtUserApp, gbtAuto);
  28
  29
  30         TStrTokSeparator = set of Char;
  31         TStrTokRec = record
  32                 Str: string;
  33                 Pos: Integer;
  34         end;
  35
  36         //\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b\83\8c\83R\81[\83h
  37         TIndexRec = record
  38                 FNo: Integer;
  39                 FFileName: string;
  40                 FTitle: string;
  41                 FCount: Integer;
  42                 FSize: Integer;
  43 //              FRoundNo: Integer;
  44                 FRoundDate: TDateTime;
  45                 FLastModified: TDateTime;
  46                 FKokomade: Integer;
  47                 FNewReceive: Integer;
  48                 FMishiyou: Boolean;     //\96¢\8eg\97p
  49                 FUnRead: Boolean;
  50                 FScrollTop: Integer;
  51                 //Index Ver 1.01
  52                 FAllResCount: Integer;
  53                 FNewResCount: Integer;
  54                 FAgeSage: TGikoAgeSage;
  55         end;
  56
  57         //\83T\83u\83W\83F\83N\83g\83\8c\83R\81[\83h
  58         TSubjectRec = record
  59                 FFileName: string;
  60                 FTitle: string;
  61                 FCount: Integer;
  62         end;
  63
  64         //\83\8c\83X\83\8c\83R\81[\83h
  65         TResRec = record
  66                 FTitle: string;
  67                 FMailTo: string;
  68                 FName: string;
  69                 FDateTime: string;
  70                 FBody: string;
  71                 FType: TGikoLogType;
  72         end;
  73
  74         //URLPath\83\8c\83R\81[\83h
  75         TPathRec = record
  76                 FBBS: string;                           //BBSID
  77                 FKey: string;                           //ThreadID
  78                 FSt: Int64;                             //\8aJ\8en\83\8c\83X\94Ô
  79                 FTo: Int64;                             //\8fI\97¹\83\8c\83X\94Ô
  80                 FFirst: Boolean;                //>>1\82Ì\95\\8e¦
  81                 FStBegin: Boolean;      //1\81`\95\\8e¦
  82                 FToEnd: Boolean;                //\81`\8dÅ\8cã\82Ü\82Å\95\\8e¦
  83                 FDone: Boolean;                 //\90¬\8c÷
  84         end;
  85
  86         TGikoSys = class(TObject)
  87         private
  88                 { Private \90é\8c¾ }
  89                 FSetting: TSetting;
  90                 FDolib: TDolib;
  91                 FAWKStr: TAWKStr;
  92                 FOnlyAHundredRes : Boolean;
  93
  94 //              FExitWrite: TStringList;
  95 //              function StrToFloatDef(s: string; Default: Double): Double;
  96         public
  97                 { Public \90é\8c¾ }
  98                 FAbon : TAbon;
  99                 FSelectResFilter : TAbon;
 100                 constructor Create;
 101
 102                 destructor Destroy; override;
 103                 property OnlyAHundredRes : Boolean read FOnlyAHundredRes write FOnlyAHundredRes;
 104 //              function MsgBox(Msg: string; Title: string; Flags: Longint): integer; overload;
 105 //              function MsgBox(Handle: THandle; Msg: string; Title: string; Flags: Longint): integer; overload;
 106                 function IsNumeric(s: string): boolean;
 107                 function IsFloat(s: string): boolean;
 108                 function DirectoryExistsEx(const Name: string): Boolean;
 109                 function ForceDirectoriesEx(Dir: string): Boolean;
 110 //              function GetVersion: string;
 111
 112                 function GetBoardFileName: string;
 113                 function GetCustomBoardFileName: string;
 114                 function GetHtmlTempFileName: string;
 115                 function GetAppDir: string;
 116                 function GetTempFolder: string;
 117                 function GetSentFileName: string;
 118                 function GetConfigDir: string;
 119                 function GetSkinDir: string;
 120                 function GetSkinHeaderFileName: string;
 121                 function GetSkinFooterFileName: string;
 122                 function GetSkinResFileName: string;
 123                 function GetSkinNewResFileName: string;
 124                 function GetSkinBookmarkFileName: string;
 125                 function GetSkinNewmarkFileName: string;
 126                 function GetStyleSheetDir: string;
 127                 function GetOutBoxFileName: string;
 128                 function GetUserAgent: string;
 129                                 function GetSambaFileName : string;
 130
 131                 procedure ReadSubjectFile(Board: TBoard);
 132                 procedure CreateThreadDat(Board: TBoard);
 133                 procedure WriteThreadDat(Board: TBoard);
 134                 function ParseIndexLine(Line: string): TIndexRec;
 135                 procedure GetFileList(Path: string; Mask: string; var List: TStringList; SubDir: Boolean; IsPathAdd: Boolean); overload;
 136                 procedure GetFileList(Path: string; Mask: string; var List: TStringList; IsPathAdd: Boolean); overload;//\83T\83u\83t\83H\83\8b\83_\82Í\8c\9f\8dõ\82µ\82È\82¢
 137                 procedure GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
 138
 139                 procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
 140                 function AddAnchorTag(s: string): string;
 141
 142                 function DivideSubject(Line: string): TSubjectRec;
 143                 function DivideStrLine(Line: string): TResRec;
 144
 145                 property Setting: TSetting read FSetting write FSetting;
 146                 property Dolib: TDolib read FDolib write FDolib;
 147
 148                 function UrlToID(url: string): string;
 149                 function UrlToServer(url: string): string;
 150
 151                 function StrTokFirst(const s:string; const sep:TStrTokSeparator; var Rec:TStrTokRec):string;
 152                 function StrTokNext(const sep:TStrTokSeparator; var Rec:TStrTokRec): string;
 153
 154                 function GetFileSize(FileName : string) : longint;
 155                 function GetFileLineCount(FileName : string): longint;
 156                 function Get2chDate(aDate: TDateTime): string;
 157                 function IntToDateTime(val: Int64): TDateTime;
 158                 function DateTimeToInt(ADate: TDateTime): Int64;
 159
 160                 function ReadThreadFile(FileName: string; Line: Integer): string;
 161
 162                 procedure MenuFont(Font: TFont);
 163
 164                 function RemoveToken(var s:string; const delimiter:string):string;
 165                 function GetTokenIndex(s: string; delimiter: string; index: Integer): string;
 166                 function DeleteLink(const s: string): string;
 167
 168                 function GetShortName(const LongName: string; ALength: integer): string;
 169                 function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string): string; overload;
 170         function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue, FullURL : string): string; overload;
 171
 172                 function ZenToHan(const s: string): string;
 173                 function VaguePos(const Substr, S: string): Integer;
 174                 function BoolToInt(b: Boolean): Integer;
 175                 function IntToBool(i: Integer): Boolean;
 176                 function GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
 177                 procedure LoadKeySetting(ActionList: TActionList);
 178                 procedure SaveKeySetting(ActionList: TActionList);
 179                 procedure LoadEditorKeySetting(ActionList: TActionList);
 180                 procedure SaveEditorKeySetting(ActionList: TActionList);
 181
 182                 procedure CreateProcess(const AppPath: string; const Param: string);
 183                 procedure OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
 184                 function HTMLDecode(const AStr: String): String;
 185                 function GetHRefText(s: string): string;
 186                 function Is2chHost(Host: string): Boolean;
 187                 function Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
 188                 function Parse2chURL2(URL: string): TPathRec;
 189                 procedure ParseURI(var URL, Protocol, Host, Path, Document, Port, Bookmark: string);
 190                 function GetVersionBuild: Integer;
 191                 function        GetBrowsableThreadURL( inURL : string ) : string;
 192                 function        GetThreadURL2BoardURL( inURL : string ) : string;
 193                 function        Get2chThreadURL2BoardURL( inURL : string ) : string;
 194                 function        Get2chBrowsableThreadURL( inURL : string ) : string;
 195                 function        Get2chBoard2ThreadURL( inBoard : TBoard; inKey : string ) : string;
 196                 procedure ListBoardFile;
 197                 procedure ReadBoardFile( bbs : TBBS );
 198
 199                 function        GetUnknownCategory : TCategory;
 200                 function        GetUnknownBoard( inPlugIn : TBoardPlugIn; inURL : string ) : TBoard;
 201
 202         procedure GetPopupResNumber(URL : string; var stRes, endRes : Int64);
 203
 204                 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
 205                 function LoadFromSkin( fileName: string; ThreadItem: TThreadItem; SizeByte: Integer ): string;
 206         // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
 207                 function SkinedRes( skin: string; Res: TResRec; No: string ): string;
 208
 209         //Samba24\82Ì\83t\83@\83C\83\8b\82ª\91¶\8dÝ\82·\82é\82©\81B\91¶\8dÝ\82µ\82È\82¢\8fê\8d\87\81Adefault\83t\83@\83C\83\8b\82ðrename\82·\82é
 210         procedure SambaFileExists();
 211         end;
 212
 213 var
 214         GikoSys: TGikoSys;
 215 const
 216         //LENGTH_RESTITLE                       = 40;
 217         ZERO_DATE: Integer      = 25569;
 218         BETA_VERSION_NAME_E = 'beta';
 219         BETA_VERSION_NAME_J = 'ÊÞÀ';
 220         BETA_VERSION                            = 48;
 221         BETA_VERSION_BUILD      = '';                           //debug\94Å\82È\82Ç
 222         APP_NAME                                                = 'gikoNavi';
 223
 224 implementation
 225
 226 uses
 227         Giko, RoundData;
 228
 229 const
 230         FOLDER_INDEX_VERSION                                    = '1.01';
 231         USER_AGENT                                                                              = 'Monazilla';
 232         DEFAULT_NGWORD_FILE_NAME : String = 'NGword.txt';
 233         NGWORDs_DIR_NAME : String               = 'NGwords';
 234
 235         READ_PATH: string =                     '/test/read.cgi/';
 236         OLD_READ_PATH: string =         '/test/read.cgi?';
 237         KAKO_PATH: string =                     '/kako/';
 238
 239 (*************************************************************************
 240  *GikoSys\83R\83\93\83X\83g\83\89\83N\83^
 241  *************************************************************************)
 242 constructor TGikoSys.Create;
 243 begin
 244         FSetting := TSetting.Create;
 245         FDolib := TDolib.Create;
 246         FAWKStr := TAWKStr.Create(nil);
 247         if DirectoryExists(GetConfigDir) = false then begin
 248                 CreateDir(GetConfigDir);
 249         end;
 250         FAbon := TAbon.Create;
 251         FAbon.Setroot(GetConfigDir+NGWORDs_DIR_NAME);
 252         FAbon.GoHome;
 253         FAbon.ReturnNGwordLineNum := FSetting.ShowNGLinesNum;
 254         FAbon.SetNGResAnchor := FSetting.AddResAnchor;
 255     FAbon.DeleteSyria := FSetting.DeleteSyria;
 256         FAbon.Deleterlo := FSetting.AbonDeleterlo;
 257         FAbon.Replaceul := FSetting.AbonReplaceul;
 258         FAbon.AbonPopupRes := FSetting.PopUpAbon;
 259
 260         FSelectResFilter := TAbon.Create;
 261         // \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
 262         FSelectResFilter.AbonString := '';
 263         //
 264         OnlyAHundredRes := FSetting.OnlyAHundredRes;
 265 end;
 266
 267 (*************************************************************************
 268  *GikoSys\83f\83X\83g\83\89\83N\83^
 269  *************************************************************************)
 270 destructor TGikoSys.Destroy;
 271 var
 272         i: Integer;
 273         FileList: TStringList;
 274 begin
 275         //\83X\83\8c\83b\83h\83f\81[\83^\83t\83@\83C\83\8b\82ð\8dX\90V
 276 //      FlashExitWrite;
 277
 278 //      FExitWrite.Free;
 279         FAWKStr.Free;
 280         FSetting.Free;
 281         FDolib.Free;
 282         FAbon.Free;
 283         FSelectResFilter.Free;
 284         //\83e\83\93\83|\83\89\83\8aHTML\82ð\8dí\8f\9c
 285         FileList := TStringList.Create;
 286         try
 287                 GetFileList(GetTempFolder, '*.html', FileList, False, True);
 288                 for i := 0 to FileList.Count - 1 do begin
 289                         DeleteFile(FileList[i]);
 290                 end;
 291         finally
 292                 FileList.Free;
 293         end;
 294         inherited;
 295 end;
 296
 297 (*************************************************************************
 298  *\95¶\8e\9a\97ñ\90\94\8e\9a\83`\83F\83b\83N
 299  *************************************************************************)
 300 {$HINTS OFF}
 301 function TGikoSys.IsNumeric(s: string): boolean;
 302 var
 303         e: integer;
 304         v: integer;
 305 begin
 306         Val(s, v, e);
 307         Result := e = 0;
 308 end;
 309 {$HINTS ON}
 310
 311 (*************************************************************************
 312  *\95¶\8e\9a\97ñ\95\82\93®\8f¬\90\94\93_\90\94\8e\9a\83`\83F\83b\83N
 313  *************************************************************************)
 314 function TGikoSys.IsFloat(s: string): boolean;
 315 var
 316         v: Extended;
 317 begin
 318         Result := TextToFloat(PChar(s), v, fvExtended);
 319 end;
 320
 321 (*************************************************************************
 322  *\83{\81[\83h\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 323  *************************************************************************)
 324 function TGikoSys.GetBoardFileName: string;
 325 begin
 326         Result := Setting.GetBoardFileName;
 327 end;
 328
 329 (*************************************************************************
 330  *\83{\81[\83h\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 331  *************************************************************************)
 332 function TGikoSys.GetCustomBoardFileName: string;
 333 begin
 334         Result := Setting.GetCustomBoardFileName;
 335 end;
 336
 337 (*************************************************************************
 338  *\83e\83\93\83|\83\89\83\8a\83t\83H\83\8b\83_\81[\96¼\8eæ\93¾
 339  *************************************************************************)
 340 function TGikoSys.GetHtmlTempFileName: string;
 341 begin
 342         Result := Setting.GetHtmlTempFileName;
 343 end;
 344
 345
 346 (*************************************************************************
 347  *\8eÀ\8ds\83t\83@\83C\83\8b\83t\83H\83\8b\83_\8eæ\93¾
 348  *************************************************************************)
 349 function TGikoSys.GetAppDir: string;
 350 begin
 351         Result := Setting.GetAppDir;
 352 end;
 353
 354 (*************************************************************************
 355  *TempHtml\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 356  *************************************************************************)
 357 function TGikoSys.GetTempFolder: string;
 358 begin
 359         Result := Setting.GetTempFolder;
 360 end;
 361
 362 (*************************************************************************
 363  *sent.ini\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 364  *************************************************************************)
 365 function TGikoSys.GetSentFileName: string;
 366 begin
 367         Result := Setting.GetSentFileName;
 368 end;
 369
 370 (*************************************************************************
 371  *outbox.ini\83t\83@\83C\83\8b\96¼\8eæ\93¾\81i\83p\83X\81{\83t\83@\83C\83\8b\96¼\81j
 372  *************************************************************************)
 373 function TGikoSys.GetOutBoxFileName: string;
 374 begin
 375         Result := Setting.GetOutBoxFileName;
 376 end;
 377
 378 (*************************************************************************
 379  *Config\83t\83H\83\8b\83_\8eæ\93¾
 380  *************************************************************************)
 381 function TGikoSys.GetConfigDir: string;
 382 begin
 383         Result := Setting.GetConfigDir;
 384 end;
 385
 386 function TGikoSys.GetStyleSheetDir: string;
 387 begin
 388         Result := Setting.GetStyleSheetDir;
 389 end;
 390
 391 function TGikoSys.GetSkinDir: string;
 392 begin
 393         Result := Setting.GetSkinDir;
 394 end;
 395
 396 function TGikoSys.GetSkinHeaderFileName: string;
 397 begin
 398         Result := Setting.GetSkinHeaderFileName;
 399 end;
 400
 401 function TGikoSys.GetSkinFooterFileName: string;
 402 begin
 403         Result := Setting.GetSkinFooterFileName;
 404 end;
 405
 406 function TGikoSys.GetSkinNewResFileName: string;
 407 begin
 408         Result := Setting.GetSkinNewResFileName;
 409 end;
 410
 411 function TGikoSys.GetSkinResFileName: string;
 412 begin
 413         Result := Setting.GetSkinResFileName;
 414 end;
 415
 416 function TGikoSys.GetSkinBookmarkFileName: string;
 417 begin
 418         Result := Setting.GetSkinBookmarkFileName;
 419 end;
 420
 421 function TGikoSys.GetSkinNewmarkFileName: string;
 422 begin
 423         Result := Setting.GetSkinNewmarkFileName;
 424 end;
 425
 426 // UserAgent\8eæ\93¾
 427 function TGikoSys.GetUserAgent: string;
 428 begin
 429         if Dolib.Connected then begin
 430                 Result := Format('%s %s/%s%d%s', [
 431                                                                 Dolib.UserAgent,
 432                                                                 APP_NAME,
 433                                                                 //MAJOR_VERSION,
 434                                                                 //MINOR_VERSION,
 435                                                                 BETA_VERSION_NAME_E,
 436                                                                 BETA_VERSION,
 437                                                                 BETA_VERSION_BUILD]);
 438         end else begin
 439                 Result := Format('%s/%s %s/%s%d%s', [
 440                                                                 USER_AGENT,
 441                                                                 Dolib.Version,
 442                                                                 APP_NAME,
 443                                                                 //MAJOR_VERSION,
 444                                                                 //MINOR_VERSION,
 445                                                                 BETA_VERSION_NAME_E,
 446                                                                 BETA_VERSION,
 447                                                                 BETA_VERSION_BUILD]);
 448         end;
 449 end;
 450
 451 (*************************************************************************
 452  *\82Q\82¿\82á\82ñ\82Ë\82é\95û\8e®\8e\9e\8d\8f\8eæ\93¾
 453  *************************************************************************)
 454 function TGikoSys.Get2chDate(aDate: TDateTime): string;
 455 var
 456         d1: TDateTime;
 457         d2: TDateTime;
 458 begin
 459         d1 := EncodeDate(1970, 1, 1);
 460         d2 := aDate - EncodeTime(9, 0, 0, 0);
 461         //Result := FloatToStr(Trunc((d2 - d1) * 24 * 60 * 60));
 462         Result := FloatToStr(Trunc((d2 - d1) * 86400));
 463 end;
 464
 465
 466 function TGikoSys.IntToDateTime(val: Int64): TDateTime;
 467 var
 468         d1: tdatetime;
 469         d2: tdatetime;
 470 begin
 471         d1 := EncodeDate(1970, 1, 1);
 472         d2 := val / 86400.0;//(val * 1000) / (24 * 60 * 60 * 1000);
 473         Result := d1 + d2;
 474 end;
 475
 476 function TGikoSys.DateTimeToInt(ADate: TDateTime): Int64;
 477 var
 478         d: TDateTime;
 479         c: Currency;
 480 begin
 481         d := EncodeDate(1970, 1, 1);
 482         c := (ADate - d) * 86400; //(ADate - d) * 24 * 60 * 60;
 483         Result := Trunc(c);
 484 end;
 485
 486
 487 (*************************************************************************
 488  *Subject\83t\83@\83C\83\8bRead
 489  *************************************************************************)
 490 procedure TGikoSys.ReadSubjectFile(Board: TBoard);
 491 var
 492         ThreadItem: TThreadItem;
 493         FileName: string;
 494         FileList: TStringList;
 495         TmpFileList: TStringList;
 496 //      SrchRec: TSearchRec;
 497 //      R: integer;
 498         Index: Integer;
 499         sl: TStringList;
 500         i: Integer;
 501         Rec: TIndexRec;
 502         UnRead: Integer;
 503 //      TmpUpdate: Boolean;
 504         ini: TMemIniFile;
 505         ResRec: TResRec;
 506         RoundItem: TRoundItem;
 507         idx: Integer;
 508         usePlugIn : Boolean;
 509         tmpStr: string;
 510 begin
 511         if Board.IsThreadDatRead then
 512                 Exit;
 513         //Board.Clear;
 514         UnRead := 0;
 515 //      TmpUpdate := False;
 516
 517         usePlugIn := Board.IsBoardPlugInAvailable;
 518
 519         FileName := Board.GetFolderIndexFileName;
 520
 521 //      if not FileExists(FileName) then CreateThreadDat(Board);
 522 //      if not FileExists(FileName) then Exit;
 523
 524         {       R := FindFirst(ExtractFileDir(Board.GetFolderIndexFileName) + '\*.dat', 0, SrchRec);
 525                 while R = 0 do begin
 526                         FileList.Add(SrchRec.Name);
 527                         R := FindNext(SrchRec);
 528                 end;
 529                 FindClose(SrchRec);}
 530
 531         FileList := TStringList.Create;
 532         FileList.Sorted := True;
 533         TmpFileList := TStringList.Create;
 534         TmpFileList.Sorted := True;
 535
 536         //IsLogFile\97pDAT\83t\83@\83C\83\8b\83\8a\83X\83g
 537         //GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.dat', FileList, False, False);
 538         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.dat', FileList, False);
 539
 540         //\91O\89ñ\88Ù\8fí\8fI\97¹\8e\9e\97pTmp\83t\83@\83C\83\8b\83\8a\83X\83g
 541         //GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, False, False);
 542         GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, False);
 543
 544         // \8fd\95¡\82ð\96h\82®
 545         Board.BeginUpdate;
 546         Board.Sorted := True;
 547
 548         sl := TStringList.Create;
 549         try
 550                 if FileExists(FileName) then begin
 551                         sl.LoadFromFile(FileName);
 552
 553                         //\82Q\8ds\96Ú\82©\82ç\81i\82P\8ds\96Ú\82Í\83o\81[\83W\83\87\83\93\81j
 554                         for i := sl.Count - 1 downto 1 do begin
 555                                 Rec := ParseIndexLine(sl[i]);
 556                                 if usePlugIn then
 557                                         ThreadItem := TThreadItem.Create(
 558                                                         Board.BoardPlugIn,
 559                                                         Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), Rec.FFileName ) )
 560                                 else
 561                                         ThreadItem := TThreadItem.Create(
 562                                                 nil,
 563                                                 Get2chBoard2ThreadURL( Board, ChangeFileExt( Rec.FFileName, '' ) ) );
 564
 565                                 if FileList.Count <> 0 then
 566                                         if FileList.Find( ThreadItem.FileName, Index ) then
 567                                                 //ThreadItem.IsLogFile := True;
 568                                                 FileList.Delete( Index );
 569
 570                                 ThreadItem.BeginUpdate;
 571                                 ThreadItem.No := Rec.FNo;
 572                                 ThreadItem.FileName := Rec.FFileName;
 573                                 ThreadItem.Title := Rec.FTitle;
 574                                 ThreadItem.Count := Rec.FCount;
 575                                 ThreadItem.Size := Rec.FSize;
 576 //                      ThreadItem.RoundNo := Rec.FRoundNo;
 577                                 ThreadItem.RoundDate := Rec.FRoundDate;
 578                                 ThreadItem.LastModified := Rec.FLastModified;
 579                                 ThreadItem.Kokomade := Rec.FKokomade;
 580                                 ThreadItem.NewReceive := Rec.FNewReceive;
 581 //                      ThreadItem.Round := Rec.FRound;
 582                                 ThreadItem.UnRead := Rec.FUnRead;
 583                                 ThreadItem.ScrollTop := Rec.FScrollTop;
 584                                 ThreadItem.AllResCount := Rec.FAllResCount;
 585                                 ThreadItem.NewResCount := Rec.FNewResCount;
 586                                 ThreadItem.AgeSage := Rec.FAgeSage;
 587                                 ThreadItem.ParentBoard := Board;
 588
 589                                 //\8f\84\89ñ\83\8a\83X\83g\82É\91¶\8dÝ\82µ\82½\82ç\8f\84\89ñ\83t\83\89\83O\83Z\83b\83g
 590                                 if ThreadItem.IsLogFile then begin
 591                                         idx := RoundList.Find(ThreadItem);
 592                                         if idx <> -1 then begin
 593                                                 RoundItem := RoundList.Items[idx, grtItem];
 594                                                 ThreadItem.RoundName := RoundItem.RoundName;
 595                                                 ThreadItem.Round := True;
 596                                         end;
 597                                 end;
 598
 599                                 //\91O\89ñ\88Ù\8fí\8fI\97¹\8e\9e\83`\83F\83b\83N
 600                                 if TmpFileList.Count <> 0 then begin
 601                                         Index := TmpFileList.IndexOf(ChangeFileExt(ThreadItem.FileName, '.tmp'));
 602                                         //if TmpFileList.Find(ChangeFileExt(ThreadItem.FileName, '.tmp'), Index) then begin
 603                                         if Index <> -1 then begin
 604                                                 ini := TMemIniFile.Create(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[Index]);
 605                                                 try
 606                                                         //ThreadItem.RoundDate := ini.ReadDateTime('Setting', 'RoundDate', ZERO_DATE);
 607                                                         tmpStr := ini.ReadString('Setting', 'RoundDate', DateTimeToStr(ZERO_DATE));
 608                                                         ThreadItem.RoundDate := ConvertDateTimeString(tmpStr);
 609
 610                                                         //ThreadItem.LastModified := ini.ReadDateTime('Setting', 'LastModified', ZERO_DATE);
 611                                                         tmpStr := ini.ReadString('Setting', 'LastModified', DateTimeToStr(ZERO_DATE));
 612                                                         ThreadItem.LastModified := ConvertDateTimeString(tmpStr);
 613
 614                                                         ThreadItem.Size := ini.ReadInteger('Setting', 'Size', 0);
 615                                                         if ThreadItem.Size = 0 then begin
 616                                                                         try
 617                                                                                 ThreadItem.Size := FileSizeByName(ThreadItem.GetThreadFileName) - ThreadItem.Count;
 618                                                                         except
 619                                                                         end;
 620                                                         end;
 621                                                         ThreadItem.Count := ini.ReadInteger('Setting', 'Count', 0);
 622                                                         ThreadItem.NewReceive := ini.ReadInteger('Setting', 'NewReceive', 0);
 623                                                         ThreadItem.Round := ini.ReadBool('Setting', 'Round', False);
 624                                                         ThreadItem.UnRead := False;//ini.ReadBool('Setting', 'UnRead', False);
 625                                                         ThreadItem.ScrollTop := ini.ReadInteger('Setting', 'ScrollTop', 0);
 626                                                         ThreadItem.AllResCount := ini.ReadInteger('Setting', 'AllResCount', ThreadItem.Count);
 627                                                         ThreadItem.NewResCount := ini.ReadInteger('Setting', 'NewResCount', 0);
 628                                                         ThreadItem.AgeSage := TGikoAgeSage(ini.ReadInteger('Setting', 'AgeSage', Ord(gasNone)));
 629                                                 finally
 630                                                         ini.Free;
 631                                                 end;
 632                                                 DeleteFile(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[Index]);
 633                                                 TmpFileList.Delete(Index);
 634                                         end;
 635                                 end;
 636
 637                                 ThreadItem.EndUpdate;
 638                                 Board.Add(ThreadItem);
 639
 640 //                      if (ThreadItem.IsLogFile) and (ThreadItem.Count > ThreadItem.Kokomade) then
 641                                 if (ThreadItem.IsLogFile) and (ThreadItem.UnRead) then
 642                                         Inc(UnRead);
 643                         end;
 644                 end;
 645
 646                 if UnRead <> Board.UnRead then
 647                         Board.UnRead := UnRead;
 648
 649                 //\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
 650                 for i := 0 to FileList.Count - 1 do begin
 651                         FileName := ExtractFileDir(Board.GetFolderIndexFileName) + '\' + FileList[i];
 652
 653                         //ResRec := DivideStrLine(ReadThreadFile(FileName, 1));
 654                         if usePlugIn then begin
 655                                 ThreadItem := TThreadItem.Create(
 656                                         Board.BoardPlugIn,
 657                                         Board.BoardPlugIn.FileName2ThreadURL( DWORD( Board ), FileList[i] ) );
 658                                 ResRec := DivideStrLine(Board.BoardPlugIn.GetDat( DWORD( ThreadItem ), 1 ));
 659                         end else begin
 660                                 ThreadItem := TThreadItem.Create(
 661                                         nil, Get2chBoard2ThreadURL( Board, ChangeFileExt( FileList[i], '' ) ) );
 662                                 ResRec := DivideStrLine(ReadThreadFile(FileName, 1));
 663                         end;
 664
 665                         ThreadItem.BeginUpdate;
 666                         ThreadItem.FilePath := FileName;
 667                         ThreadItem.No := Board.Count + 1;
 668                         ThreadItem.FileName := FileList[i];
 669                         ThreadItem.Title := ResRec.FTitle;
 670                         ThreadItem.Count := GetFileLineCount(FileName);
 671                         ThreadItem.AllResCount := ThreadItem.Count;
 672                         ThreadItem.NewResCount := ThreadItem.Count;
 673                         ThreadItem.Size := FileSizeByName(FileName) - ThreadItem.Count;//1byte\82¸\82ê\82é\82Æ\82«\82ª\82 \82é\82¯\82Ç\82»\82ê\82Í\82 \82«\82ç\82ß\82é
 674                         ThreadItem.RoundDate := ZERO_DATE;
 675                         ThreadItem.LastModified := ZERO_DATE;
 676                         ThreadItem.Kokomade := -1;
 677                         ThreadItem.NewReceive := ThreadItem.Count;
 678                         ThreadItem.ParentBoard := Board;
 679                         ThreadItem.IsLogFile := True;
 680                         ThreadItem.Round := False;
 681                         ThreadItem.UnRead := False;
 682                         ThreadItem.ScrollTop := 0;
 683                         ThreadItem.AgeSage := gasNone;
 684                         ThreadItem.EndUpdate;
 685                         Board.Add(ThreadItem);
 686                 end;
 687                 Board.EndUpdate;
 688         finally
 689                 sl.Free;
 690                 FileList.Free;
 691                 TmpFileList.Free;
 692                 Board.Sorted := False;
 693         end;
 694         Board.IsThreadDatRead := True;
 695         if not FileExists(Board.GetFolderIndexFileName) then begin
 696                 WriteThreadDat(Board);
 697                 CreateThreadDat(Board);
 698         end;
 699 end;
 700
 701 (*************************************************************************
 702  *\83X\83\8c\83b\83h\83C\83\93\83f\83b\83N\83X\83t\83@\83C\83\8b(Folder.idx)\8dì\90¬
 703  *************************************************************************)
 704 procedure TGikoSys.CreateThreadDat(Board: TBoard);
 705 var
 706         i: integer;
 707         s: string;
 708         SubjectList: TStringList;
 709         sl: TStringList;
 710         Rec: TSubjectRec;
 711         FileName: string;
 712         cnt: Integer;
 713 begin
 714         if not FileExists(Board.GetSubjectFileName) then Exit;
 715         FileName := Board.GetFolderIndexFileName;
 716
 717         SubjectList := TStringList.Create;
 718         try
 719                 SubjectList.LoadFromFile(Board.GetSubjectFileName);
 720                 sl := TStringList.Create;
 721                 try
 722                         cnt := 1;
 723                         sl.Add(FOLDER_INDEX_VERSION);
 724                         for i := 0 to SubjectList.Count - 1 do begin
 725                                 Rec := DivideSubject(SubjectList[i]);
 726
 727                                 if (Trim(Rec.FFileName) = '') or (Trim(Rec.FTitle) = '') then
 728                                         Continue;
 729
 730                                 s := Format('%x', [cnt]) + #1                                   //\94Ô\8d\86
 731                                          + Rec.FFileName + #1                                                           //\83t\83@\83C\83\8b\96¼
 732                                          + Rec.FTitle + #1                                                                      //\83^\83C\83g\83\8b
 733                                          + Format('%x', [Rec.FCount]) + #1      //\83J\83E\83\93\83g
 734                                          + Format('%x', [0]) + #1                                               //size
 735                                          + Format('%x', [0]) + #1                                               //RoundDate
 736                                          + Format('%x', [0]) + #1                                               //LastModified
 737                                          + Format('%x', [0]) + #1                                               //Kokomade
 738                                          + Format('%x', [0]) + #1                                               //NewReceive
 739                                          + '0' + #1                                                                                             //\96¢\8eg\97p
 740                                          + Format('%x', [0]) + #1                                               //UnRead
 741                                          + Format('%x', [0]) + #1                                               //ScrollTop
 742                                          + Format('%x', [Rec.FCount]) + #1      //AllResCount
 743                                          + Format('%x', [0]) + #1                                               //NewResCount
 744                                          + Format('%x', [0]);                                                           //AgeSage
 745
 746                                 sl.Add(s);
 747                                 inc(cnt);
 748                         end;
 749                         sl.SaveToFile(FileName);
 750                 finally
 751                         sl.Free;
 752                 end;
 753         finally
 754                 SubjectList.Free;
 755         end;
 756 end;
 757
 758 (*************************************************************************
 759  *\83X\83\8c\83b\83h\83C\83\93\83f\83b\83N\83X(Thread.dat)\8f\91\82«\8d\9e\82Ý
 760  *Public
 761  *************************************************************************)
 762 procedure TGikoSys.WriteThreadDat(Board: TBoard);
 763 //const
 764 //      Values: array[Boolean] of string = ('0', '1');
 765 var
 766         i: integer;
 767     Index: Integer;
 768     tmpSize: Integer;
 769         FileName: string;
 770         sl: TStringList;
 771         s: string;
 772         TmpFileList: TStringList;
 773     ini : TMemIniFIle;
 774 begin
 775         if not Board.IsThreadDatRead then
 776                 Exit;
 777         FileName := Board.GetFolderIndexFileName;
 778         ForceDirectoriesEx( ExtractFilePath( FileName ) );
 779
 780         sl := TStringList.Create;
 781          TmpFileList := TStringList.Create;
 782         try
 783                 //GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, False, true);
 784                 GetFileList(ExtractFileDir(Board.GetFolderIndexFileName), '*.tmp', TmpFileList, false);
 785
 786                 sl.BeginUpdate;
 787                 sl.Add(FOLDER_INDEX_VERSION);
 788                 for i := 0 to Board.Count - 1 do begin
 789                         if Board.Items[i].No = 0 then
 790                                 Board.Items[i].No := i + 1;
 791
 792                         if TmpFileList.Count <> 0 then begin
 793                                 //if TmpFileList.Find(ChangeFileExt(Board.Items[i].FileName, '.tmp'), Index) then begin
 794                                 Index := TmpFileList.IndexOf(ChangeFileExt(Board.Items[i].FileName, '.tmp'));
 795                                 if Index <> -1 then begin
 796                                         ini := TMemIniFile.Create(ChangeFileExt(Board.Items[Index].GetThreadFileName, '.tmp'));
 797                                         try
 798                                                 tmpSize := ini.ReadInteger('Setting', 'Size', 0);
 799                                                 if Board.Items[i].Size <  tmpSize then begin
 800                                                         //Board.Items[i].RoundDate := ini.ReadDateTime('Setting', 'RoundDate', ZERO_DATE);
 801                                                         //Board.Items[i].LastModified := ini.ReadDateTime('Setting', 'LastModified', ZERO_DATE);
 802                                                         Board.Items[i].Size := tmpSize;
 803                                                         Board.Items[i].Count := ini.ReadInteger('Setting', 'Count', 0);
 804                                                         Board.Items[i].NewReceive := ini.ReadInteger('Setting', 'NewReceive', 0);
 805                                                         //Board.Items[i].Round := ini.ReadBool('Setting', 'Round', False);
 806                                                         //Board.Items[i].UnRead := False;//ini.ReadBool('Setting', 'UnRead', False);
 807                                                         //Board.Items[i].ScrollTop := ini.ReadInteger('Setting', 'ScrollTop', 0);
 808                                                         Board.Items[i].AllResCount := ini.ReadInteger('Setting', 'AllResCount', Board.Items[i].Count);
 809                                                         Board.Items[i].NewResCount := ini.ReadInteger('Setting', 'NewResCount', 0);
 810                                                         //Board.Items[i].AgeSage := TGikoAgeSage(ini.ReadInteger('Setting', 'AgeSage', Ord(gasNone)));
 811                                                 end;
 812                                         finally
 813                                                 ini.Free;
 814                                         end;
 815                                         DeleteFile(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList.Strings[Index]);
 816                                         TmpFileList.Delete(Index);
 817                                 end;
 818                         end;
 819
 820                         s := Format('%x', [Board.Items[i].No]) + #1
 821                                  + Board.Items[i].FileName + #1
 822                                  + Board.Items[i].Title + #1
 823                                  + Format('%x', [Board.Items[i].Count]) + #1
 824                                  + Format('%x', [Board.Items[i].Size]) + #1
 825                                  + Format('%x', [DateTimeToInt(Board.Items[i].RoundDate)]) + #1
 826                                  + Format('%x', [DateTimeToInt(Board.Items[i].LastModified)]) + #1
 827                                  + Format('%x', [Board.Items[i].Kokomade]) + #1
 828                                  + Format('%x', [Board.Items[i].NewReceive]) + #1
 829                                  + '0' + #1     //\96¢\8eg\97p
 830                                  + Format('%x', [BoolToInt(Board.Items[i].UnRead)]) + #1
 831                                  + Format('%x', [Board.Items[i].ScrollTop]) + #1
 832                                  + Format('%x', [Board.Items[i].AllResCount]) + #1
 833                                  + Format('%x', [Board.Items[i].NewResCount]) + #1
 834                                  + Format('%x', [Ord(Board.Items[i].AgeSage)]);
 835
 836                         sl.Add(s);
 837                 end;
 838                 sl.EndUpdate;
 839                 sl.SaveToFile(FileName);
 840
 841                 for i := 0 to TmpFileList.Count - 1 do begin
 842                         DeleteFile(ExtractFilePath(Board.GetFolderIndexFileName) + TmpFileList[i]);
 843                 end;
 844
 845         finally
 846                 TmpFileList.Free;
 847                 sl.Free;
 848         end;
 849 end;
 850
 851 function TGikoSys.ParseIndexLine(Line: string): TIndexRec;
 852 //var
 853 //      s: string;
 854 //      i: Integer;
 855 begin
 856         {for i := 0 to 14 do begin
 857                 s := GetTokenIndex(Line, #1, i);
 858                 case i of
 859                         0: Result.FNo := StrToIntDef('$' + s, 0);
 860                         1: Result.FFileName := s;
 861                         2: Result.FTitle := s;
 862                         3: Result.FCount := StrToIntDef('$' + s, 0);
 863                         4: Result.FSize := StrToIntDef('$' + s, 0);
 864                         5: Result.FRoundDate := IntToDateTime(StrToIntDef('$' + s, ZERO_DATE));
 865                         6: Result.FLastModified := IntToDateTime(StrToIntDef('$' + s, ZERO_DATE));
 866                         7: Result.FKokomade := StrToIntDef('$' + s, -1);
 867                         8: Result.FNewReceive := StrToIntDef('$' + s, 0);
 868                         9: ;    //\96¢\8eg\97p
 869                         10: Result.FUnRead := IntToBool(StrToIntDef('$' + s, 0));
 870                         11: Result.FScrollTop := StrToIntDef('$' + s, 0);
 871                         12: Result.FAllResCount := StrToIntDef('$' + s, 0);
 872                         13: Result.FNewResCount := StrToIntDef('$' + s, 0);
 873                         14: Result.FAgeSage := TGikoAgeSage(StrToIntDef('$' + s, 0));
 874                 end;
 875         end;
 876         }
 877         Result.FNo := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 878         Result.FFileName := RemoveToken(Line, #1);
 879         Result.FTitle := RemoveToken(Line, #1);
 880         Result.FCount := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 881         Result.FSize := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 882         Result.FRoundDate := IntToDateTime(StrToIntDef('$' + RemoveToken(Line, #1), ZERO_DATE));
 883         Result.FLastModified := IntToDateTime(StrToIntDef('$' + RemoveToken(Line, #1), ZERO_DATE));
 884         Result.FKokomade := StrToIntDef('$' + RemoveToken(Line, #1), -1);
 885         Result.FNewReceive := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 886         RemoveToken(Line, #1);//9: ;    //\96¢\8eg\97p
 887         Result.FUnRead := IntToBool(StrToIntDef('$' + RemoveToken(Line, #1), 0));
 888         Result.FScrollTop := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 889         Result.FAllResCount := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 890         Result.FNewResCount := StrToIntDef('$' + RemoveToken(Line, #1), 0);
 891         Result.FAgeSage := TGikoAgeSage(StrToIntDef('$' + RemoveToken(Line, #1), 0));
 892
 893 end;
 894
 895 //\8ew\92è\83t\83H\83\8b\83_\93à\82Ì\8ew\92è\83t\83@\83C\83\8b\88ê\97\97\82ð\8eæ\93¾\82·\82é
 896 // ListFiles('c:\', '*.txt', list, True);
 897 procedure TGikoSys.GetFileList(Path: string; Mask: string; var List: TStringList; SubDir: Boolean; IsPathAdd: Boolean);
 898 var
 899         rc: Integer;
 900         SearchRec : TSearchRec;
 901         s: string;
 902         maskExt: string;
 903 begin
 904         maskExt := Copy(Mask, 1, Length(Mask) - 1);
 905
 906         Path := IncludeTrailingPathDelimiter(Path);
 907         rc := FindFirst(Path + '*.*', faAnyfile, SearchRec);
 908         try
 909                 while rc = 0 do begin
 910                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
 911                                 s := Path + SearchRec.Name;
 912                                 //if (SearchRec.Attr and faDirectory > 0) then
 913                                 //      s := IncludeTrailingPathDelimiter(s)
 914
 915                                 if (SearchRec.Attr and faDirectory = 0) and (MatchesMask(s, Mask)) then
 916                                                 if IsPathAdd then
 917                                                         List.Add(s)
 918                                                 else
 919                                                         List.Add(SearchRec.Name);
 920                                 if SubDir and (SearchRec.Attr and faDirectory > 0) then
 921                                         GetFileList(s, Mask, List, True, IsPathAdd);
 922                         end;
 923                         rc := FindNext(SearchRec);
 924                 end;
 925         finally
 926                 SysUtils.FindClose(SearchRec);
 927         end;
 928         List.Sort;
 929 end;
 930 //\8ew\92è\83t\83H\83\8b\83_\93à\82Ì\8ew\92è\83t\83@\83C\83\8b\88ê\97\97\82ð\8eæ\93¾\82·\82é
 931 //\83T\83u\83t\83H\83\8b\83_\82Í\8c\9f\8dõ\82µ\82È\82¢
 932 // ListFiles('c:\', '*.txt', list, True);
 933 procedure TGikoSys.GetFileList(Path: string; Mask: string; var List: TStringList; IsPathAdd: Boolean);
 934 var
 935         rc: Integer;
 936         SearchRec : TSearchRec;
 937         s: string;
 938 begin
 939         Path := IncludeTrailingPathDelimiter(Path);
 940         rc := FindFirst(Path + Mask, faAnyfile, SearchRec);
 941         try
 942                 while rc = 0 do begin
 943                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
 944                                 s := Path + SearchRec.Name;
 945
 946                                 if (SearchRec.Attr and faDirectory = 0) then
 947                                                 if IsPathAdd then
 948                                                         List.Add(s)
 949                                                 else
 950                                                         List.Add(SearchRec.Name);
 951                         end;
 952                         rc := FindNext(SearchRec);
 953                 end;
 954         finally
 955                 SysUtils.FindClose(SearchRec);
 956         end;
 957         List.Sort;
 958 end;
 959 //\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é
 960 procedure TGikoSys.GetDirectoryList(Path: string; Mask: string; List: TStringList; SubDir: Boolean);
 961 var
 962         rc: Integer;
 963         SearchRec : TSearchRec;
 964         s: string;
 965 begin
 966         Path := IncludeTrailingPathDelimiter(Path);
 967         rc := FindFirst(Path + '*.*', faDirectory, SearchRec);
 968         try
 969                 while rc = 0 do begin
 970                         if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then begin
 971                                 s := Path + SearchRec.Name;
 972                                 //if (SearchRec.Attr and faDirectory > 0) then
 973                                 //      s := IncludeTrailingPathDelimiter(s)
 974
 975                                 if (SearchRec.Attr and faDirectory > 0) and (MatchesMask(s, Mask)) then
 976                                         List.Add( IncludeTrailingPathDelimiter( s ) );
 977                                 if SubDir and (SearchRec.Attr and faDirectory > 0) then
 978                                         GetDirectoryList(s, Mask, List, True);
 979                         end;
 980                         rc := FindNext(SearchRec);
 981                 end;
 982         finally
 983                 SysUtils.FindClose(SearchRec);
 984         end;
 985 end;
 986
 987 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
 988 function TGikoSys.LoadFromSkin(
 989         fileName: string;
 990         ThreadItem: TThreadItem;
 991         SizeByte: Integer
 992 ): string;
 993 var
 994         Skin: TStringList;
 995 begin
 996
 997         Skin := TStringList.Create;
 998         try
 999                 if FileExists( fileName ) then begin
1000                         Skin.LoadFromFile( fileName );
1001
1002                         // \82â\82è\82©\82½\82ª\8bê\82µ\82¢\82¯\82Ç\81A\83I\83v\83V\83\87\83\93\83_\83C\83A\83\8d\83O\82Ì\83v\83\8c\83r\83\85\81[\97p try
1003                         try
1004                                 if ThreadItem.ParentBoard <> nil then
1005                                         if ThreadItem.ParentBoard.ParentCategory <> nil then
1006                         CustomStringReplace( Skin, '<BBSNAME/>', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
1007                     CustomStringReplace( Skin, '<THREADURL/>', ThreadItem.URL);
1008                         except end;
1009             CustomStringReplace( Skin, '<BOARDNAME/>', ThreadItem.ParentBoard.Title);
1010             CustomStringReplace( Skin, '<BOARDURL/>', ThreadItem.ParentBoard.URL);
1011             CustomStringReplace( Skin, '<THREADNAME/>', ThreadItem.Title);
1012             CustomStringReplace( Skin, '<SKINPATH/>', Setting.CSSFileName);
1013             CustomStringReplace( Skin, '<GETRESCOUNT/>', IntToStr( ThreadItem.NewReceive - 1 ));
1014                                                 CustomStringReplace( Skin, '<NEWRESCOUNT/>', IntToStr( ThreadItem.NewResCount ));
1015                                                 CustomStringReplace( Skin, '<ALLRESCOUNT/>', IntToStr( ThreadItem.AllResCount ));
1016
1017             CustomStringReplace( Skin, '<NEWDATE/>',FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
1018                                                 CustomStringReplace( Skin, '<SIZEKB/>', IntToStr( Floor( SizeByte / 1024 ) ));
1019                                                 CustomStringReplace( Skin, '<SIZE/>', IntToStr( SizeByte ));
1020
1021                         //----- \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µ
1022                         // \82â\82è\82©\82½\82ª\8bê\82µ\82¢\82¯\82Ç\81A\83I\83v\83V\83\87\83\93\83_\83C\83A\83\8d\83O\82Ì\83v\83\8c\83r\83\85\81[\97p try
1023                         try
1024                                 if ThreadItem.ParentBoard <> nil then
1025                                         if ThreadItem.ParentBoard.ParentCategory <> nil then
1026                         CustomStringReplace( Skin, '&BBSNAME', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
1027                     CustomStringReplace( Skin, '&THREADURL', ThreadItem.URL);
1028                         except end;
1029             CustomStringReplace( Skin, '&BOARDNAME', ThreadItem.ParentBoard.Title);
1030             CustomStringReplace( Skin, '&BOARDURL', ThreadItem.ParentBoard.URL);
1031             CustomStringReplace( Skin, '&THREADNAME', ThreadItem.Title);
1032             CustomStringReplace( Skin, '&SKINPATH', Setting.CSSFileName);
1033             CustomStringReplace( Skin, '&GETRESCOUNT', IntToStr( ThreadItem.NewReceive - 1 ));
1034             CustomStringReplace( Skin, '&NEWRESCOUNT', IntToStr( ThreadItem.NewResCount ));
1035             CustomStringReplace( Skin, '&ALLRESCOUNT', IntToStr( ThreadItem.AllResCount ));
1036
1037             CustomStringReplace( Skin, '&NEWDATE', FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
1038             CustomStringReplace( Skin, '&SIZEKB', IntToStr( Floor( SizeByte / 1024 ) ));
1039             CustomStringReplace( Skin, '&SIZE', IntToStr( SizeByte ));
1040                         //----- \82±\82±\82Ü\82Å
1041                 end;
1042                 Result := Skin.Text;
1043         finally
1044                 Skin.Free;
1045         end;
1046 end;
1047
1048 // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
1049 function TGikoSys.SkinedRes(
1050         skin: string;
1051         Res: TResRec;
1052         No: string
1053 ): string;
1054 begin
1055
1056         try
1057                 Skin := CustomStringReplace( Skin, '<NUMBER/>',
1058                         '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
1059                 Skin := CustomStringReplace( Skin, '<PLAINNUMBER/>', No);
1060                 Skin := CustomStringReplace( Skin, '<NAME/>', '<b>' + Res.FName + '</b>');
1061                 Skin := CustomStringReplace( Skin, '<MAILNAME/>',
1062                         '<a href="mailto:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>');
1063                 Skin := CustomStringReplace( Skin, '<MAIL/>', Res.FMailTo);
1064                 Skin := CustomStringReplace( Skin, '<DATE/>', Res.FDateTime);
1065                 Skin := CustomStringReplace( Skin, '<MESSAGE/>', Res.FBody);
1066
1067                 //----- \82©\82¿\82ã\81`\82µ\82á\8cÝ\8a·\97p\81B\83R\83\81\83\93\83g\83A\83E\83g\82µ\82Ä\82à\82æ\82µ
1068                 Skin := CustomStringReplace( Skin, '&NUMBER',
1069                         '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
1070                 Skin := CustomStringReplace( Skin, '&PLAINNUMBER', No);
1071                 Skin := CustomStringReplace( Skin, '&NAME', '<b>' + Res.FName + '</b>');
1072                 Skin := CustomStringReplace( Skin, '&MAILNAME',
1073                         '<a href="mailto:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>');
1074                 Skin := CustomStringReplace( Skin, '&MAIL', Res.FMailTo);
1075                 Skin := CustomStringReplace( Skin, '&DATE', Res.FDateTime);
1076                 Skin := CustomStringReplace( Skin, '&MESSAGE', Res.FBody);
1077                 //----- \82±\82±\82Ü\82Å
1078
1079                 Result := Skin;
1080         finally
1081         end;
1082
1083 end;
1084
1085 procedure TGikoSys.CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
1086 var
1087         i: integer;
1088         No: string;
1089         //bufList : TStringList;
1090         ReadList: TStringList;
1091         SaveList: TStringList;
1092         CSSFileName: string;
1093         BBSID: string;
1094         FileName: string;
1095         NewReceiveNo: Integer;
1096         Res: TResRec;
1097         boardPlugIn : TBoardPlugIn;
1098
1099         UserOptionalStyle: string;
1100         SkinHeader: string;
1101         SkinNewRes: string;
1102         SkinRes: string;
1103 //      SizeByte: Integer;
1104
1105         function LoadSkin( fileName: string ): string;
1106         begin
1107                 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1108         end;
1109         function ReplaceRes( skin: string ): string;
1110         begin
1111                 Result := SkinedRes( skin, Res, No );
1112         end;
1113 begin
1114         if ThreadItem <> nil then begin
1115                 if ThreadItem.IsBoardPlugInAvailable then begin
1116                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
1117                         boardPlugIn             := ThreadItem.BoardPlugIn;
1118                         NewReceiveNo    := ThreadItem.NewReceive;
1119                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1120                         if Length( GikoSys.Setting.BrowserFontName ) > 0 then
1121                                 UserOptionalStyle := UserOptionalStyle +
1122                                                                 'font-family:"' + GikoSys.Setting.BrowserFontName + '";';
1123                         if GikoSys.Setting.BrowserFontSize <> 0 then
1124                                 UserOptionalStyle := UserOptionalStyle +
1125                                                                 'font-size:' + IntToStr( GikoSys.Setting.BrowserFontSize ) + 'pt;';
1126                         if GikoSys.Setting.BrowserFontColor <> -1 then
1127                                 UserOptionalStyle := UserOptionalStyle +
1128                                                                 'color:#' + IntToHex( GikoSys.Setting.BrowserFontColor, 6 ) + ';';
1129                         if GikoSys.Setting.BrowserBackColor <> -1 then
1130                                 UserOptionalStyle := UserOptionalStyle +
1131                                                                 'background-color:#' + IntToHex( GikoSys.Setting.BrowserBackColor, 6 ) + ';';
1132                         case GikoSys.Setting.BrowserFontBold of
1133                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-weight:normal;';
1134                                 1: UserOptionalStyle := UserOptionalStyle + 'font-weight:bold;';
1135                         end;
1136                         case GikoSys.Setting.BrowserFontItalic of
1137                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-style:normal;';
1138                                 1: UserOptionalStyle := UserOptionalStyle + 'font-style:italic;';
1139                         end;
1140
1141                         SaveList := TStringList.Create;
1142                         try
1143                                 doc.open;
1144                                 // \95¶\8e\9a\83R\81[\83h\82Í\83v\83\89\83O\83C\83\93\82É\94C\82¹\82é
1145                                 // doc.charset := 'Shift_JIS';
1146                                 threadItem.SizeByte := 0;
1147
1148                                 // \83w\83b\83_
1149                                 SaveList.Add( boardPlugIn.GetHeader( DWORD( threadItem ),
1150                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ) );
1151
1152                                 for i := 0 to threadItem.Count - 1 do begin
1153                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (threadItem.Count-i) > 101 ) then begin
1154                                                 Continue;
1155                                         end;
1156
1157                                         // \90V\92\85\83}\81[\83N
1158                                         if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1159                                                 try
1160                                                         if GikoSys.Setting.UseSkin then begin
1161                                                                 if FileExists( GetSkinNewmarkFileName ) then
1162                                                                         SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) )
1163                                                                 else
1164                                                                         SaveList.Add( '<a name="new"></a>' );
1165                                                         end else if GikoSys.Setting.UseCSS then begin
1166                                                                 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>');
1167                                                         end else begin
1168                                                                 SaveList.Add('</dl>');
1169                                                                 SaveList.Add('<a name="new"></a>');
1170                                                                 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>');
1171                                                                 SaveList.Add('<dl>');
1172                                                         end;
1173                                                 except
1174                                                         SaveList.Add( '<a name="new"></a>' );
1175                                                 end;
1176                                         end;
1177
1178                                         // \83\8c\83X
1179                                         SaveList.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) );
1180
1181                                         if ThreadItem.Kokomade = (i + 1) then begin
1182                                                 // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
1183                                                 try
1184                                                         if GikoSys.Setting.UseSkin then begin
1185                                                                 if FileExists( GetSkinBookmarkFileName ) then
1186                                                                         SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) )
1187                                                                 else
1188                                                                         SaveList.Add( '<a name="koko"></a>' );
1189                                                         end else if GikoSys.Setting.UseCSS then begin
1190                                                                 SaveList.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
1191                                                         end else begin
1192                                                                 SaveList.Add('</dl>');
1193                                                                 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>');
1194                                                                 SaveList.Add('<dl>');
1195                                                         end;
1196                                                 except
1197                                                         SaveList.Add( '<a name="koko"></a>' );
1198                                                 end;
1199                                         end;
1200
1201                                         threadItem.SizeByte := threadItem.SizeByte + Length( SaveList.Text );
1202                                         doc.Write(SaveList.Text);
1203                                         SaveList.Clear;
1204                                 end;
1205
1206                                 threadItem.SizeByte := threadItem.SizeByte + Length( SaveList.Text );
1207
1208                                 // \83X\83L\83\93(\83t\83b\83^)
1209                                 SaveList.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1210
1211                                 doc.Write(SaveList.Text);
1212                         finally
1213                                 SaveList.Free;
1214                                 doc.Close;
1215                         end;
1216
1217                         Exit;
1218                 end;
1219         end;
1220         ShortDayNames[1] := '\93ú';               ShortDayNames[2] := '\8c\8e';
1221         ShortDayNames[3] := '\89Î';               ShortDayNames[4] := '\90\85';
1222         ShortDayNames[5] := '\96Ø';               ShortDayNames[6] := '\8bà';
1223         ShortDayNames[7] := '\93y';
1224 //      SizeByte := 0;
1225         BBSID := ThreadItem.ParentBoard.BBSID;
1226         NewReceiveNo := ThreadItem.NewReceive;
1227         ReadList := TStringList.Create;
1228         try
1229                 if ThreadItem.IsLogFile then begin
1230                         FileName := ThreadItem.GetThreadFileName;
1231                         ReadList.LoadFromFile(FileName);
1232                         FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1233                         FAbon.Execute(ReadList);                //       \82 \82Ú\81`\82ñ\82µ\82Ä
1234                         FSelectResFilter.Execute(ReadList); //\83\8c\83X\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\82·\82é
1235                         Res := DivideStrLine(ReadList[0]);
1236                         Res.FTitle := CustomStringReplace(Res.FTitle, '\81\97\81M', ',');
1237                         sTitle := Res.FTitle;
1238                 end else begin
1239                         sTitle := CustomStringReplace(ThreadItem.Title, '\81\97\81M', ',');
1240                 end;
1241                 SaveList := TStringList.Create;
1242                 try
1243                         doc.open;
1244                         doc.charset := 'Shift_JIS';
1245
1246                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1247                         if Length( GikoSys.Setting.BrowserFontName ) > 0 then
1248                                 UserOptionalStyle := UserOptionalStyle +
1249                                                                 'font-family:"' + GikoSys.Setting.BrowserFontName + '";';
1250                         if GikoSys.Setting.BrowserFontSize <> 0 then
1251                                 UserOptionalStyle := UserOptionalStyle +
1252                                                                 'font-size:' + IntToStr( GikoSys.Setting.BrowserFontSize ) + 'pt;';
1253                         if GikoSys.Setting.BrowserFontColor <> -1 then
1254                                 UserOptionalStyle := UserOptionalStyle +
1255                                                                 'color:#' + IntToHex( GikoSys.Setting.BrowserFontColor, 6 ) + ';';
1256                         if GikoSys.Setting.BrowserBackColor <> -1 then
1257                                 UserOptionalStyle := UserOptionalStyle +
1258                                                                 'background-color:#' + IntToHex( GikoSys.Setting.BrowserBackColor, 6 ) + ';';
1259                         case GikoSys.Setting.BrowserFontBold of
1260                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-weight:normal;';
1261                                 1: UserOptionalStyle := UserOptionalStyle + 'font-weight:bold;';
1262                         end;
1263                         case GikoSys.Setting.BrowserFontItalic of
1264                                 -1: UserOptionalStyle := UserOptionalStyle + 'font-style:normal;';
1265                                 1: UserOptionalStyle := UserOptionalStyle + 'font-style:italic;';
1266                         end;
1267
1268                         CSSFileName := GetStyleSheetDir + Setting.CSSFileName;
1269                         if GikoSys.Setting.UseSkin then begin
1270                                 // \83X\83L\83\93\8eg\97p
1271                                 // \83X\83L\83\93\82Ì\90Ý\92è
1272                                 try
1273                                         SkinHeader := LoadSkin( GetSkinHeaderFileName );
1274                                         if Length( UserOptionalStyle ) > 0 then
1275                                                 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1276                                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1277                                         SaveList.Add( SkinHeader );
1278                                 except
1279                                 end;
1280                                 try
1281                                         SkinNewRes := LoadSkin( GetSkinNewResFileName );
1282                                 except
1283                                                                 end;
1284                                 try
1285                                         SkinRes := LoadSkin( GetSkinResFileName );
1286                                 except
1287                                 end;
1288
1289                                 SaveList.Add('<a name="top"></a>');
1290
1291                                 for i := 0 to ReadList.Count - 1 do begin
1292                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1293                                                 Continue;
1294                                         end;
1295                                         // \90V\92\85\83}\81[\83N
1296                                         if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
1297                                                 try
1298                                                         if FileExists( GetSkinNewmarkFileName ) then
1299                                                                 SaveList.Add( LoadSkin( GetSkinNewmarkFileName ) )
1300                                                         else
1301                                                                 SaveList.Add( '<a name="new"></a>' );
1302                                                 except
1303                                                         SaveList.Add( '<a name="new"></a>' );
1304                                                 end;
1305                                         end;
1306                                         if (Trim(ReadList[i]) <> '') then begin
1307                                                 No := IntToStr(i + 1);
1308
1309                                                 Res := DivideStrLine(ReadList[i]);
1310                                                 if Res.FType = glt2chOld then begin
1311                                                         Res.FMailTo := CustomStringReplace(Res.FMailTo, '\81\97\81M', ',');
1312                                                         Res.FName := CustomStringReplace(Res.FName, '\81\97\81M', ',');
1313                                                         Res.FBody := CustomStringReplace(Res.FBody, '\81\97\81M', ',');
1314                                                 end;
1315
1316                                                 Res.FBody := AddAnchorTag(Res.FBody);
1317                                                 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1318
1319                                                 { DivideStrLine\83\81\83\\83b\83h\93à\82Åbody\82ª
1320                                                 \81@\8bó\82É\82È\82ç\82È\82¢\82æ\82¤\82É\82µ\82Ä\82¢\82é\82Ì\82Å\95s\97v
1321                                                 if Res.FName = '' then
1322                                                         Res.FName := '&nbsp;';
1323                                                 }
1324                                                 try
1325                                                         if NewReceiveNo <= (i + 1) then
1326                                                                 // \90V\92\85\83\8c\83X
1327                                                                 SaveList.Add( ReplaceRes( SkinNewRes ) )
1328                                                         else
1329                                                                 // \92Ê\8fí\82Ì\83\8c\83X
1330                                                                 SaveList.Add( ReplaceRes( SkinRes ) );
1331                                                 except
1332                                                 end;
1333                                         end;
1334
1335                                         if ThreadItem.Kokomade = (i + 1) then begin
1336                                                 // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
1337                                                 try
1338                                                         if FileExists( GetSkinBookmarkFileName ) then
1339                                                                 SaveList.Add( LoadSkin( GetSkinBookmarkFileName ) )
1340                                                         else
1341                                                                 SaveList.Add( '<a name="koko"></a>' );
1342                                                 except
1343                                                         SaveList.Add( '<a name="koko"></a>' );
1344                                                 end;
1345                                         end;
1346 //                                      SizeByte := SizeByte + Length( SaveList.Text );
1347                                         doc.Write(SaveList.Text);
1348                                         SaveList.Clear;
1349                                 end;
1350                                 SaveList.Add('<a name="bottom"></a>');
1351 //                              SizeByte := SizeByte + Length( SaveList.Text );
1352                                 // \83X\83L\83\93(\83t\83b\83^)
1353                                 try
1354                                         SaveList.Add( LoadSkin( GetSkinFooterFileName ) );
1355                                 except
1356                                 end;
1357                                 doc.Write(SaveList.Text);
1358
1359                         end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1360                                 //CSS\8eg\97p
1361                                 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1362 //                              SaveList.Add('<html lang="ja"><head>');
1363                                 SaveList.Add('<html><head>');
1364                                 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1365                                 SaveList.Add('<title>' + sTitle + '</title>');
1366                                 SaveList.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1367                                 if Length( UserOptionalStyle ) > 0 then
1368                                         SaveList.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1369                                 SaveList.Add('</head>');
1370                                 SaveList.Add('<body>');
1371                                 SaveList.Add('<a name="top"></a>');
1372                                 SaveList.Add('<div class="title">' + sTitle + '</div>');
1373                                 doc.Write(SaveList.Text);
1374                                 SaveList.Clear;
1375                                 //Application.ProcessMessages;
1376                                 for i := 0 to ReadList.Count - 1 do begin
1377                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1378                                                 Continue;
1379                                         end;
1380                     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1381                                                 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>');
1382                                         end;
1383                                         if (Trim(ReadList[i]) <> '') then begin
1384                                                 No := IntToStr(i + 1);
1385                                                 Res := DivideStrLine(ReadList[i]);
1386                                                 Res.FBody := AddAnchorTag(Res.FBody);
1387                                                 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1388                                                 {
1389                                                 if Res.FName = '' then
1390                                                         Res.FName := '&nbsp;';
1391                         }
1392                                                 if Res.FMailTo = '' then
1393                                                         SaveList.Add('<a name="' + No + '"></a>'
1394                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1395                                                                                         + '<span class="name_label">\96¼\91O\81F</span> '
1396                                                                                         + '<span class="name"><b>' + Res.FName + '</b></span> '
1397                                                                                         + '<span class="date_label">\93\8a\8de\93ú\81F</span> '
1398                                                                                         + '<span class="date">' + Res.FDateTime+ '</span></div>'
1399                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>')
1400                                                 else if GikoSys.Setting.ShowMail then
1401                                                         SaveList.Add('<a name="' + No + '"></a>'
1402                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1403                                                                                                                                                                                 + '<span class="name_label"> \96¼\91O\81F </span>'
1404                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1405                                                                                         + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1406                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1407                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1408                                                                                         + '<div class="mes">' + Res.FBody + ' </div>')
1409                                                 else
1410                                                         SaveList.Add('<a name="' + No + '"></a>'
1411                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1412                                                                                         + '<span class="name_label"> \96¼\91O\81F </span>'
1413                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1414                                                                                         + '<b>' + Res.FName + '</b></a>'
1415                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1416                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1417                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>');
1418                                         end;
1419                                         if ThreadItem.Kokomade = (i + 1) then begin
1420                                                 SaveList.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
1421                                         end;
1422
1423                                         doc.Write(SaveList.Text);
1424                                         SaveList.Clear;
1425                                 end;
1426                                 //FOnlyAHundredRes
1427                                 SaveList.Add('<a name="bottom"></a>');
1428                                 SaveList.Add('</body></html>');
1429                                 SaveList.Add('<a name="last"></a>');
1430                                 SaveList.Add('</body></html>');
1431
1432                                 doc.Write(SaveList.Text);
1433                         end else begin
1434                                 //CSS\94ñ\8eg\97p
1435 //                              SaveList.Add('<html lang="ja"><head>');
1436                                 SaveList.Add('<html><head>');
1437                                 SaveList.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1438                                 SaveList.Add('<title>' + sTitle + '</title></head>');
1439                                 SaveList.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1440                                 SaveList.Add('<a name="top"></a>');
1441                                 SaveList.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1442                                 SaveList.Add('<dl>');
1443                                 doc.Write(SaveList.Text);
1444                                 SaveList.Clear;
1445                                 //Application.ProcessMessages;
1446                                 for i := 0 to ReadList.Count - 1 do begin
1447                                         if (OnlyAHundredRes = true) and ( i <> 0 ) and ( (ReadList.Count-i) > 101 ) then begin
1448                                                 Continue;
1449                                         end;
1450                     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1451                                                 SaveList.Add('</dl>');
1452                                                 SaveList.Add('<a name="new"></a>');
1453                                                 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>');
1454                                                 SaveList.Add('<dl>');
1455                                         end;
1456                                         if (Trim(ReadList[i]) <> '') then begin
1457                                                 No := IntToStr(i + 1);
1458                                                 Res := DivideStrLine(ReadList[i]);
1459                                                 if Res.FType = glt2chOld then begin
1460                                                         Res.FMailTo := CustomStringReplace(Res.FMailTo, '\81\97\81M', ',');
1461                                                         Res.FName := CustomStringReplace(Res.FName, '\81\97\81M', ',');
1462                                                         Res.FBody := CustomStringReplace(Res.FBody, '\81\97\81M', ',');
1463                                                 end;
1464                                                 Res.FBody := AddAnchorTag(Res.FBody);
1465                                                 Res.FBody := ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1466                                                 if Res.FMailTo = '' then
1467                                                         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>')
1468                                                 else if GikoSys.Setting.ShowMail then
1469                                                         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>')
1470                                                 else
1471                                                         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>');
1472                                         end;
1473                                         if ThreadItem.Kokomade = (i + 1) then begin
1474                                                 SaveList.Add('</dl>');
1475                                                 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>');
1476                                                 SaveList.Add('<dl>');
1477                                         end;
1478                                         doc.Write(SaveList.Text);
1479                                         SaveList.Clear;
1480                                 end;
1481                                 SaveList.Add('</dl>');
1482                                 SaveList.Add('<a name="bottom"></a>');
1483                                 SaveList.Add('</body></html>');
1484                                 doc.Write(SaveList.Text);
1485                         end;
1486                 finally
1487                         SaveList.Free;
1488                         doc.Close;
1489                 end;
1490         finally
1491                 ReadList.Free;
1492         end;
1493 end;
1494 (*************************************************************************
1495  *http://\82Ì\95¶\8e\9a\97ñ\82ðanchor\83^\83O\95t\82«\82É\82·\82é\81B
1496  *************************************************************************)
1497 function TGikoSys.AddAnchorTag(s: string): string;
1498 const
1499         URL_CHAR: string = '0123456789'
1500                                                                          + 'abcdefghijklmnopqrstuvwxyz'
1501                                                                          + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1502                                                                          + '#$%&()*+,-./:;=?@[]^_`{|}~!''\';
1503         ANCHOR_REF      = 'href=';
1504         RES_REF                 = '&gt;&gt;';
1505 var
1506         wkIdx: array[0..9] of Integer;
1507         url: string;
1508         href: string;
1509         i, b: Integer;
1510         idx: Integer;
1511         anchorLen : Integer;
1512 begin
1513         Result := '';
1514         // + 3 \82Í 'href="' ('"'\82Â\82«)\82È\82Ç\82Ì\83o\83\8a\83G\81[\83V\83\87\83\93\82É\97]\97T\82ð\8e\9d\82½\82¹\82é\82½\82ß
1515         anchorLen := Length( ANCHOR_REF ) + 3;
1516
1517         while True do begin
1518                 wkIdx[0] := AnsiPos('http://', s);
1519                 wkIdx[1] := AnsiPos('ttp://', s);
1520                 wkIdx[2] := AnsiPos('tp://', s);
1521                 wkIdx[3] := AnsiPos('ms-help://', s);
1522                 wkIdx[4] := AnsiPos('p://', s);
1523                 wkIdx[5] := AnsiPos('https://', s);
1524                 wkIdx[6] := AnsiPos('www.', s);
1525                 wkIdx[7] := AnsiPos('ftp://', s);
1526                 wkIdx[8] := AnsiPos('news://', s);
1527                 wkIdx[9] := AnsiPos('rtsp://', s);
1528
1529                 idx := MaxInt;
1530                 for i := 0 to 9 do
1531                         if wkIdx[i] <> 0 then idx := Min(wkIdx[i], idx);
1532
1533                 if idx = MaxInt then begin
1534                         //\83\8a\83\93\83N\82ª\96³\82¢\82æ\81B
1535                         Result := Result + s;
1536                         Break;
1537                 end;
1538
1539                 if (idx > 1) and
1540                         (Pos( ANCHOR_REF, Copy(s, idx - anchorLen, anchorLen ) ) > 0) then begin
1541                         //\8aù\82É\83\8a\83\93\83N\83^\83O\82ª\82Â\82¢\82Ä\82¢\82é\82Á\82Û\82¢\82Æ\82«\82Í\83\80\83V
1542                         href := Copy( s, idx, Length( s ) );
1543                         Result := Result + Copy( s, 1, idx + Pos( '</a>', href ) + Length( '</a>' ) - 2 );
1544                         s := href;
1545                         s := Copy( s, Pos( '</a>', s ) + Length( '</a>' ), Length( s ) );
1546
1547                         Continue;
1548                 end;
1549
1550                 Result := Result + Copy(s, 0, idx - 1);
1551
1552                 s := Copy(s, idx, length(s));
1553
1554                 b := Length( s ) + 1;
1555                 for i := 1 to b do begin
1556                         if i = b then
1557         idx := 0
1558       else
1559                                 idx := AnsiPos(s[i], URL_CHAR);
1560                         if idx = 0 then begin
1561                                 //URL\82¶\82á\82È\82¢\95¶\8e\9a\94\8c©\81I\82Æ\82©\81A\95¶\8e\9a\82ª\82È\82\82È\82Á\82½\81B
1562                                 url := Copy(s, 0, i - 1);
1563
1564                                 if AnsiPos('ttp://', url) = 1 then
1565                                         href := 'h' + url
1566                                 else if AnsiPos('tp://', url) = 1 then
1567                                         href := 'ht' + url
1568                                 else if AnsiPos('p://', url) = 1 then
1569                                         href := 'htt' + url
1570                                 else if AnsiPos('www.', url) = 1 then
1571                                         href := 'http://' + url
1572                                 else
1573                                         href := url;
1574                                 Result := Result + '<a href="' + href + '" target="_blank">' + url + '</a>';
1575                                 s := Copy(s, i, MaxInt);
1576                                 Break;
1577                         end;
1578                 end;
1579         end;
1580 end;
1581
1582 (*************************************************************************
1583  *\83T\83u\83W\83F\83N\83g\88ê\8ds\82ð\95ª\8a\84
1584  *************************************************************************)
1585 function TGikoSys.DivideSubject(Line: string): TSubjectRec;
1586 var
1587         i: integer;
1588         ws: WideString;
1589         Delim: string;
1590         LeftK: string;
1591         RightK: string;
1592 begin
1593         Result.FCount := 0;
1594
1595         if AnsiPos('<>', Line) = 0 then
1596                 Delim := ','
1597         else
1598                 Delim := '<>';
1599         {
1600         Result.FFileName := GetTokenIndex(Line, Delim, 0);
1601         Result.FTitle := GetTokenIndex(Line, Delim, 1);
1602         }
1603         Result.FFileName := RemoveToken(Line, Delim);
1604         Result.FTitle := RemoveToken(Line, Delim);
1605
1606         ws := Trim(Result.FTitle);
1607
1608         if Copy(ws, Length(ws), 1) = ')' then begin
1609                 LeftK := '(';
1610                 RightK := ')';
1611         end else if Copy(ws, Length(ws), 1) = '\81j' then begin
1612                 LeftK := '\81i';
1613                 RightK := '\81j';
1614         end else if Copy(ws, Length(ws), 1) = '<' then begin
1615                 LeftK := '<';
1616                 RightK := '>';
1617         end;
1618
1619         for i := Length(ws) - 1 downto 1 do begin
1620                 if ws[i] = LeftK then begin
1621                         ws := Copy(ws, i + 1, Length(ws) - i - 1);
1622                         if IsNumeric(ws) then
1623                                 Result.FCount := StrToInt(ws);
1624                         Result.FTitle := Trim(CustomStringReplace(Result.FTitle, LeftK + ws + RightK, ''));
1625                         break;
1626                 end;
1627         end;
1628 end;
1629
1630 (*************************************************************************
1631  * dat\83t\83@\83C\83\8b\82Ì\88ê\83\89\83C\83\93\82ð\95ª\89ð
1632  *************************************************************************)
1633 function TGikoSys.DivideStrLine(Line: string): TResRec;
1634 var
1635         Delim: string;
1636                 bufbody : String;
1637 begin
1638         if AnsiPos('<>', Line) = 0 then begin
1639                 Delim := ',';
1640                 Result.FType := glt2chOld;
1641         end else begin
1642                 Delim := '<>';
1643                 Result.FType := glt2chNew;
1644         end;
1645         {
1646         Result.FName := Trim(GetTokenIndex(Line, Delim, 0));
1647         Result.FMailTo := Trim(GetTokenIndex(Line, Delim, 1));
1648         Result.FDateTime := Trim(GetTokenIndex(Line, Delim, 2));
1649         bufBody := Trim(GetTokenIndex(Line, Delim, 3));
1650         }
1651         Result.FName := Trim(RemoveToken(Line, Delim));
1652         Result.FMailTo := Trim(RemoveToken(Line, Delim));
1653         Result.FDateTime := Trim(RemoveToken(Line, Delim));
1654         bufBody := Trim(RemoveToken(Line, Delim));
1655
1656         if bufbody = '' then begin
1657                 Insert('&nbsp;',bufbody, 1);
1658         end;
1659         Result.FBody := bufBody;
1660         //Result.FTitle := Trim(GetTokenIndex(Line, Delim, 4));
1661         Result.FTitle := Trim(RemoveToken(Line, Delim));
1662
1663 end;
1664
1665 (*************************************************************************
1666  * URL\82©\82çBBSID\82ð\8eæ\93¾
1667  *************************************************************************)
1668 function TGikoSys.UrlToID(url: string): string;
1669 var
1670         i: integer;
1671 begin
1672         Result := '';
1673         url := Trim(url);
1674
1675         if url = '' then Exit;
1676
1677         url := Copy(url, 0, Length(url) - 1);
1678         for i := Length(url) downto 0 do begin
1679                 if url[i] = '/' then begin
1680                         Result := Copy(url, i + 1, Length(url));
1681                         Break;
1682                 end;
1683         end;
1684 end;
1685
1686 (*************************************************************************
1687  *URL\82©\82çBBSID\88È\8aO\82Ì\95\94\95ª(http://teri.2ch.net/)\82ð\8eæ\93¾
1688  *************************************************************************)
1689 function TGikoSys.UrlToServer(url: string): string;
1690 var
1691         i: integer;
1692         wsURL: WideString;
1693 begin
1694         Result := '';
1695         wsURL := url;
1696         wsURL := Trim(wsURL);
1697
1698         if wsURL = '' then exit;
1699
1700         if Copy(wsURL, Length(wsURL), 1) = '/' then
1701                 wsURL := Copy(wsURL, 0, Length(wsURL) - 1);
1702
1703         for i := Length(wsURL) downto 0 do begin
1704                 if wsURL[i] = '/' then begin
1705                         Result := Copy(wsURL, 0, i);
1706                         break;
1707                 end;
1708         end;
1709 end;
1710
1711 (*************************************************************************
1712  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
1713  *************************************************************************)
1714 function TGikoSys.DirectoryExistsEx(const Name: string): Boolean;
1715 var
1716         Code: Integer;
1717 begin
1718         Code := GetFileAttributes(PChar(Name));
1719         Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
1720 end;
1721
1722 (*************************************************************************
1723  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
1724  *************************************************************************)
1725 function TGikoSys.ForceDirectoriesEx(Dir: string): Boolean;
1726 begin
1727         Result := True;
1728         if Length(Dir) = 0 then
1729                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
1730         Dir := ExcludeTrailingPathDelimiter(Dir);
1731         if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
1732                 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
1733         Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
1734 end;
1735
1736 (*************************************************************************
1737  *\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
1738  *FDelphi\82©\82ç\82Ì\83p\83N\83\8a
1739  *************************************************************************)
1740 function TGikoSys.StrTokFirst(const s:string; const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1741 begin
1742         Rec.Str := s;
1743         Rec.Pos := 1;
1744         Result := StrTokNext(sep, Rec);
1745 end;
1746
1747 (*************************************************************************
1748  *\95¶\8e\9a\97ñ\82©\82ç\83g\81[\83N\83\93\82Ì\90Ø\82è\8fo\82µ
1749  *FDelphi\82©\82ç\82Ì\83p\83N\83\8a
1750  *************************************************************************)
1751 function TGikoSys.StrTokNext(const sep: TStrTokSeparator; var Rec: TStrTokRec): string;
1752 var
1753         Len, I: Integer;
1754 begin
1755         with Rec do     begin
1756                 Len := Length(Str);
1757                 Result := '';
1758                 if Len >= Pos then begin
1759                         while (Pos <= Len) and (Str[Pos] in sep) do begin
1760                          Inc(Pos);
1761                         end;
1762                         I := Pos;
1763                         while (Pos<= Len) and not (Str[Pos] in sep) do begin
1764                                 if IsDBCSLeadByte(Byte(Str[Pos])) then begin
1765                                         Inc(Pos);
1766                                 end;
1767                                 Inc(Pos);
1768                         end;
1769                         Result := Copy(Str, I, Pos - I);
1770                         while (Pos <= Len) and (Str[Pos] in sep) do begin// \82±\82ê\82Í\82¨\8dD\82Ý
1771                                 Inc(Pos);
1772                         end;
1773                 end;
1774         end;
1775 end;
1776
1777 (*************************************************************************
1778  *\83t\83@\83C\83\8b\83T\83C\83Y\8eæ\93¾
1779  *************************************************************************)
1780 function TGikoSys.GetFileSize(FileName : string): longint;
1781 var
1782         F : File;
1783 begin
1784         try
1785                 if not FileExists(FileName) then begin
1786                         Result := 0;
1787                         Exit;
1788                 end;
1789                 Assign(F, FileName);
1790                 Reset(F, 1);
1791                 Result := FileSize(F);
1792                 CloseFile(F);
1793         except
1794                 Result := 0;
1795         end;
1796 end;
1797
1798 (*************************************************************************
1799  *\83t\83@\83C\83\8b\8ds\90\94\8eæ\93¾
1800  *************************************************************************)
1801 function TGikoSys.GetFileLineCount(FileName : string): longint;
1802 var
1803         sl: TStringList;
1804 begin
1805         sl := TStringList.Create;
1806         try
1807                 try
1808                         sl.LoadFromFile(FileName);
1809                         Result := sl.Count;
1810                 except
1811                         Result := 0;
1812                 end;
1813         finally
1814                 sl.Free;
1815         end;
1816
1817 end;
1818
1819 (*************************************************************************
1820  *\83X\83\8c\83b\83h\83t\83@\83C\83\8b\82©\82ç\8ew\92è\8ds\82ð\8eæ\93¾
1821  *************************************************************************)
1822 function TGikoSys.ReadThreadFile(FileName: string; Line: Integer): string;
1823 var
1824         fileTmp : TStringList;
1825 begin
1826         Result := '';
1827         if FileExists(FileName) then begin
1828                 fileTmp := TStringList.Create;
1829                 try
1830                         try
1831                                 fileTmp.LoadFromFile( FileName );
1832                                 if ( Line       >= 1 ) and ( Line       < fileTmp.Count + 1 ) then begin
1833                                         Result := fileTmp.Strings[ Line-1 ];
1834                                 end;
1835                         except
1836                                 //on EFOpenError do Result := '';
1837                         end;
1838                 finally
1839                         fileTmp.Free;
1840                 end;
1841         end;
1842 end;
1843
1844 (*************************************************************************
1845  *\83V\83X\83e\83\80\83\81\83j\83\85\81[\83t\83H\83\93\83g\82Ì\91®\90«\82ð\8eæ\93¾
1846  *************************************************************************)
1847 procedure TGikoSys.MenuFont(Font: TFont);
1848 var
1849         lf: LOGFONT;
1850         nm: NONCLIENTMETRICS;
1851 begin
1852         nm.cbSize := sizeof(NONCLIENTMETRICS);
1853
1854         SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @nm, 0);
1855         lf := nm.lfMenuFont;
1856
1857         Font.Name := lf.lfFaceName;
1858         Font.Height := lf.lfHeight;
1859         Font.Style := [];
1860         if lf.lfWeight >= 700 then
1861                 Font.Style := Font.Style + [fsBold];
1862         if lf.lfItalic = 1 then
1863                 Font.Style := Font.Style + [fsItalic];
1864 end;
1865
1866 (*************************************************************************
1867  *
1868  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
1869  *************************************************************************)
1870 function TGikoSys.RemoveToken(var s: string;const delimiter: string): string;
1871 var
1872         p: Integer;
1873 begin
1874         p := AnsiPos(delimiter, s);
1875         if p = 0 then
1876                 Result := s
1877         else
1878                 Result := Copy(s, 1, p - 1);
1879         s := Copy(s, Length(Result) + Length(delimiter) + 1, Length(s));
1880 end;
1881
1882 (*************************************************************************
1883  *
1884  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
1885  *************************************************************************)
1886 function TGikoSys.GetTokenIndex(s: string; delimiter: string; index: Integer): string;
1887 var
1888         i: Integer;
1889 begin
1890         Result := '';
1891         for i := 0 to index do
1892                 Result := RemoveToken(s, delimiter);
1893 end;
1894
1895 (*************************************************************************
1896  *
1897  *************************************************************************)
1898 function TGikoSys.DeleteLink(const s: string): string;
1899 var
1900         s1: string;
1901         s2: string;
1902         idx: Integer;
1903         i: Integer;
1904 begin
1905         i := 0;
1906         Result := '';
1907         while True do begin
1908                 s1 := GetTokenIndex(s, '<a href="', i);
1909                 s2 := GetTokenIndex(s, '<a href="', i + 1);
1910
1911                 idx := Pos('">', s1);
1912                 if idx <> 0 then
1913                         Delete(s1, 1, idx + 1);
1914                 idx := Pos('">', s2);
1915                 if idx <> 0 then
1916                         Delete(s2, 1, idx + 1);
1917
1918                 Result := Result + s1 + s2;
1919
1920                 if s2 = '' then
1921                         Break;
1922
1923                 inc(i, 2);
1924         end;
1925 end;
1926
1927 //\83C\83\93\83f\83b\83N\83X\96¢\8dX\90V\83o\83b\83t\83@\82ð\83t\83\89\83b\83V\83\85\81I
1928 {procedure TGikoSys.FlashExitWrite;
1929 var
1930         i: Integer;
1931 begin
1932         //\83X\83\8c\83b\83h\83f\81[\83^\83t\83@\83C\83\8b\82ð\8dX\90V
1933         for i := 0 to FExitWrite.Count - 1 do
1934                 WriteThreadDat(FExitWrite[i]);
1935         FExitWrite.Clear;
1936 end;}
1937
1938 (*************************************************************************
1939  *\83X\83\8c\96¼\82È\82Ç\82ð\92Z\82¢\96¼\91O\82É\95Ï\8a·\82·\82é
1940  *from HotZonu
1941  *************************************************************************)
1942 function TGikoSys.GetShortName(const LongName: string; ALength: integer): string;
1943 const
1944         ERASECHAR : array [1..39] of string =
1945                 ('\81\99','\81\9a','\81¡','\81 ','\81\9f','\81\9e','\81Q','\81\94','\81£','\81¥',
1946                  '\81¢','\81¤','\81\9c','\81\9b','\81\9d','\81y','\81z','\81ô','\81s','\81t',
1947                  '\81g','\81h','\81k','\81l','\81e','\81f','\81\83','\81\84','\81á','\81â',
1948                  '\81o','\81p','\81q','\81r','\81w','\81x','\81¬','\81c', '\81@');
1949 var
1950         Chr : array [0..255]    of      char;
1951         S : string;
1952         i : integer;
1953 begin
1954         s := Trim(LongName);
1955         if (Length(s) <= ALength) then begin
1956                 Result := s;
1957         end else begin
1958                 S := s;
1959                 for i := Low(ERASECHAR) to      High(ERASECHAR) do      begin
1960                         S := CustomStringReplace(S, ERASECHAR[i], '');
1961                 end;
1962                 if (Length(S) <= ALength) then begin
1963                         Result := S;
1964                 end else begin
1965                         Windows.LCMapString(
1966                                         GetUserDefaultLCID(),
1967                                         LCMAP_HALFWIDTH,
1968                                         PChar(S),
1969                                         Length(S) + 1,
1970                                         chr,
1971                                         Sizeof(chr)
1972                                         );
1973                         S := Chr;
1974                         S := Copy(S,1,ALength);
1975                         while true do begin
1976                                 if (ByteType(S, Length(S)) = mbLeadByte ) then begin
1977                                         S := Copy(S, 1, Length(S) - 1);
1978                                 end else begin
1979                                         Break;
1980                                 end;
1981                         end;
1982                         Result := S;
1983                 end;
1984         end;
1985 end;
1986
1987 (*************************************************************************
1988  *
1989  * from HotZonu
1990  *************************************************************************)
1991 function TGikoSys.ConvRes(const Body, Bbs, Key,
1992         ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string): string;
1993 type
1994         PIndex = ^TIndex;
1995         TIndex = record
1996                 FIndexFrom      : integer;
1997                 FIndexTo                : integer;
1998                 FNo                              : string;
1999         end;
2000 const
2001         GT      = '&gt;';
2002         SN      = '0123456789-';
2003         ZN      = '\82O\82P\82Q\82R\82S\82T\82U\82V\82W\82X\81|';
2004 var
2005         i : integer;
2006         s,r : string;
2007         b : TMbcsByteType;
2008         sw: boolean;
2009         sp: integer;
2010         No: string;
2011         sx: string;
2012         List: TList;
2013         oc      : string;
2014         st, et: string;
2015         chk : boolean;
2016         al : boolean;
2017         procedure Add(IndexFrom, IndexTo: integer; const No: string);
2018         var
2019                 FIndex : PIndex;
2020         begin
2021                 New(FIndex);
2022                 FIndex.FIndexFrom       := IndexFrom;
2023                 FIndex.FIndexTo         := IndexTo;
2024                 FIndex.FNo                               := No;
2025                 List.Add(FIndex);
2026         end;
2027         function ChooseString(const Text, Separator: string; Index: integer): string;
2028         var
2029                 S : string;
2030                 i, p : integer;
2031         begin
2032                 S :=    Text;
2033                 for i :=        0 to    Index - 1 do    begin
2034                         if      (AnsiPos(Separator, S) = 0) then        S :=    ''
2035                         else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
2036                 end;
2037                 p :=    AnsiPos(Separator, S);
2038                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;
2039         end;
2040 begin
2041         { v1.0 b2 - 03 }
2042         s        :=     Body;
2043         r        :=     Body;
2044         i        :=     1;
2045         sw      :=      False;
2046         No      :=      '';
2047         List:=  TList.Create;
2048         oc      :=      '';
2049         sp      :=      0;
2050         chk :=  False;
2051         al      :=      False;
2052         while true      do      begin
2053                 b :=    ByteType(s, i);
2054                 case    b of
2055                         mbSingleByte    : begin
2056                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2057                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2058                                                 sw      :=      True;
2059                                                 sp      :=      i;
2060                                                 i :=    i + 7;
2061                                                 oc:='';
2062                                                 chk :=  True;
2063                                         end;
2064                                 end else
2065                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2066                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin
2067                                                 i :=    i + 7;
2068                                                 oc:='';
2069                                                 chk :=  True;
2070                                         end;
2071                                 end else
2072                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin
2073                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2074                                                 sw      :=      True;
2075                                                 sp      :=      i;
2076                                                 i :=    i + 3;
2077                                                 oc:='';
2078                                                 chk :=  True;
2079                                         end;
2080                                 end else
2081                                 if      ((not sw) and (Copy(s,i,1) = ',')) or
2082                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin
2083                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
2084                                                         ((Chk) and      (oc = '')) or
2085                                                         ((not Chk) and (al)) then
2086                                         begin
2087                                                 sw      :=      True;
2088                                                 sp      :=      i;
2089                                                 //i :=  i + 1;
2090                                                 oc:='';
2091                                         end;
2092                                 end else
2093                                 if      (sw) then begin
2094                                         sx      :=      Copy(s,i,1);
2095                                         if      (AnsiPos(sx, SN) > 0)   then    begin
2096                                                 No      :=      No      + sx;
2097                                         end else begin
2098                                                 if      (No <> '') and (No <> '-')       then   begin
2099                                                         Add(sp, i, No);
2100                                                         al := True;
2101                                                 end;
2102                                                 sw      :=      False;
2103                                                 //
2104                                                 i := i - 1;
2105                                                 //
2106                                                 No      := '';
2107                                                 oc:='';
2108                                                 //chk :=        False;
2109                                         end;
2110                                 end else begin
2111                                         if      Copy(s,i,1) = '<' then  oc      :=      '';
2112                                         oc      :=      oc + Copy(s,i,1);
2113                                         chk :=  False;
2114                                         al      :=      False;
2115                                 end;
2116                         end;
2117                         mbLeadByte      : begin
2118                                 if      (not sw) and (Copy(s,i,4) = '\81\84\81\84') then        begin
2119                                         sw      :=      True;
2120                                         sp      :=      i;
2121                                         i :=    i + 3;
2122                                         chk :=  True;
2123                                 end else
2124                                 if      (not sw) and (Copy(s,i,2) = '\81\84') then  begin
2125                                         sw      :=      True;
2126                                         sp      :=      i;
2127                                         i :=    i + 1;
2128                                         chk :=  True;
2129                                 end else
2130                                 if      (sw) then begin
2131                                         sx      :=      Copy(s,i,2);
2132                                         if      (AnsiPos(sx, ZN) > 0)   then    begin
2133                                                 No      :=      No      + ZenToHan(sx);
2134                                         end else begin
2135                                                 if      (No <> '') and (No <> '-')      and (No <> '\81|') then   begin
2136                                                         Add(sp, i, No);
2137                                                 end;
2138                                                 sw      :=      False;
2139                                                 i := i - 1;
2140                                                 No      :=      '';
2141                                         end;
2142                                 end else begin
2143                                         oc      :=      '';
2144                                         chk :=  False;
2145                                 end;
2146                                 al      :=      False;
2147                         end;
2148                 end;
2149                 inc(i);
2150                 if      (i > Length(Body))      then    begin
2151                         if      (sw)    then    begin
2152                                 if      (No <> '')      then    Add(sp, i, No);
2153                         end;
2154                         Break;
2155                 end;
2156         end;
2157         for i :=        List.Count - 1  downto  0 do    begin
2158                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin
2159                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);
2160                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);
2161                 end else begin
2162                         st      :=      PIndex(List[i]).FNo;
2163                         et      :=      PIndex(List[i]).FNo;
2164                 end;
2165                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
2166                                         Format('<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">',
2167                                                                 [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
2168                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
2169                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));
2170                 Dispose(PIndex(List[i]));
2171         end;
2172         List.Free;
2173         Result  :=      r;
2174 end;
2175
2176 function TGikoSys.ConvRes(
2177         const Body, Bbs, Key, ParamBBS, ParamKey,
2178     ParamStart, ParamTo, ParamNoFirst,
2179     ParamTrue, FullURL : string
2180 ): string;
2181 type
2182         PIndex = ^TIndex;
2183         TIndex = record
2184                 FIndexFrom      : integer;
2185                 FIndexTo                : integer;
2186                 FNo                              : string;
2187         end;
2188 const
2189         GT      = '&gt;';
2190         SN      = '0123456789-';
2191         ZN      = '\82O\82P\82Q\82R\82S\82T\82U\82V\82W\82X\81|';
2192 var
2193         i : integer;
2194         s,r : string;
2195         b : TMbcsByteType;
2196         sw: boolean;
2197         sp: integer;
2198         No: string;
2199         sx: string;
2200         List: TList;
2201         oc      : string;
2202         st, et: string;
2203         chk : boolean;
2204         al : boolean;
2205         procedure Add(IndexFrom, IndexTo: integer; const No: string);
2206         var
2207                 FIndex : PIndex;
2208         begin
2209                 New(FIndex);
2210                 FIndex.FIndexFrom       := IndexFrom;
2211                 FIndex.FIndexTo         := IndexTo;
2212                 FIndex.FNo                               := No;
2213                 List.Add(FIndex);
2214         end;
2215         function ChooseString(const Text, Separator: string; Index: integer): string;
2216         var
2217                 S : string;
2218                 i, p : integer;
2219         begin
2220                 S :=    Text;
2221                 for i :=        0 to    Index - 1 do    begin
2222                         if      (AnsiPos(Separator, S) = 0) then        S :=    ''
2223                         else    S :=    Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
2224                 end;
2225                 p :=    AnsiPos(Separator, S);
2226                 if      (p > 0) then    Result  :=      Copy(S, 1, p - 1) else Result :=        S;
2227         end;
2228 begin
2229         { v1.0 b2 - 03 }
2230         s        :=     Body;
2231         r        :=     Body;
2232         i        :=     1;
2233         sw      :=      False;
2234         No      :=      '';
2235         List:=  TList.Create;
2236         oc      :=      '';
2237         sp      :=      0;
2238         chk :=  False;
2239         al      :=      False;
2240         while true      do      begin
2241                 b :=    ByteType(s, i);
2242                 case    b of
2243                         mbSingleByte    : begin
2244                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2245                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2246                                                 sw      :=      True;
2247                                                 sp      :=      i;
2248                                                 i :=    i + 7;
2249                                                 oc:='';
2250                                                 chk :=  True;
2251                                         end;
2252                                 end else
2253                                 if      (not sw) and (Copy(s,i,8) = GT + GT) then       begin
2254                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 1) then        begin
2255                                                 i :=    i + 7;
2256                                                 oc:='';
2257                                                 chk :=  True;
2258                                         end;
2259                                 end else
2260                                 if      (not sw) and (Copy(s,i,4) = GT) then    begin
2261                                         if      (AnsiPos('<A HREF', AnsiUpperCase(oc)) = 0) then        begin
2262                                                 sw      :=      True;
2263                                                 sp      :=      i;
2264                                                 i :=    i + 3;
2265                                                 oc:='';
2266                                                 chk :=  True;
2267                                         end;
2268                                 end else
2269                                 if      ((not sw) and (Copy(s,i,1) = ',')) or
2270                                                 ((not sw) and (Copy(s,i,1) = '=')) then begin
2271                                         if      ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
2272                                                         ((Chk) and      (oc = '')) or
2273                                                         ((not Chk) and (al)) then
2274                                         begin
2275                                                 sw      :=      True;
2276                                                 sp      :=      i;
2277                                                 //i :=  i + 1;
2278                                                 oc:='';
2279                                         end;
2280                                 end else
2281                                 if      (sw) then begin
2282                                         sx      :=      Copy(s,i,1);
2283                                         if      (AnsiPos(sx, SN) > 0)   then    begin
2284                                                 No      :=      No      + sx;
2285                                         end else begin
2286                                                 if      (No <> '') and (No <> '-')       then   begin
2287                                                         Add(sp, i, No);
2288                                                         al := True;
2289                                                 end;
2290                                                 sw      :=      False;
2291                                                 //
2292                                                 i := i - 1;
2293                                                 //
2294                                                 No      := '';
2295                                                 oc:='';
2296                                                 //chk :=        False;
2297                                         end;
2298                                 end else begin
2299                                         if      Copy(s,i,1) = '<' then  oc      :=      '';
2300                                         oc      :=      oc + Copy(s,i,1);
2301                                         chk :=  False;
2302                                         al      :=      False;
2303                                 end;
2304                         end;
2305                         mbLeadByte      : begin
2306                                 if      (not sw) and (Copy(s,i,4) = '\81\84\81\84') then        begin
2307                                         sw      :=      True;
2308                                         sp      :=      i;
2309                                         i :=    i + 3;
2310                                         chk :=  True;
2311                                 end else
2312                                 if      (not sw) and (Copy(s,i,2) = '\81\84') then  begin
2313                                         sw      :=      True;
2314                                         sp      :=      i;
2315                                         i :=    i + 1;
2316                                         chk :=  True;
2317                                 end else
2318                                 if      (sw) then begin
2319                                         sx      :=      Copy(s,i,2);
2320                                         if      (AnsiPos(sx, ZN) > 0)   then    begin
2321                                                 No      :=      No      + ZenToHan(sx);
2322                                         end else begin
2323                                                 if      (No <> '') and (No <> '-')      and (No <> '\81|') then   begin
2324                                                         Add(sp, i, No);
2325                                                 end;
2326                                                 sw      :=      False;
2327                                                 i := i - 1;
2328                                                 No      :=      '';
2329                                         end;
2330                                 end else begin
2331                                         oc      :=      '';
2332                                         chk :=  False;
2333                                 end;
2334                                 al      :=      False;
2335                         end;
2336                 end;
2337                 inc(i);
2338                 if      (i > Length(Body))      then    begin
2339                         if      (sw)    then    begin
2340                                 if      (No <> '')      then    Add(sp, i, No);
2341                         end;
2342                         Break;
2343                 end;
2344         end;
2345         for i :=        List.Count - 1  downto  0 do    begin
2346         //plName := Copy(PluginName, LastDelimiter('\',PluginName) + 1, Length(PluginName) - LastDelimiter('/',PluginName) -1 );
2347                 if      (AnsiPos('-', PIndex(List[i]).FNo) > 0) then    begin
2348                         st      :=      ChooseString(PIndex(List[i]).FNo, '-', 0);
2349                         et      :=      ChooseString(PIndex(List[i]).FNo, '-', 1);
2350                 end else begin
2351                         st      :=      PIndex(List[i]).FNo;
2352                         et      :=      PIndex(List[i]).FNo;
2353                 end;
2354                 r :=    Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
2355                                         Format('<a href="%s&%s=%s&%s=%s&%s=%s" target="_blank">',
2356                                                                 [FullURL, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
2357                                         Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
2358                                         Copy(r,PIndex(List[i]).FIndexTo,Length(r));
2359                 Dispose(PIndex(List[i]));
2360         end;
2361         List.Free;
2362         Result  :=      r;
2363 end;
2364
2365 (*************************************************************************
2366  * \91S\8ap\81¨\94¼\8ap
2367  * from HotZonu
2368  *************************************************************************)
2369 function TGikoSys.ZenToHan(const s: string): string;
2370 var
2371         Chr: array [0..255] of char;
2372 begin
2373         Windows.LCMapString(
2374                  GetUserDefaultLCID(),
2375 //               LCMAP_HALFWIDTH,
2376                  LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
2377                  PChar(s),
2378                  Length(s) + 1,
2379                  chr,
2380                  Sizeof(chr)
2381                  );
2382         Result := Chr;
2383 end;
2384
2385 (*************************************************************************
2386  * \91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\82©\82½\82©\82È\82ð\8bæ\95Ê\82µ\82È\82¢\90¦\82¢Pos
2387  *************************************************************************)
2388 function TGikoSys.VaguePos(const Substr, S: string): Integer;
2389 begin
2390         Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
2391 end;
2392
2393 function TGikoSys.BoolToInt(b: Boolean): Integer;
2394 begin
2395         Result := IfThen(b, 1, 0);
2396 end;
2397
2398 function TGikoSys.IntToBool(i: Integer): Boolean;
2399 begin
2400         Result := i = 1;
2401 end;
2402
2403 //gzip\82Å\88³\8fk\82³\82ê\82½\82Ì\82ð\96ß\82·
2404 function TGikoSys.GzipDecompress(ResStream: TStream; ContentEncoding: string): string;
2405 const
2406         BUF_SIZE = 4096;
2407 var
2408         GZipStream: TGzipDecompressStream;
2409         TextStream: TStringStream;
2410         buf: array[0..BUF_SIZE - 1] of Byte;
2411         cnt: Integer;
2412         s: string;
2413         i: Integer;
2414 begin
2415         Result := '';
2416         TextStream := TStringStream.Create('');
2417         try
2418 //\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¢)
2419 //              if LowerCase(Trim(ContentEncoding)) = 'gzip' then begin
2420                 if AnsiPos('gzip', LowerCase(Trim(ContentEncoding))) > 0 then begin
2421                         ResStream.Position := 0;
2422                         GZipStream := TGzipDecompressStream.Create(TextStream);
2423                         try
2424                                 repeat
2425                                         FillChar(buf, BUF_SIZE, 0);
2426                                         cnt := ResStream.Read(buf, BUF_SIZE);
2427                                         if cnt > 0 then
2428                                                 GZipStream.Write(buf, BUF_SIZE);
2429                                 until cnt = 0;
2430                         finally
2431                                 GZipStream.Free;
2432                         end;
2433                 end else begin
2434                         ResStream.Position := 0;
2435                         repeat
2436                                 FillChar(buf, BUF_SIZE, 0);
2437                                 cnt := ResStream.Read(buf, BUF_SIZE);
2438                                 if cnt > 0 then
2439                                         TextStream.Write(buf, BUF_SIZE);
2440                         until cnt = 0;
2441                 end;
2442
2443                 //NULL\95¶\8e\9a\82ð"*"\82É\82·\82é
2444                 s := TextStream.DataString;
2445                 i := Length(s);
2446                 while (i > 0) and (s[i] = #0) do
2447                         Dec(i);
2448                 s := Copy(s, 1, i);
2449
2450                 i := Pos(#0, s);
2451                 while i <> 0 do begin
2452                         s[i] := '*';
2453                         i := Pos(#0, s);
2454                 end;
2455                 Result := s;
2456         finally
2457                 TextStream.Free;
2458         end;
2459 end;
2460
2461 procedure TGikoSys.LoadKeySetting(ActionList: TActionList);
2462 const
2463         STD_SEC = 'KeySetting';
2464 var
2465         i: Integer;
2466         ini: TMemIniFile;
2467         ActionName: string;
2468         ActionKey: Integer;
2469         SecList: TStringList;
2470         Component: TComponent;
2471 begin
2472         if not FileExists(GetConfigDir + KEY_SETTING_FILE_NAME) then
2473                 Exit;
2474         SecList := TStringList.Create;
2475         ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2476         try
2477                 ini.ReadSection(STD_SEC, SecList);
2478                 for i := 0 to SecList.Count - 1 do begin
2479                         ActionName := SecList[i];
2480                         ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
2481                         if ActionKey <> -1 then begin
2482                                 Component := ActionList.Owner.FindComponent(ActionName);
2483                                 if TObject(Component) is TAction then begin
2484                                         TAction(Component).ShortCut := ActionKey;
2485                                 end;
2486                         end;
2487                 end;
2488         finally
2489                 ini.Free;
2490                 SecList.Free;
2491         end;
2492 end;
2493
2494 procedure TGikoSys.SaveKeySetting(ActionList: TActionList);
2495 const
2496         STD_SEC = 'KeySetting';
2497 var
2498         i: Integer;
2499         ini: TMemIniFile;
2500 begin
2501         ini := TMemIniFile.Create(GetConfigDir + KEY_SETTING_FILE_NAME);
2502         try
2503                 for i := 0 to ActionList.ActionCount - 1 do begin
2504                         if ActionList.Actions[i].Tag = -1 then
2505                                 Continue;
2506                         ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
2507                 end;
2508                 ini.UpdateFile;
2509         finally
2510                 ini.Free;
2511         end;
2512 end;
2513
2514 procedure TGikoSys.LoadEditorKeySetting(ActionList: TActionList);
2515 const
2516         STD_SEC = 'KeySetting';
2517 var
2518         i: Integer;
2519         ini: TMemIniFile;
2520         ActionName: string;
2521         ActionKey: Integer;
2522         SecList: TStringList;
2523         Component: TComponent;
2524 begin
2525         if not FileExists(GetConfigDir + EKEY_SETTING_FILE_NAME) then
2526                 Exit;
2527         SecList := TStringList.Create;
2528         ini := TMemIniFile.Create(GetConfigDir + EKEY_SETTING_FILE_NAME);
2529         try
2530                 ini.ReadSection(STD_SEC, SecList);
2531                 for i := 0 to SecList.Count - 1 do begin
2532                         ActionName := SecList[i];
2533                         ActionKey := ini.ReadInteger(STD_SEC, ActionName, -1);
2534                         if ActionKey <> -1 then begin
2535                                 Component := ActionList.Owner.FindComponent(ActionName);
2536                                 if TObject(Component) is TAction then begin
2537                                         TAction(Component).ShortCut := ActionKey;
2538                                 end;
2539                         end;
2540                 end;
2541         finally
2542                 ini.Free;
2543                 SecList.Free;
2544         end;
2545 end;
2546
2547 procedure TGikoSys.SaveEditorKeySetting(ActionList: TActionList);
2548 const
2549         STD_SEC = 'KeySetting';
2550 var
2551         i: Integer;
2552         ini: TMemIniFile;
2553 begin
2554         ini := TMemIniFile.Create(GetConfigDir + EKEY_SETTING_FILE_NAME);
2555         try
2556                 for i := 0 to ActionList.ActionCount - 1 do begin
2557                         if ActionList.Actions[i].Tag = -1 then
2558                                 Continue;
2559                         ini.WriteInteger(STD_SEC, ActionList.Actions[i].Name, TAction(ActionList.Actions[i]).ShortCut);
2560                 end;
2561                 ini.UpdateFile;
2562         finally
2563                 ini.Free;
2564         end;
2565 end;
2566
2567 //
2568 procedure TGikoSys.CreateProcess(const AppPath: string; const Param: string);
2569 var
2570         PI: TProcessInformation;
2571         SI: TStartupInfo;
2572         Path: string;
2573 begin
2574         Path := '"' + AppPath + '"';
2575         if Param <> '' then
2576                 Path := Path + ' ' + Param;
2577
2578         SI.Cb := SizeOf(Si);
2579         SI.lpReserved   := nil;
2580         SI.lpDesktop     := nil;
2581         SI.lpTitle               := nil;
2582         SI.dwFlags               := 0;
2583         SI.cbReserved2 := 0;
2584         SI.lpReserved2 := nil;
2585         SI.dwysize               := 0;
2586         Windows.CreateProcess(nil,
2587                                                                 PChar(Path),
2588                                                                 nil,
2589                                                                 nil,
2590                                                                 False,
2591                                                                 0,
2592                                                                 nil,
2593                                                                 nil,
2594                                                                 SI,
2595                                                                 PI);
2596 end;
2597
2598 procedure TGikoSys.OpenBrowser(URL: string; BrowserType: TGikoBrowserType);
2599 begin
2600         case BrowserType of
2601                 gbtIE:
2602                         HlinkNavigateString(nil, PWideChar(WideString(URL)));
2603                 gbtUserApp, gbtAuto:
2604                         if (Setting.URLApp) and (FileExists(Setting.URLAppFile)) then
2605                                 GikoSys.CreateProcess(Setting.URLAppFile, URL)
2606                         else
2607                                 HlinkNavigateString(nil, PWideChar(WideString(URL)));
2608         end;
2609 end;
2610
2611 function TGikoSys.HTMLDecode(const AStr: String): String;
2612 var
2613         Sp, Rp, Cp, Tp: PChar;
2614         S: String;
2615         I, Code: Integer;
2616         Num: Boolean;
2617 begin
2618         SetLength(Result, Length(AStr));
2619         Sp := PChar(AStr);
2620         Rp := PChar(Result);
2621         //Cp := Sp;
2622         try
2623                 while Sp^ <> #0 do begin
2624                         case Sp^ of
2625                                 '&': begin
2626                                                          //Cp := Sp;
2627                                                          Inc(Sp);
2628                                                          case Sp^ of
2629                                                                  'a': if AnsiStrPos(Sp, 'amp;') = Sp then
2630                                                                                         begin
2631                                                                                                 Inc(Sp, 3);
2632                                                                                                 Rp^ := '&';
2633                                                                                         end;
2634                                                                  'l',
2635                                                                  'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then
2636                                                                                         begin
2637                                                                                                 Cp := Sp;
2638                                                                                                 Inc(Sp, 2);
2639                                                                                                 while (Sp^ <> ';') and (Sp^ <> #0) do
2640                                                                                                         Inc(Sp);
2641                                                                                                 if Cp^ = 'l' then
2642                                                                                                         Rp^ := '<'
2643                                                                                                 else
2644                                                                                                         Rp^ := '>';
2645                                                                                         end;
2646                                                                  'q': if AnsiStrPos(Sp, 'quot;') = Sp then
2647                                                                                         begin
2648                                                                                                 Inc(Sp,4);
2649                                                                                                 Rp^ := '"';
2650                                                                                         end;
2651                                                                  '#': begin
2652                                                                                                 Tp := Sp;
2653                                                                                                 Inc(Tp);
2654                                                                                                 Num := IsNumeric(Copy(Tp, 1, 1));
2655                                                                                                 while (Sp^ <> ';') and (Sp^ <> #0) do begin
2656                                                                                                         if (Num) and (not IsNumeric(Copy(Sp, 1, 1))) then
2657                                                                                                                 Break;
2658                                                                                                         Inc(Sp);
2659                                                                                                 end;
2660                                                                                                 SetString(S, Tp, Sp - Tp);
2661                                                                                                 Val(S, I, Code);
2662                                                                                                 Rp^ := Chr((I));
2663                                                                                         end;
2664                                                          //      else
2665                                                                          //raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2666                                                                                  //[Cp^ + Sp^, Cp - PChar(AStr)])
2667                                                          end;
2668                                          end
2669                         else
2670                                 Rp^ := Sp^;
2671                         end;
2672                         Inc(Rp);
2673                         Inc(Sp);
2674                 end;
2675         except
2676 //              on E:EConvertError do
2677 //                      raise EConvertError.CreateFmt(sInvalidHTMLEncodedChar,
2678 //                              [Cp^ + Sp^, Cp - PChar(AStr)])
2679         end;
2680         SetLength(Result, Rp - PChar(Result));
2681 end;
2682
2683 function TGikoSys.GetHRefText(s: string): string;
2684 var
2685         Index: Integer;
2686         Index2: Integer;
2687 begin
2688         Result := '';
2689         s := Trim(s);
2690         if s = '' then
2691                 Exit;
2692
2693         Index := AnsiPos('href', LowerCase(s));
2694         if Index = 0 then
2695                 Exit;
2696         s := Trim(Copy(s, Index + 4, Length(s)));
2697         s := Trim(Copy(s, 2, Length(s)));
2698
2699         //\8en\82ß\82Ì\95¶\8e\9a\82ª'"'\82È\82ç\8eæ\82è\8f\9c\82
2700         //if Copy(s, 1, 1) = '"' then begin
2701     if s[1]  = '"' then begin
2702                 s := Trim(Copy(s, 2, Length(s)));
2703         end;
2704
2705         Index := AnsiPos('"', s);
2706         if Index <> 0 then begin
2707                 //'"'\82Ü\82ÅURL\82Æ\82·\82é
2708                 s := Copy(s, 1, Index - 1);
2709         end else begin
2710                 //'"'\82ª\96³\82¯\82ê\82Î\83X\83y\81[\83X\82©">"\82Ì\91\81\82¢\95û\82Ü\82Å\82ðURL\82Æ\82·\82é
2711                 Index := AnsiPos(' ', s);
2712                 Index2 := AnsiPos('>', s);
2713                 if Index = 0 then
2714                         Index := Index2;
2715                 if Index > Index2 then
2716                         Index := Index2;
2717                 if Index <> 0 then
2718                         s := Copy(s, 1, Index - 1)
2719                 else
2720                         //\82±\82ê\88È\8fã\82à\82¤\92m\82ç\82ñ\82Ê
2721                         ;
2722         end;
2723         Result := Trim(s);
2724 end;
2725
2726 //\83z\83X\83g\96¼\82ª\82Q\82\83\82\88\82©\82Ç\82¤\82©\83`\83F\83b\83N\82·\82é
2727 function TGikoSys.Is2chHost(Host: string): Boolean;
2728 const
2729         HOST_NAME: array[0..1] of string = ('2ch.net', 'bbspink.com');
2730 var
2731         i: Integer;
2732 //      Len: Integer;
2733 begin
2734         Result := False;
2735         if RightStr( Host, 1 ) = '/' then
2736                 Host := Copy( Host, 1, Length( Host ) - 1 );
2737         OutputDebugString(pchar(HOST_NAME[0]));
2738         for i := 0 to Length(HOST_NAME) - 1 do begin
2739 //              Len := Length(HOST_NAME[i]);
2740                 if AnsiPos(HOST_NAME[i], Host) = (Length(Host) - Length(HOST_NAME[i]) + 1) then begin
2741                         Result := True;
2742                         Exit;
2743                 end;
2744         end;
2745 end;
2746
2747 function TGikoSys.Parse2chURL(const url: string; const path: string; const document: string; var BBSID: string; var BBSKey: string): Boolean;
2748 var
2749         Index: Integer;
2750         s: string;
2751         SList: TStringList;
2752 begin
2753         BBSID := '';
2754         BBSKey := '';
2755         Result := False;
2756
2757         Index := AnsiPos(READ_PATH, path);
2758         if Index <> 0 then begin
2759                 s := Copy(path, Length(READ_PATH) + 1, Length(path));
2760                 BBSID := GetTokenIndex(s, '/', 0);
2761                 BBSKey := GetTokenIndex(s, '/', 1);
2762                 if BBSKey = '' then
2763                         BBSKey := Document;
2764                 Result := (BBSID <> '') or (BBSKey <> '');
2765                 Exit;
2766         end;
2767         Index := AnsiPos(KAKO_PATH, path);
2768         if Index <> 0 then begin
2769                 s := Copy(path, 2, Length(path));
2770                 BBSID := GetTokenIndex(s, '/', 0);
2771                 if (BBSID = 'log') and (GetTokenIndex(s, '/', 2) = 'kako') then
2772                         BBSID := GetTokenIndex(s, '/', 1);
2773                 BBSKey := ChangeFileExt(Document, '');
2774                 Result := (BBSID <> '') or (BBSKey <> '');
2775                 Exit;
2776         end;
2777         Index := AnsiPos('read.cgi?', URL);
2778         if Index <> 0 then begin
2779                 SList := TStringList.Create;
2780                 try
2781                         try
2782 //                              s := HTMLDecode(Document);
2783                                 ExtractHTTPFields(['?', '&'], [], PChar(URL), SList, False);
2784                                 BBSID := SList.Values['bbs'];
2785                                 BBSKey := SList.Values['key'];
2786                                 Result := (BBSID <> '') or (BBSKey <> '');
2787                                 Exit;
2788                         except
2789                                 Exit;
2790                         end;
2791                 finally
2792                         SList.Free;
2793                 end;
2794         end;
2795 end;
2796 procedure TGikoSys.GetPopupResNumber(URL : string; var stRes, endRes : Int64);
2797 var
2798     buf : String;
2799     convBuf : String;
2800     ps : Int64;
2801     pch : PChar;
2802 begin
2803         URL := Trim(LowerCase(URL));
2804     if (AnsiPos('&st=', URL ) <> 0) and ( AnsiPos( '&to=',URL) <> 0 ) then begin
2805         try
2806             stRes := StrToInt64( Copy( URL, AnsiPos('&st=', URL ) + 4, AnsiPos( '&to=',URL) - AnsiPos('&st=', URL ) - 4 ) );
2807             if AnsiPos( '&nofirst=',URL) <> 0 then begin
2808                 buf := Copy( URL, AnsiPos('&to=', URL ) + 4, AnsiPos( '&nofirst=',URL) - AnsiPos('&to=', URL ) - 4);
2809             end else begin
2810                 buf := Copy( URL, AnsiPos('&to=', URL ) + 4, Length( URL ) - AnsiPos('&to=', URL ) - 4 + 1 );
2811                 ps := 0;
2812                 pch := PChar(buf);
2813                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
2814                 buf := Copy( buf, 1, ps );
2815             end;
2816             try
2817                 if buf <> '' then
2818                     endRes := StrToInt64(buf);
2819             except
2820                 endRes := 0;
2821             end;
2822         except
2823             stRes := 0;
2824         end;
2825         GikoSys.GetBrowsableThreadURL( URL );
2826     end else if( AnsiPos('&res=', URL ) <> 0 ) then begin
2827         endRes := 0;
2828         buf := Copy( URL, AnsiPos('&res=', URL ) + 5, Length( URL ) - AnsiPos('&res=', URL ) - 5 + 1 );
2829         ps := 0;
2830         pch := PChar(buf);
2831         while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
2832         buf := Copy( buf, 1, ps );
2833         try
2834             if buf <> '' then
2835                 stRes := StrToInt(buf)
2836             else begin
2837                 stRes := 0;
2838             end;
2839         except
2840             stRes := 0;
2841         end;
2842     end else if (AnsiPos('&start=', URL ) <> 0) and ( AnsiPos( '&end=',URL) <> 0 ) then begin
2843         try
2844             stRes := StrToInt64( Copy( URL, AnsiPos('&start=', URL ) + 7, AnsiPos( '&end=',URL) - AnsiPos('&start=', URL ) - 7 ) );
2845             if AnsiPos( '&nofirst=',URL) <> 0 then begin
2846                 buf := Copy( URL, AnsiPos('&end=', URL ) + 5, AnsiPos( '&nofirst=',URL) - AnsiPos('&end=', URL ) - 5);
2847             end else begin
2848                 buf := Copy( URL, AnsiPos('&end=', URL ) + 5, Length( URL ) - AnsiPos('&to=', URL ) - 5 + 1 );
2849                 ps := 0;
2850                 pch := PChar(buf);
2851                 while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
2852                 buf := Copy( buf, 1, ps );
2853             end;
2854             try
2855                 if buf <> '' then
2856                     endRes := StrToInt64(buf);
2857             except
2858                 endRes := 0;
2859             end;
2860         except
2861             stRes := 0;
2862         end;
2863     end else if ( AnsiPos('.html',URL) <> Length(URL) -4 ) and ( AnsiPos('.htm',URL) <> Length(URL) -3 ) then begin
2864         buf := Copy(URL, LastDelimiter('/',URL)+1,Length(URL)-LastDelimiter('/',URL)+1);
2865         if  Length(buf) > 0 then begin
2866             ps := 0;
2867             pch := PChar(buf);
2868             while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
2869             try
2870                 convBuf := Copy( buf, 1, ps );
2871                 if convBuf <> '' then begin
2872                     stRes := StrToInt64(convBuf);
2873                     Delete(buf,1,ps+1);
2874                     ps := 0;
2875                     pch := PChar(buf);
2876                     while  ( ps < Length(buf) )and ( pch[ps] >= '0' ) and ( pch[ps] <= '9' ) do Inc(ps);
2877                     try
2878                         convBuf := Copy( buf, 1, ps );
2879                         if convBuf <> '' then
2880                             endRes := StrToInt64(convBuf)
2881                         else
2882                             endRes := 0;
2883                     except
2884                         endRes := 0;
2885                     end;
2886                 end else begin
2887                     stRes := 0;
2888                 end;
2889
2890             except
2891                 stRes := 0;
2892                 endRes := 0;
2893             end;
2894
2895         end;
2896     end else begin
2897             //stRes := 0;
2898         //endRes := 0;
2899     end;
2900 end;
2901
2902 function TGikoSys.Parse2chURL2(URL: string): TPathRec;
2903 var
2904         i: Integer;
2905         s: string;
2906 //    buf : String;
2907 //    convBuf : String;
2908         wk: string;
2909         wkMin: Integer;
2910         wkMax: Integer;
2911         wkInt: Integer;
2912         RStart: Integer;
2913         RLength: Integer;
2914 //    ps : Integer;
2915 //    pch : PChar;
2916         SList: TStringList;
2917 begin
2918         URL := Trim(LowerCase(URL));
2919         Result.FBBS := '';
2920         Result.FKey := '';
2921         Result.FSt := 0;
2922         Result.FTo := 0;
2923         Result.FFirst := False;
2924         Result.FStBegin := False;
2925         Result.FToEnd := False;
2926         Result.FDone := False;
2927
2928         wkMin := 0;
2929         wkMax := 1;
2930     if URL[length(URL)] = '\' then
2931         URL := URL + 'n';
2932         FAWKStr.RegExp := 'http://.+\.(2ch\.net|bbspink\.com)/';
2933         if FAWKStr.Match(FAWKStr.ProcessEscSeq(URL), RStart, RLength) <> 0 then begin
2934                 s := Copy(URL, RStart + RLength - 1, Length(URL));
2935
2936         //\95W\8f\80\8f\91\8e®
2937         //\8dÅ\8cã\82Íl50, 10, 10-20, 10n, 10-20n, -10, 10-, 10n- \82È\82Ç
2938         //http://xxx.2ch.net/test/read.cgi/bbsid/1000000000/
2939         FAWKStr.RegExp := '/test/read.cgi/.+/[0-9]+/.*';
2940         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2941             s := Copy(s, 15, Length(s));
2942
2943             SList := TStringList.Create;
2944             try
2945                 SList.Clear;
2946                 FAWKStr.RegExp := '/';
2947                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
2948                     Result.FBBS := SList[1];
2949                     Result.FKey := SList[2];
2950                     if SList.Count >= 3 then
2951                         s := SList[3]
2952                     else
2953                         s := '';
2954                 end else
2955                     Exit;
2956
2957                 SList.Clear;
2958                 FAWKStr.LineSeparator := mcls_CRLF;
2959                 FAWKStr.RegExp := '-';
2960                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) = 0 then begin
2961                     Result.FFirst := True;
2962                 end else begin
2963                     FAWKStr.RegExp := 'l[0-9]+';
2964                     if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
2965                         Result.FFirst := True;
2966                     end else begin
2967                         for i := 0 to SList.Count - 1 do begin
2968                             if Trim(SList[i]) = '' then begin
2969                                 if i = 0 then
2970                                     Result.FStBegin := True;
2971                                 if i = (SList.Count - 1) then
2972                                     Result.FToEnd := True;
2973                             end else if IsNumeric(SList[i]) then begin
2974                                 wkInt := StrToInt(SList[i]);
2975                                 wkMax := Max(wkMax, wkInt);
2976                                 if wkMin = 0 then
2977                                     wkMin := wkInt
2978                                 else
2979                                     wkMin := Min(wkMin, wkInt);
2980                             end else if Trim(SList[i]) = 'n' then begin
2981                                 Result.FFirst := True;
2982                             end else begin
2983                                 FAWKStr.RegExp := '^n[0-9]+$|^[0-9]+n$';
2984                                 if FAWKStr.Match(FAWKStr.ProcessEscSeq(SList[i]), RStart, RLength) > 0 then begin
2985                                     if Copy(SList[i], 1, 1) = 'n' then
2986                                         wkInt := StrToInt(Copy(SList[i], 2, Length(SList[i])))
2987                                     else
2988                                         wkInt := StrToInt(Copy(SList[i], 1, Length(SList[i]) - 1));
2989                                     Result.FFirst := True;
2990                                     wkMax := Max(wkMax, wkInt);
2991                                     if wkMin = 1 then
2992                                         wkMin := wkInt
2993                                     else
2994                                         wkMin := Min(wkMin, wkInt);
2995                                 end;
2996                             end;
2997                         end;
2998                         if Result.FStBegin and (not Result.FToEnd) then
2999                             Result.FSt := wkMin
3000                         else if (not Result.FStBegin) and Result.FToEnd then
3001                             Result.FTo := wkMax
3002                         else if (not Result.FStBegin) and (not Result.FToEnd) then begin
3003                             Result.FSt := wkMin;
3004                             Result.FTo := wkMax;
3005                         end;
3006                         //Result.FSt := wkMin;
3007                         //Result.FTo := wkMax;
3008                     end;
3009                 end;
3010             finally
3011                 SList.Free;
3012             end;
3013             Result.FDone := True;
3014             Exit;
3015         end;
3016
3017         //\90Vkako\8f\91\8e®
3018         //http://server.2ch.net/ITA_NAME/kako/1000/10000/1000000000.html
3019         FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+/[0-9]+\.html';
3020         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3021             SList := TStringList.Create;
3022             try
3023                 SList.Clear;
3024                 FAWKStr.RegExp := '/';
3025                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
3026                     Result.FBBS := SList[1];
3027                     Result.FKey := ChangeFileExt(SList[5], '');
3028                     Result.FFirst := True;
3029                 end else
3030                     Exit;
3031             finally
3032                 SList.Free;
3033             end;
3034             Result.FDone := True;
3035             Exit;
3036         end;
3037
3038         //\8b\8ckako\8f\91\8e®
3039         //http://server.2ch.net/ITA_NAME/kako/999/999999999.html
3040         FAWKStr.RegExp := '/.+/kako/[0-9]+/[0-9]+\.html';
3041         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3042             SList := TStringList.Create;
3043             try
3044                 SList.Clear;
3045                 FAWKStr.RegExp := '/';
3046                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 5 then begin
3047                     Result.FBBS := SList[1];
3048                     Result.FKey := ChangeFileExt(SList[4], '');
3049                     Result.FFirst := True;
3050                 end else
3051                     Exit;
3052             finally
3053                 SList.Free;
3054             end;
3055             Result.FDone := True;
3056             Exit;
3057         end;
3058
3059         //log\8by\82Ñlog2\8f\91\8e®
3060         //http://server.2ch.net/log/ITA_NAME/kako/999/999999999.html
3061         //http://server.2ch.net/log2/ITA_NAME/kako/999/999999999.html
3062         FAWKStr.RegExp := '/log2?/.+/kako/[0-9]+/[0-9]+\.html';
3063         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3064             SList := TStringList.Create;
3065             try
3066                 SList.Clear;
3067                 FAWKStr.RegExp := '/';
3068                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 6 then begin
3069                     Result.FBBS := SList[2];
3070                     Result.FKey := ChangeFileExt(SList[5], '');
3071                     Result.FFirst := True;
3072                 end else
3073                     Exit;
3074             finally
3075                 SList.Free;
3076             end;
3077             Result.FDone := True;
3078             Exit;
3079         end;
3080
3081
3082         //\8b\8cURL\8f\91\8e®
3083         //http://server.2ch.net/test/read.cgi?bbs=ITA_NAME&key=1000000000&st=1&to=5&nofirst=true
3084         FAWKStr.RegExp := '/test/read\.cgi\?';
3085         if FAWKStr.Match(FAWKStr.ProcessEscSeq(s), RStart, RLength) > 0 then begin
3086             s := Copy(s, 16, Length(s));
3087             SList := TStringList.Create;
3088             try
3089                 SList.Clear;
3090                 FAWKStr.RegExp := '&';
3091                 if FAWKStr.Split(FAWKStr.ProcessEscSeq(s), SList) >= 2 then begin
3092                     Result.FFirst := True;
3093                     for i := 0 to SList.Count - 1 do begin
3094                         if Pos('bbs=', SList[i]) = 1 then begin
3095                             Result.FBBS := Copy(SList[i], 5, Length(SList[i]));
3096                         end else if Pos('key=', SList[i]) = 1 then begin
3097                             Result.FKey := Copy(SList[i], 5, Length(SList[i]));
3098                         end else if Pos('st=', SList[i]) = 1 then begin
3099                             wk := Copy(SList[i], 4, Length(SList[i]));
3100                             if IsNumeric(wk) then
3101                                 Result.FSt := StrToInt(wk)
3102                             else if wk = '' then
3103                                 Result.FStBegin := True;
3104                         end else if Pos('to=', SList[i]) = 1 then begin
3105                             wk := Copy(SList[i], 4, Length(SList[i]));
3106                             if IsNumeric(wk) then
3107                                 Result.FTo := StrToInt(wk)
3108                             else if wk = '' then
3109                                 Result.FToEnd := True;
3110                         end else if Pos('nofirst=', SList[i]) = 1 then begin
3111                             Result.FFirst := False;
3112                         end;
3113                     end;
3114                 end else
3115                     Exit;
3116             finally
3117                 SList.Free;
3118             end;
3119
3120             if (Result.FBBS <> '') and (Result.FKey <> '') then begin
3121                 Result.FDone := True;
3122             end;
3123             Exit;
3124         end;
3125     end;
3126 end;
3127
3128 procedure TGikoSys.ParseURI(var URL, Protocol, Host, Path, Document, Port, Bookmark: string);
3129 var
3130         URI: TIdURI;
3131 begin
3132         Protocol := '';
3133         Host := '';
3134         Path := '';
3135         Document := '';
3136         Port := '';
3137         Bookmark := '';
3138         URI := TIdURI.Create(URL);
3139         try
3140                 Protocol := URI.Protocol;
3141                 Host := URI.Host;
3142                 Path := URI.Path;
3143                 Document := URI.Document;
3144                 Port := URI.Port;
3145                 Bookmark := URI.Bookmark;
3146         finally
3147                 URI.Free;
3148         end;
3149 end;
3150
3151 function TGikoSys.GetVersionBuild: Integer;
3152 var
3153         FixedFileInfo: PVSFixedFileInfo;
3154         VersionHandle, VersionSize: DWORD;
3155         pVersionInfo: Pointer;
3156         ItemLen : UInt;
3157         AppFile: string;
3158 begin
3159         Result := 0;
3160         AppFile := Application.ExeName;
3161         VersionSize := GetFileVersionInfoSize(pChar(AppFile), VersionHandle);
3162         if VersionSize = 0 then
3163                 Exit;
3164         GetMem(pVersionInfo, VersionSize);
3165         try
3166                 if GetFileVersionInfo(PChar(AppFile),VersionHandle,VersionSize, pVersionInfo) then
3167                         if VerQueryValue(pVersionInfo, '\', Pointer(FixedFileInfo), ItemLen) then
3168                                 Result := LOWORD(FixedFileInfo^.dwFileVersionLS);
3169         finally
3170                 FreeMem(pVersionInfo, VersionSize);
3171         end;
3172 end;
3173
3174 function        TGikoSys.GetBrowsableThreadURL(
3175         inURL : string
3176 ) : string;
3177 var
3178         threadItem      : TThreadItem;
3179         boardPlugIn     : TBoardPlugIn;
3180         i                                               : Integer;
3181 begin
3182
3183         //===== \83v\83\89\83O\83C\83\93
3184         try
3185                 for i := Length( BoardPlugIns ) - 1 downto 0 do begin
3186                         if Assigned( Pointer( BoardPlugIns[ i ].Module ) ) then begin
3187                                 if BoardPlugIns[ i ].AcceptURL( inURL ) = atThread then begin
3188                                         boardPlugIn := BoardPlugIns[ i ];
3189                                         threadItem      := TThreadItem.Create( boardPlugIn, inURL );
3190                                         Result                  := threadItem.URL;
3191                                         threadItem.Free;
3192
3193                                         Break;
3194                                 end;
3195                         end;
3196                 end;
3197         except
3198                 // exception \82ª\94\90¶\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
3199         end;
3200
3201         if Length( Result ) = 0 then
3202                 Result := GikoSys.Get2chBrowsableThreadURL( inURL );
3203
3204 end;
3205
3206 function        TGikoSys.GetThreadURL2BoardURL(
3207         inURL : string
3208 ) : string;
3209 var
3210         threadItem      : TThreadItem;
3211         boardPlugIn     : TBoardPlugIn;
3212         i                                               : Integer;
3213 begin
3214
3215         //===== \83v\83\89\83O\83C\83\93
3216         try
3217                 for i := Length( BoardPlugIns ) - 1 downto 0 do begin
3218                         if Assigned( Pointer( BoardPlugIns[ i ].Module ) ) then begin
3219                                 if BoardPlugIns[ i ].AcceptURL( inURL ) = atThread then begin
3220                                         boardPlugIn := BoardPlugIns[ i ];
3221                                         threadItem      := TThreadItem.Create( boardPlugIn, inURL );
3222                                         Result                  := BoardPlugIns[ i ].GetBoardURL( Longword( threadItem ) );
3223                                         threadItem.Free;
3224
3225                                         Break;
3226                                 end;
3227                         end;
3228                 end;
3229         except
3230                 // exception \82ª\94\90¶\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
3231         end;
3232
3233         if Length( Result ) = 0 then
3234                 Result := GikoSys.Get2chThreadURL2BoardURL( inURL );
3235
3236 end;
3237
3238 function        TGikoSys.Get2chThreadURL2BoardURL(
3239         inURL : string
3240 ) : string;
3241 var
3242         Protocol, Host, Path, Document, Port, Bookmark : string;
3243         BBSID, BBSKey : string;
3244         foundPos                        : Integer;
3245 begin
3246
3247         ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
3248         Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
3249
3250         foundPos := Pos( '/test/read.cgi', inURL );
3251         if foundPos > 0 then
3252                 Result := Copy( inURL, 1, foundPos ) + BBSID + '/'
3253         else
3254                 Result := Protocol + '://' + Host + '/' + BBSID + '/';
3255
3256 end;
3257
3258 function        TGikoSys.Get2chBrowsableThreadURL(
3259         inURL                   : string
3260 ) : string;
3261 var
3262         Protocol, Host, Path, Document, Port, Bookmark : string;
3263         BBSID, BBSKey : string;
3264         foundPos        : Integer;
3265 begin
3266
3267 //      if Pos( KAKO_PATH, inURL ) > 0 then begin
3268 //              Result := inURL;
3269 //      end else begin
3270                 ParseURI( inURL, Protocol, Host, Path, Document, Port, Bookmark );
3271                 Parse2chURL( inURL, Path, Document, BBSID, BBSKey );
3272                 foundPos := Pos( '/test/read.cgi', inURL ) - 1;
3273
3274                 if Is2chHost( Host ) then begin
3275                         Result := Protocol + '://' + Host +
3276                                 READ_PATH + BBSID + '/' + BBSKey + '/l50';
3277                 end else begin
3278                         if foundPos > 0 then
3279                                 Result := Copy( inURL, 1, foundPos ) +
3280                                         OLD_READ_PATH + 'bbs=' + BBSID + '&key=' + BBSKey + '&ls=50'
3281                         else
3282                                 Result := Protocol + '://' + Host +
3283                                         OLD_READ_PATH + 'bbs=' + BBSID + '&key=' + BBSKey + '&ls=50';
3284                 end;
3285 //      end;
3286
3287 end;
3288
3289 function        TGikoSys.Get2chBoard2ThreadURL(
3290         inBoard : TBoard;
3291         inKey           : string
3292 ) : string;
3293 var
3294         server  : string;
3295 begin
3296
3297         server := UrlToServer( inBoard.URL );
3298         if Is2chHost( server ) then
3299                 Result := server + 'test/read.cgi/' + inBoard.BBSID + '/' + inKey + '/l50'
3300         else
3301                 Result := server + 'test/read.cgi?bbs=' + inBoard.BBSID + '&key=' + inKey + '&ls=50';
3302
3303 end;
3304
3305 (*************************************************************************
3306  *\8b@\94\\96¼\81@\81@\81F\83{\81[\83h\83t\83@\83C\83\8b\97ñ\8b\93
3307  *\89Â\8e\8b\81@\81@\81@\81FPublic
3308  *************************************************************************)
3309 procedure TGikoSys.ListBoardFile;
3310 var
3311         boardFileList   : TStringList;
3312         i, l                                    : Integer;
3313 begin
3314
3315   // BBS \82Ì\8aJ\95ú
3316   try
3317     for i := 0 to Length( BBSs ) - 1 do
3318       BBSs[ i ].Free;
3319   except
3320   end;
3321   SetLength( BBSs, 0 );
3322
3323   l := 0;
3324   // \94Â\83\8a\83X\83g\82Ì\97ñ\8b\93
3325   if FileExists( GikoSys.GetBoardFileName ) then begin
3326     SetLength( BBSs, l + 1 );
3327     BBSs[ l ]                           := TBBS.Create( GikoSys.GetBoardFileName );
3328     BBSs[ l ].Title     := '\82Q\82¿\82á\82ñ\82Ë\82é';
3329                 Inc( l );
3330   end;
3331
3332   if FileExists( GikoSys.GetCustomBoardFileName ) then begin
3333     SetLength( BBSs, l + 1 );
3334     BBSs[ l ]                           := TBBS.Create( GikoSys.GetCustomBoardFileName );
3335     BBSs[ l ].Title     := '\82»\82Ì\91¼';
3336                 Inc( l );
3337   end;
3338
3339   // Board \83t\83H\83\8b\83_
3340   if DirectoryExists( GikoSys.Setting.GetBoardDir ) then begin
3341     BoardFileList := TStringList.Create;
3342     try
3343           GikoSys.GetFileList( GikoSys.Setting.GetBoardDir, '*', BoardFileList, True, True );
3344                         SetLength( BBSs, l + BoardFileList.Count );
3345       for i := BoardFileList.Count - 1 downto 0 do begin
3346         BBSs[ l ]                               := TBBS.Create( BoardFileList[ i ] );
3347         BBSs[ l ].Title := ChangeFileExt( ExtractFileName( BoardFileList[ i ] ), '' );
3348
3349         Inc( l );
3350       end;
3351     finally
3352       BoardFileList.Free;
3353     end;
3354   end;
3355
3356 end;
3357
3358 (*************************************************************************
3359  *\8b@\94\\96¼\81@\81@\81F\83{\81[\83h\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý
3360  *\89Â\8e\8b\81@\81@\81@\81FPublic
3361  *************************************************************************)
3362 procedure TGikoSys.ReadBoardFile( bbs : TBBS );
3363 var
3364         idx                                             : Integer;
3365         ini                                             : TMemIniFile;
3366
3367         boardFile                       : TStringList;
3368         CategoryList    : TStringList;
3369         BoardList                       : TStringList;
3370         Category                        : TCategory;
3371         Board                                   : TBoard;
3372         inistr                          : string;
3373         RoundItem                       : TRoundItem;
3374
3375         i, iBound                       : Integer;
3376         j, jBound                       : Integer;
3377         k, kBound                       : Integer;
3378 begin
3379
3380   if not FileExists( bbs.FilePath ) then
3381     Exit;
3382
3383         bbs.Clear;
3384   ini := TMemIniFile.Create('');
3385   boardFile := TStringList.Create;
3386   try
3387     boardFile.LoadFromFile( bbs.FilePath );
3388
3389     ini.SetStrings( boardFile );
3390     CategoryList        := TStringList.Create;
3391     BoardList                   := TStringList.Create;
3392     try
3393       ini.ReadSections( CategoryList );
3394
3395       iBound := CategoryList.Count - 1;
3396       for i := 0 to iBound do begin
3397         ini.ReadSection( CategoryList[i], BoardList );
3398         Category                                := TCategory.Create;
3399         Category.No                     := i + 1;
3400         Category.Title  := CategoryList[i];
3401
3402         jBound := BoardList.Count - 1;
3403         for j := 0 to jBound do begin
3404           Board := nil;
3405           inistr := ini.ReadString(CategoryList[i], BoardList[j], '');
3406
3407           //===== \83v\83\89\83O\83C\83\93
3408           try
3409             kBound := Length( BoardPlugIns ) - 1;
3410             for k := 0 to kBound do begin
3411               if Assigned( Pointer( BoardPlugIns[ k ].Module ) ) then begin
3412                 if BoardPlugIns[ k ].AcceptURL( inistr ) = atBoard then begin
3413                   Board := TBoard.Create( BoardPlugIns[ k ], inistr );
3414
3415                   Break;
3416                 end;
3417               end;
3418             end;
3419           except
3420             // exception \82ª\94\90¶\82µ\82½\8fê\8d\87\82Í\93à\95\94\8f\88\97\9d\82É\94C\82¹\82½\82¢\82Ì\82Å\82±\82±\82Å\82Í\89½\82à\82µ\82È\82¢
3421           end;
3422
3423           if Board = nil then
3424             Board := TBoard.Create( nil, inistr );
3425           Board.BeginUpdate;
3426           Board.No := j + 1;
3427           Board.Title := BoardList[j];
3428           Board.RoundDate := ZERO_DATE;
3429
3430           idx := RoundList.Find(Board);
3431           if idx <> -1 then begin
3432             RoundItem                           := RoundList.Items[idx, grtBoard];
3433             Board.Round                 := True;
3434             Board.RoundName     := RoundItem.RoundName;
3435           end;
3436
3437           Category.Add(Board);
3438           Board.LoadSettings;
3439           Board.EndUpdate;
3440         end;
3441
3442         bbs.Add( Category );
3443       end;
3444                         bbs.IsBoardFileRead := True;
3445     finally
3446       BoardList.Free;
3447       CategoryList.Free;
3448     end;
3449   finally
3450     boardFile.Free;
3451     ini.Free;
3452   end;
3453
3454 end;
3455
3456 function        TGikoSys.GetUnknownCategory : TCategory;
3457 const
3458         UNKNOWN_CATEGORY = '(\96¼\8fÌ\95s\96¾)';
3459 begin
3460
3461         if Length( BBSs ) < 2 then begin
3462                 Result := nil;
3463                 Exit;
3464         end;
3465
3466         Result := BBSs[ 1 ].FindCategoryFromTitle( UNKNOWN_CATEGORY );
3467         if Result = nil then begin
3468                 Result                          := TCategory.Create;
3469                 Result.Title    := UNKNOWN_CATEGORY;
3470                 BBSs[ 1 ].Add( Result );
3471         end;
3472
3473 end;
3474
3475 function        TGikoSys.GetUnknownBoard( inPlugIn : TBoardPlugIn; inURL : string ) : TBoard;
3476 var
3477         category : TCategory;
3478 const
3479         UNKNOWN_BOARD = '(\96¼\8fÌ\95s\96¾)';
3480 begin
3481
3482         category := GetUnknownCategory;
3483         if category = nil then begin
3484                 Result := nil;
3485         end else begin
3486                 Result := category.FindBoardFromTitle( UNKNOWN_BOARD );
3487                 if Result = nil then begin
3488                         Result                          := TBoard.Create( inPlugIn, inURL );
3489                         Result.Title    := UNKNOWN_BOARD;
3490                         category.Add( Result );
3491                 end;
3492         end;
3493
3494 end;
3495 function TGikoSys.GetSambaFileName : string;
3496 begin
3497         Result := Setting.GetSambaFileName;
3498 end;
3499 procedure TGikoSys.SambaFileExists();
3500 var
3501         sambaTmp: string;
3502     sambaStrList: TStringList;
3503 begin
3504     if not FileExists(GikoSys.GetSambaFileName) then begin
3505         sambaTmp := ChangeFileExt(GikoSys.GetSambaFileName, '.default');
3506         sambaStrList := TStringList.Create;
3507         try
3508             if FileExists(sambaTmp) then begin
3509                         sambaStrList.LoadFromFile(sambaTmp);
3510                 sambaStrList.SaveToFile(GikoSys.GetSambaFileName);
3511             end;
3512         finally
3513                 sambaStrList.Free;
3514         end;
3515     end;
3516 end;
3517
3518 initialization
3519         GikoSys := TGikoSys.Create;
3520
3521 finalization
3522         if GikoSys <> nil then begin
3523                 GikoSys.Free;
3524                 GikoSys := nil;
3525         end;
3526 end.