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