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