MonaUtils.pas

   1 unit MonaUtils;
   2
   3 {$IOCHECKS ON}
   4
   5 {----------------------------------------------------------
   6   MonaUtils
   7
   8   --History--
   9   2002.12.10 GetDatSince\8dì\90¬
  10   2001.03.07 ExtractUrlPath\8dì\90¬
  11   2001.03.07 ExtractUrlName\8dì\90¬
  12   2001.03.08 Max\8dì\90¬
  13   2001.03.08 Min\8dì\90¬
  14   2001.03 10 EMonaError, MonaError\8dì\90¬
  15   2001.03.10 IncludeTrailingSlash\8dì\90¬
  16   2001.03.10 ExcludeTrailingSlash\8dì\90¬
  17   2001.03 10 IsUrlDelimiter\8dì\90¬
  18   2001.03 10 FindFile\8dì\90¬
  19   2001.03.10 LoadStringFromFile\8dì\90¬
  20   2001.03.10 SaveStringToFile\8dì\90¬
  21   2001.03.11 TMonaHtmlParser\8dì\90¬
  22   2001.03.11 TMonaProfiler\8dì\90¬
  23   2001.03.11 ShellOpen\8dì\90¬
  24   2001.04.06 AddHRefTag\8dì\90¬                                       < GikoNavi\82æ\82è
  25   2001.04.27 TrimHRefTag\8dì\90¬
  26   2001.04.27 DecodeHtmlEsc\8dì\90¬
  27   2001.04.27 EncodeHtmlEsc\8dì\90¬
  28   2001.04.27 ExtractHostName\8dì\90¬
  29   2001.04.27 Get2chDate\8dì\90¬                                       < GikoNavi\82æ\82è
  30   2001.04.27 ChooseString\8dì\90¬
  31   2001.04.27 ExtractQuotedStr\8dì\90¬
  32   2001.04.27 ExtractUrlLastPath\8dì\90¬
  33   2001.04.27 IsNumeric\8dì\90¬                                        < GikoNavi\82æ\82è
  34   2001.04.27 IsFloat\8dì\90¬                                          < GikoNavi\82æ\82è
  35   2001.04.27 Fmt2chToDateTime\8dì\90¬                               < Monaplorer\82æ\82è
  36   2001.04.27 AddHRefTag\82ð\83A\83b\83v\83f\81[\83g                        < GikoNavi a013\82æ\82è
  37   2001.04.27 StrCount1\8dì\90¬                                      < Monaplorer\82æ\82è
  38   2001.04.27 BackAnsiPos\8dì\90¬                                    < Monaplorer\82æ\82è
  39   2001.10.30 TMonaProfiler\82ð\88ê\92U\8aO\82·
  40   2001.10.30 TMonaHtmlParser\82É Attributes\83v\83\8d\83p\83e\83B\82ð\92Ç\89Á          < Hotzonu\82æ\82è
  41   2001.10.30 UrlToDosPath\8dì\90¬                                      < Hotzonu\82æ\82è
  42   2001.10.30 ChooseValue\8dì\90¬                                       < Hotzonu\82æ\82è
  43   2001.10.30 MargeUrl\8dì\90¬                                          < Hotzonu\82æ\82è
  44   2001.10.30 ExtractHrefUrl\8dì\90¬                                    < Hotzonu\82æ\82è
  45   2001.10.30 ZenToHan\8dì\90¬                                          < Hotzonu\82æ\82è
  46   2001.10.30 GetContentLength\8dì\90¬                                  < Hotzonu\82æ\82è
  47   2001.10.30 TrimTag\8dì\90¬                                           < Hotzonu\82æ\82è
  48   2001.10.30 AddTargetBlank\8dì\90¬                                    < Hotzonu\82æ\82è
  49   2001.11.09 ExtractDatNo\8dì\90¬
  50
  51   --Procedures--
  52   ExtractUrlPath .......... URL\82©\82ç\83p\83X\82¾\82¯\82ð\92\8a\8fo
  53   ExtractUrlName .......... URL\82©\82ç\83t\83@\83C\83\8b\96¼\82¾\82¯\82ð\92\8a\8fo
  54   IncludeTrailingSlash .... \83t\83@\83C\83\8b\96¼\82Ì\96\96\94ö\82É'/'\82ð\92Ç\89Á\82·\82é
  55   ExcludeTrailingSlash .... \83t\83@\83C\83\8b\96¼\82Ì\96\96\94ö\82©\82ç'/'\82ð\8eæ\82è\8f\9c\82
  56   IsUrlDelimiter .......... \95¶\8e\9a\97ñ\92\86\82Ì\8ew\92è\88Ê\92u\82ª / \82©\82Ç\82¤\82©
  57   Max ..................... \82Ó\82½\82Â\82Ì\88ø\90\94\82Ì\82¤\82¿\91å\82«\82¢\95û\82ð\95Ô\82·
  58   Min ..................... \82Ó\82½\82Â\82Ì\88ø\90\94\82Ì\82¤\82¿\8f¬\82³\82¢\95û\82ð\95Ô\82·
  59   FindFile ................ \8ew\92è\83p\83X\82Ì\83t\83@\83C\83\8b\82Ì TSearchRec\82ð\95Ô\82·
  60   LoadStringFromFile ...... \83t\83@\83C\83\8b\82©\82ç\95¶\8e\9a\97ñ\82ð\93Ç\82Ý\8d\9e\82Þ
  61   SaveStringToFile ........ \95¶\8e\9a\97ñ\82ð\83t\83@\83C\83\8b\82É\8f\91\82«\8fo\82·
  62   ShellOpen ............... \8ew\92è\83t\83@\83C\83\8b\93\99\82ðShellExecute
  63   AddHRefTag .............. http://\82©\82ç\8en\82Ü\82é\95¶\8e\9a\97ñ\82É A\83^\83O\82ð\82Â\82¯\82é
  64   TrimHRefTag ............. \95¶\8e\9a\97ñ\82©\82ç<A HREF\81`> </A>\83^\83O\82ð\8f\9c\8b\8e\82·\82é
  65   DecodeHtmlEsc ........... \95¶\8e\9a\97ñ\92\86\82Ì\93Á\8eê\83^\83O(&lt;\82Æ\82©)\82ð\95Ï\8a·\82·\82é
  66   EncodeHtmlEsc ........... \95¶\8e\9a\97ñ\92\86\82Ì"<"\82È\82Ç\82ð\93Á\8eê\83^\83O\82É\95Ï\8a·\82·\82é
  67   ExtractHostName ......... URL\82©\82ç\83z\83X\83g\96¼\82¾\82¯\82ð\92\8a\8fo
  68   Get2chDate .............. \93ú\95t\82ð\82Q\82¿\82á\82ñ\82Ë\82éPOST\97p\93ú\95t\82É\95Ï\8a·\82·\82é
  69   ChooseString ............ \82 \82é\83Z\83p\83\8c\81[\83^\82Å\8bæ\90Ø\82ç\82ê\82½\95¶\8e\9a\97ñ\82©\82ç
  70                             \82\8e\94Ô\96Ú\82Ì\95¶\8e\9a\97ñ\82ð\8eæ\82è\8fo\82·
  71   ExtractQuotedStr ........ \95¶\8e\9a\97ñ\82Ì\91O\8cã\82Ì\88ø\97p\95\84\82ð\8aO\82·
  72   ExtractUrlLastPath ...... URL\82Ì\8dÅ\8cã\82Ì\83p\83X\82ð\92\8a\8fo
  73   IsNumeric ............... \8ew\92è\95¶\8e\9a\97ñ\82ª\90®\90\94\82©\82Ç\82¤\82©\82ð\94»\92f\82·\82é
  74   IsFloat ................. \8ew\92è\95¶\8e\9a\97ñ\82ª\8eÀ\90\94\82©\82Ç\82¤\82©\82ð\94»\92f\82·\82é
  75   Fmt2chToDateTime ........ DAT\83t\83@\83C\83\8b\82Å\82Ì\93ú\95t\95¶\8e\9a\97ñ\82ð\93ú\95t\8c^\82É\95Ï\8a·\82·\82é
  76   StrCount1 ............... S\82Ì\92\86\82ÉSubStr\82ª\82¢\82\82Â\82 \82é\82©\83J\83E\83\93\83g\82·\82é(2\83o\83C\83g\91Î\89\9e)
  77   UrlToDosPath ............ URL\82ðDOS\8c`\8e®\82Ì\83p\83X\82É\95Ï\8a·\82·\82é
  78   ChooseValue ............. URL\82Ì ?param=value \82ÌParam\82ð\8ew\92è\82·\82é\82ÆValue\82ð\8eæ\93¾\82·\82é
  79   MargeUrl ................ \90â\91ÎURL\82Æ\91\8a\91ÎURL\82ð\83}\81[\83W\82·\82é
  80   ExtractHrefUrl .......... A HREF\83^\83O\82Ì\92\86\82©\82çURL\82ð\92\8a\8fo\82·\82é
  81   ZenToHan ................ \91S\8ap\95¶\8e\9a\97ñ\82ð\94¼\8ap\95¶\8e\9a\97ñ\82É\95Ï\8a·(Windows\82Ì\82Ý)
  82   GetContentLength ........ \8ew\92è\95¶\8e\9a\97ñ\82Ì\92·\82³\82ð\95Ô\82· (#13\82ð\8aÜ\82Ü\82È\82¢)
  83   TrimTag ................. \8ew\92è\82³\82ê\82½\95¶\8e\9a\97ñ\82©\82ç\83^\83O\82ð\8f\9c\8b\8e\82·\82é
  84   AddTargetBlank .......... A HREF\83^\83O\82É TARGET="_blank"\82ð\91}\93ü\82·\82é
  85   ExtractDatNo ............ DAT\83t\83@\83C\83\8b\96¼\82©\82ç DAT\82Ì\94Ô\8d\86\82¾\82¯\8eæ\93¾\82·\82é
  86
  87   --Classes--
  88   TMonaHtmlParser ......... HTML\83p\81[\83T\81[\83N\83\89\83X
  89   TMonaProfiler ........... \83v\83\8d\83t\83@\83C\83\89
  90
  91   --Report--
  92   SaveStringToFile \82ÍLinux\83v\83\89\83b\83g\83t\83H\81[\83\80\82Å\92·\82³\83[\83\8d\82Ì\95¶\8e\9a\97ñ\82ð\83T\83|\81[\83g\82µ\82Ü\82¹\82ñ\81B
  93   ShellOpen, MonaProfiler\82ÍLinux\83v\83\89\83b\83g\83t\83H\81[\83\80\82ð\83T\83|\81[\83g\82µ\82Ü\82¹\82ñ\81B
  94 ----------------------------------------------------------}
  95
  96 interface
  97
  98 uses
  99   {$IFDEF LINUX}
 100     QForms,
 101   {$ENDIF}
 102   {$IFDEF MSWINDOWS}
 103     Windows, ShellApi, Forms,
 104   {$ENDIF}
 105   Classes, SysUtils, {HTTPApp,} YofUtils, DateUtils;
 106
 107 //
 108 //  \97á\8aO
 109 //
 110 type
 111   EMonaError = class(Exception);
 112
 113 // EMonaError\82ðraise
 114 procedure MonaError(msg: String); overload;
 115 procedure MonaError(format: String; args: array of const); overload;
 116
 117 //
 118 //  \8eè\91±\82«\81E\8aÖ\90\94
 119 //
 120 function  ExtractUrlPath(const FileName: string): string;
 121 function  ExtractUrlName(const FileName: string): string;
 122 function  Max(A, B: Integer): Integer; overload;
 123 function  Max(A, B: Int64): Int64; overload;
 124 function  Max(A, B: Single): Single; overload;
 125 function  Max(A, B: Double): Double; overload;
 126 function  Max(A, B: Extended): Extended; overload;
 127 function  Min(A, B: Integer): Integer; overload;
 128 function  Min(A, B: Int64): Int64; overload;
 129 function  Min(A, B: Single): Single; overload;
 130 function  Min(A, B: Double): Double; overload;
 131 function  Min(A, B: Extended): Extended; overload;
 132 function  IncludeTrailingSlash(const S: string): string;
 133 function  ExcludeTrailingSlash(const S: string): string;
 134 function  IsUrlDelimiter(const S: string; Index: Integer): Boolean;
 135 function  FindFile(const FileName: String): TSearchRec;
 136 function  LoadStringFromFile(const FileName: String): String;
 137 procedure SaveStringToFile(const FileName, Str: String);
 138 procedure ShellOpen(const FileName: String); // \82Æ\82É\82©\82\8aJ\82
 139 function  AddHRefTag(s: string): string;
 140 function  TrimHRefTag(const S: string): string;
 141 function  DecodeHtmlEsc(const s: string): string;
 142 function  EncodeHtmlEsc(const s: string): string;
 143 function  ExtractHostName(const Url: string): string;
 144 function  Get2chDate(aDate: TDateTime): string;  {from GikoNavi / hiroyuki}
 145 function  GetDatSince(aDatNo: string): string;
 146 function  ChooseString(const Text, Separator: string; Index: integer): string;
 147 function  ExtractQuotedStr(S: string; Quote: char): string;
 148 function  ExtractUrlLastPath(Url: string): string;
 149 function  IsNumeric(s: string): boolean; {GikoNavi}
 150 function  Fmt2chToDateTime(Fmt2ch: String): TDateTime; {monaCommonFunc}
 151 function  StrCount1(const Substr, S: string): Integer; {monaCommonFunc}
 152 function  BackAnsiPos(const SubStr,S: String): Integer;{monaCommonFunc}
 153 function  IsFloat(s: string): boolean;
 154 function  UrlToDosPath(const Url: string): string;
 155 function  ChooseValue(const Url, Key: string): string;
 156 function  MargeUrl(const BaseUrl, NewUrl: string): string;
 157 function  ExtractHrefUrl(const s: string): string;
 158 function  ZenToHan(const s: string): string;
 159 function  GetContentLength(S : string): integer;
 160 function  TrimTag(const s: string): string;
 161 function  AddTargetBlank(const Value: string): string;
 162 function  ExtractDatNo(const DatFileName: string): string;
 163 function  DateStrToDateTime(const DateStr: string): TDateTime;
 164 //
 165 procedure testMonaUtils;
 166
 167 //
 168 //  \83N\83\89\83X\81E\83\8c\83R\81[\83h
 169 //
 170 type
 171   TMonaHtmlTokenType = (
 172     htNone,
 173     htTag,  // \83^\83O\82Ì\92\86
 174     htText  // \83^\83O\82Ì\8aO
 175     );
 176
 177   TMonaHtmlParser = class(TObject)
 178   protected
 179     p: PChar;
 180     FLine: String;
 181     FToken: String;
 182     FTokenType: TMonaHtmlTokenType;
 183     FAttributes: TStrings;
 184     procedure SetAttributes(const Value: TStrings); // Dax
 185     procedure makeAttributes(const Token: string);  // Dax
 186   public
 187     constructor Create(s: String);  virtual;
 188     destructor  Destory;  // Dax
 189     procedure Error; // \89ð\90Í\83G\83\89\81[\97á\8aO\82ð\94\90¶\82³\82¹\82é
 190     procedure Assign(s: String);
 191     procedure GetToken(ATokenType: TMonaHtmlTokenType; AToken: String; IgnoreCase: Boolean = False); overload;
 192     function GetToken: TMonaHtmlTokenType; overload;
 193     function GetToken(ATokenType: TMonaHtmlTokenType): String; overload;
 194     property Token: String read FToken;
 195     property TokenType: TMonaHtmlTokenType read FTokenType;
 196     property Attributes: TStrings   read  FAttributes write SetAttributes;  // Dax
 197   end;
 198
 199   TMonaProfiler = class(TObject)
 200   private
 201     FActive: Boolean;
 202     FStartCounter, FTotalCounter: Int64;
 203     function GetMicroSec: Integer;
 204     function GetMilliSec: Integer;
 205     function GetSec: Integer;
 206     procedure SetActive(const Value: Boolean);
 207   protected
 208     function GetCounter: Int64;
 209   public
 210     constructor Create;
 211     procedure Start;
 212     procedure Stop;
 213     procedure Clear;
 214     property Active: Boolean read FActive write SetActive;
 215     property MilliSec: Integer read GetMilliSec;
 216     property MicroSec: Integer read GetMicroSec;
 217     property Sec: Integer read GetSec;
 218   end;
 219
 220 ////////////////////////////////////////////////////////////////////////////////
 221 implementation
 222 ////////////////////////////////////////////////////////////////////////////////
 223
 224 uses
 225   MonaTest;
 226
 227 procedure MonaError(msg: String);
 228 begin
 229   raise EMonaError.Create(msg);
 230 end;
 231
 232 procedure MonaError(format: String; args: array of const);
 233 begin
 234   MonaError(SysUtils.Format(format, args));
 235 end;
 236
 237 function ExtractUrlPath(const FileName: string): string;
 238 var
 239   I: Integer;
 240 begin
 241   I := LastDelimiter('/:', FileName);
 242   Result := Copy(FileName, 1, I);
 243 end;
 244
 245 procedure testExtractUrlPath;
 246   procedure mycheck(s, s2: String);
 247   begin
 248     Check(s, ExtractUrlPath(s2));
 249   end;
 250 begin
 251   mycheck(
 252     'http://piza.2ch.net/tech/',
 253     'http://piza.2ch.net/tech/index2.html');
 254
 255   mycheck(
 256     'http://piza.2ch.net/tech/',
 257     'http://piza.2ch.net/tech/index2.html#menu');
 258
 259   mycheck(
 260     'http://',
 261     'http://www.yahoo.co.jp' );
 262
 263   mycheck(
 264     '',
 265     'www.yahoo.co.jp' );
 266 end;
 267
 268 function ExtractUrlName(const FileName: string): string;
 269 var
 270   I: Integer;
 271 begin
 272   I := LastDelimiter('/:', FileName);
 273   Result := Copy(FileName, I + 1, MaxInt);
 274 end;
 275
 276 procedure testExtractUrlName;
 277   procedure mycheck(s, s2: String);
 278   begin
 279     Check(s, ExtractUrlName(s2));
 280   end;
 281 begin
 282   mycheck(
 283     'index2.html',
 284     'http://piza.2ch.net/tech/index2.html');
 285
 286   mycheck(
 287     'index2.html#menu',
 288     'http://piza.2ch.net/tech/index2.html#menu');
 289
 290   mycheck(
 291     'www.yahoo.co.jp',
 292     'http://www.yahoo.co.jp' );
 293
 294   mycheck(
 295     'www.yahoo.co.jp',
 296     'www.yahoo.co.jp' );
 297 end;
 298
 299
 300 function Max(A, B: Integer): Integer;
 301 begin
 302   if B < A then Result := A else Result := B;
 303 end;
 304
 305 function Max(A, B: Int64): Int64;
 306 begin
 307   if B < A then Result := A else Result := B;
 308 end;
 309
 310 function Max(A, B: Single): Single;
 311 begin
 312   if B < A then Result := A else Result := B;
 313 end;
 314
 315 function Max(A, B: Double): Double;
 316 begin
 317   if B < A then Result := A else Result := B;
 318 end;
 319
 320 function Max(A, B: Extended): Extended;
 321 begin
 322   if B < A then Result := A else Result := B;
 323 end;
 324
 325 function Min(A, B: Integer): Integer;
 326 begin
 327   if A < B then Result := A else Result := B;
 328 end;
 329
 330 function Min(A, B: Int64): Int64; overload;
 331 begin
 332   if A < B then Result := A else Result := B;
 333 end;
 334
 335 function Min(A, B: Single): Single; overload;
 336 begin
 337   if A < B then Result := A else Result := B;
 338 end;
 339
 340 function Min(A, B: Double): Double; overload;
 341 begin
 342   if A < B then Result := A else Result := B;
 343 end;
 344
 345 function Min(A, B: Extended): Extended; overload;
 346 begin
 347   if A < B then Result := A else Result := B;
 348 end;
 349
 350 procedure testMaxMin;
 351 var
 352   LowInteger, HighInteger: Integer;
 353   LowInt64, HighInt64: Int64;
 354   LowSingle, HighSingle: Single;
 355   LowDouble, HighDouble: Double;
 356   LowExtended, HighExtended: Extended;
 357 begin
 358   LowInteger := Low(Integer) ; HighInteger := High(Integer);
 359   LowInt64 := Low(Int64); HighInt64 := High(Int64);
 360   LowSingle := -PI; HighSingle := PI;
 361   LowDouble := -PI; HighDouble := PI;
 362   LowExtended := -PI; HighExtended := PI;
 363   Check(
 364     HighInteger,
 365     Max(LowInteger, HighInteger));
 366   Check(
 367     HighInt64,
 368     Max(LowInt64, HighInt64));
 369   Check(
 370     HighSingle,
 371     Max(LowSingle, HighSingle));
 372   Check(
 373     HighDouble,
 374     Max(LowDouble, HighDouble));
 375   Check(
 376     HighExtended,
 377     Max(LowExtended, HighExtended));
 378   Check(
 379     LowInteger,
 380     Min(LowInteger, HighInteger));
 381   Check(
 382     LowInt64,
 383     Min(LowInt64, HighInt64));
 384   Check(
 385     LowSingle,
 386     Min(LowSingle, HighSingle));
 387   Check(
 388     LowDouble,
 389     Min(LowDouble, HighDouble));
 390   Check(
 391     LowExtended,
 392     Min(LowExtended, HighExtended));
 393 end;
 394
 395
 396
 397 //\83t\83@\83C\83\8b\96¼\82Ì\96\96\94ö\82É'\'\82ð\92Ç\89Á\82·\82é\8aÖ\90\94
 398 function IncludeTrailingSlash(const S: string): string;
 399 begin
 400   Result := S;
 401   if not IsUrlDelimiter(Result, Length(Result)) then
 402     Result := Result + '/';
 403 end;
 404
 405 procedure testIncludeTrailingSlash;
 406   procedure mycheck(s, s2: string);
 407   begin
 408     Check(s, IncludeTrailingSlash(s2));
 409   end;
 410 begin
 411     mycheck(
 412       'http://www.yahoo.co.jp/',
 413       'http://www.yahoo.co.jp' );
 414     mycheck(
 415       'http://www.yahoo.co.jp/',
 416       'http://www.yahoo.co.jp/' );
 417 end;
 418
 419 //\83t\83@\83C\83\8b\96¼\82Ì\96\96\94ö\82©\82ç'\'\82ð\8eæ\82è\8f\9c\82\8aÖ\90\94
 420 function ExcludeTrailingSlash(const S: string): string;
 421 begin
 422   Result := S;
 423   if IsUrlDelimiter(Result, Length(Result)) then
 424     SetLength(Result, Length(Result)-1);
 425 end;
 426
 427 procedure testExcludeTrailingSlash;
 428   procedure mycheck(s, s2: String);
 429   begin
 430     Check(s, ExcludeTrailingSlash(s2));
 431   end;
 432 begin
 433   mycheck(
 434     'http://www.yahoo.co.jp',
 435     'http://www.yahoo.co.jp/' );
 436   mycheck(
 437     'http://www.yahoo.co.jp',
 438     'http://www.yahoo.co.jp' );
 439 end;
 440
 441 function IsUrlDelimiter(const S: string; Index: Integer): Boolean;
 442 begin
 443   Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = '/')
 444     and (ByteType(S, Index) = mbSingleByte);
 445 end;
 446
 447 procedure testIsUrlDelimiter;
 448   procedure mycheck(b: Boolean; s: String; Index: Integer);
 449   begin
 450     Check(b, IsUrlDelimiter(s, Index));
 451   end;
 452 begin
 453   mycheck(
 454     True,
 455     'http://www.yahoo.co.jp/index.htm', 6 );
 456   mycheck(
 457     False,
 458     'http://www.yahoo.co.jp/index.htm', 3 );
 459 end;
 460
 461 //\83t\83@\83C\83\8b\82©\82ç\95¶\8e\9a\97ñ\82ð\93Ç\82Ý\8d\9e\82Þ
 462 function LoadStringFromFile(const FileName: String): String;
 463 var
 464   size: Integer;
 465   F: File;
 466 begin
 467   size := FindFile(FileName).Size;
 468   if size = 0 then
 469   begin
 470     Result := '';
 471     Exit;
 472   end;
 473
 474   try
 475     SetLength(Result, size);
 476     AssignFile(F, FileName);
 477     Reset(F, size);
 478     BlockRead(F, PChar(Result)^, 1);
 479   finally
 480     CloseFile(F);
 481   end;
 482 end;
 483
 484 procedure SaveStringToFile(const FileName, Str: String);
 485 var
 486   path: String;
 487   F: File;
 488 begin
 489   path := ExtractFileDir(FileName);
 490   if (path <> '') and not DirectoryExists(path) then
 491     {$IFDEF VER130}
 492     if ForceDirectories(path) then
 493       MonaError('\83f\83B\83\8c\83N\83g\83\8a%s\82ª\8dì\82ê\82Ü\82¹\82ñ\81B', [path]);
 494       {\83E\83G(\81L\84D\81M) \83t\83H\83\8b\83_\82ª\91¶\8dÝ\82µ\82È\82¢\8fê\8d\87\8dì\90¬\82·\82é}
 495     {$ELSE}
 496     try
 497       ForceDirectories(path);
 498     except
 499       MonaError('\83f\83B\83\8c\83N\83g\83\8a%s\82ª\8dì\82ê\82Ü\82¹\82ñ\81B', [path]);
 500     end;
 501     {$ENDIF}
 502   try
 503     AssignFile(F, FileName);
 504     Rewrite(F, Length(Str));
 505     if Length(Str) > 0 then
 506       BlockWrite(F, PChar(Str)^, 1);
 507   finally
 508     CloseFile(F);
 509   end;
 510 end;
 511
 512 procedure testLoadSaveString;
 513   procedure mycheck(s: String);
 514   var s2: String;
 515   begin
 516     try
 517       SaveStringToFile('testString.txt', s);
 518       s2 := LoadStringFromFile('testString.txt');
 519       Check(s, s2, 'testLoadSaveString');
 520     except
 521       on E:Exception do Error(E);
 522     end;
 523   end;
 524 begin
 525   mycheck('hello,world');
 526   {$IFDEF LINUX}
 527   {$ELSE}
 528   mycheck(''); //Kylix \82Å\82Í\83G\83\89\81[
 529                //\83v\83\8d\83W\83F\83N\83g Project1 \82ª EInOutError \83N\83\89\83X\82Ì\97á\8aO\82ð\90¶\90¬\82µ\82Ü\82µ\82½\81B
 530                //'\93ü\97Í\92l\82ª\90\94\92l\82Å\82Í\82 \82è\82Ü\82¹\82ñ'
 531   {$ENDIF}
 532   mycheck('test' + #13 + 'LoadString' + #10 + 'SaveString' + #13 + #10 + 'xxx');
 533 end;
 534
 535 function FindFile(const FileName: String): TSearchRec;
 536 begin
 537   if FindFirst(FileName, faAnyFile, Result) = 0 then
 538     FindClose(Result)
 539   else
 540     MonaError('%s\82Ì\8fî\95ñ\82Ì\8eæ\93¾\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B', [FileName]);
 541 end;
 542
 543 procedure testFindFile;
 544 var
 545   sl: TStringList;
 546 begin
 547   sl := TStringList.Create;
 548   try
 549     sl.Text := 'hello,world';
 550     sl.SaveToFile('fileinfo.txt');
 551     with FindFile('fileinfo.txt') do
 552     begin
 553       Check(Size, Length(sl.Text));
 554       Check(Name, 'fileinfo.txt');
 555     end;
 556   finally
 557     sl.Free;
 558   end;
 559 end;
 560
 561 { TMonaHtmlParser }
 562 procedure TMonaHtmlParser.Error;
 563 begin
 564   MonaError('HTML\82Ì\89ð\90Í\82É\8e¸\94s\82µ\82Ü\82µ\82½:%s', [p]);
 565 end;
 566
 567 constructor TMonaHtmlParser.Create(s: String);
 568 begin
 569   FAttributes :=  TStringList.Create;
 570   Assign(s);
 571 end;
 572
 573 procedure TMonaHtmlParser.Assign(s: String);
 574 begin
 575   FLine := s;
 576   p := PChar(s);
 577 end;
 578
 579 function TMonaHtmlParser.GetToken: TMonaHtmlTokenType;
 580 begin
 581   FToken := '';
 582   while True do
 583     case p^ of
 584     #10, #13:
 585       Inc(p);
 586     else
 587       break;
 588     end;
 589
 590   case p^ of
 591   #0:
 592     FTokenType := htNone;
 593
 594   '<':
 595   begin
 596     FTokenType := htTag;
 597     while True do
 598     begin
 599       Inc(p);
 600       case p^ of
 601       #10, #13:
 602         ;
 603       #0, '<':
 604         Error;
 605       '>':
 606         begin
 607           makeAttributes(FToken); // add Dax 2001/10/30
 608                                 Break;
 609         end;
 610       else
 611         FToken := FToken + p^;
 612       end;
 613     end;
 614     Inc(p);
 615   end;
 616
 617   else
 618     FTokenType := htText;
 619     while True do
 620     begin
 621       case p^ of
 622       #10, #13:
 623         ;
 624       #0, '<':
 625         Break;
 626
 627       '>':
 628         Error;
 629       else
 630         FToken := FToken + p^;
 631       end;
 632       Inc(p);
 633     end;
 634   end;
 635
 636   Result := FTokenType;
 637 end;
 638
 639 function TMonaHtmlParser.GetToken(ATokenType: TMonaHtmlTokenType): String;
 640 begin
 641   if GetToken <> ATokenType then
 642     Error;
 643   Result := Token;
 644 end;
 645
 646 procedure TMonaHtmlParser.GetToken(ATokenType: TMonaHtmlTokenType;
 647   AToken: String; IgnoreCase: Boolean);
 648 begin
 649   if IgnoreCase then
 650   begin
 651     if UpperCase(GetToken(ATokenType)) <> UpperCase(AToken) then
 652       Error;
 653   end else begin
 654     if GetToken(ATokenType) <> AToken then
 655       Error;
 656   end;
 657 end;
 658
 659
 660 destructor TMonaHtmlParser.Destory;
 661 begin
 662   FAttributes.Free;
 663 end;
 664
 665 procedure TMonaHtmlParser.makeAttributes(const Token: string);
 666 var
 667   x, xend : PChar;
 668   Attr  : string;
 669   S : string;
 670 begin
 671   //'<AAA BBB=CCC DDD=EEE>'
 672   x       :=  PChar(Token);
 673   xend    :=  PChar(Token) + Length(Token) + 1;
 674   S := '';
 675   while (x < xend)  do  begin
 676     if  (x^ = ' ') or (x^ = #0) then  begin
 677       if  (Attr <> '')  then  begin
 678         FAttributes.Values[Attr]  :=  S;
 679       end;
 680       Attr  :=  '';
 681       S     :=  '';
 682     end else
 683     if  (x^ = '=')  then  begin
 684       Attr  :=  S;
 685       S     :=  '';
 686     end else begin
 687       S :=  S + x^;
 688     end;
 689     inc(x);
 690   end;
 691 end;
 692
 693 procedure TMonaHtmlParser.SetAttributes(const Value: TStrings);
 694 begin
 695   FAttributes.Assign(Value);
 696 end;
 697
 698 procedure testMonaHtmlParser;
 699 var
 700   parser: TMonaHtmlParser;
 701
 702 begin
 703   parser := TMonaHtmlParser.Create( // TStrings.Text\82È\82Ç\82ð\93n\82·
 704     '<!-- saved from url=(0032)http://www.2ch.net/bbstable.html -->' +
 705     '<html>' +#10+
 706       '<HEAD>' +#13+
 707         '<TITLE>BBS TABLE for 2ch</TITLE>' +
 708       '</HEAD>' +#13+
 709       '<Body>' +#13+#10+
 710         '\81y<B>\93é\82ê\8d\87\82¢</B>\81z' +
 711         '<A href="http://piza.2ch.net/intro/index2.html">\8e©\8cÈ\8fÐ\89î</A>' +
 712       '</Body>' +#10+#13+
 713     '</html>' +#10
 714   );
 715   with parser do
 716   try
 717     // \89ü\8ds\95¶\8e\9a\82Í\82·\82×\82Ä\96³\8e\8b\81A\91å\95¶\8e\9a\8f¬\95¶\8e\9a\82Í\8bæ\95Ê\81A
 718     // \83e\83L\83X\83g\81E\83^\83O\82Ì\92\86\90g\82Í\89ð\8eß\82¹\82¸\82É\82»\82Ì\82Ü\82Ü\95Ô\82·\81B
 719     GetToken(htTag,  '!-- saved from url=(0032)http://www.2ch.net/bbstable.html --');
 720 //    GetToken;(htTag,  'html');
 721     GetToken;
 722     Check(TokenType = htTag, 'GetToken = htTag');
 723     Check(Token, 'html');
 724
 725 //    GetToken(htTag,  'HEAD');
 726     Check(GetToken(htTag), 'HEAD');
 727
 728     GetToken(htTag,  'TITLE');
 729     GetToken(htText, 'BBS TABLE for 2ch');
 730     GetToken(htTag,  '/title', True);
 731     GetToken(htTAG,  '/HEAD');
 732     GetToken(htTag,  'Body');
 733     GetToken(htText, '\81y');
 734     GetToken(htTag,  'B');
 735     GetToken(htText, '\93é\82ê\8d\87\82¢');
 736     GetToken(htTag,  '/B');
 737     GetToken(htText, '\81z');
 738     GetToken(htTag,  'A href="http://piza.2ch.net/intro/index2.html"');
 739     GetToken(htText, '\8e©\8cÈ\8fÐ\89î');
 740     GetToken(htTag,  '/A');
 741     GetToken(htTag,  '/Body');
 742     GetToken(htTag,  '/html');
 743     Check(GetToken = htNone); // \82¨\82µ\82Ü\82¢
 744   finally
 745     Free;
 746   end;
 747 end;
 748
 749 { TMonaProfiler }
 750
 751 // PerformanceCounter\97p
 752 var TMonaProfiler_FFrequency: Int64;
 753
 754 procedure TMonaProfiler.Clear;
 755 begin
 756   FTotalCounter := 0;
 757   if FActive then
 758     FStartCounter := GetCounter;
 759 end;
 760
 761 constructor TMonaProfiler.Create;
 762 begin
 763   Clear;
 764 end;
 765
 766 function TMonaProfiler.GetCounter: Int64;
 767 begin
 768   {$IFDEF LINUX}
 769     //
 770   {$ELSE}
 771     if not QueryPerformanceCounter(Result) then
 772       RaiseLastWin32Error;
 773   {$ENDIF}
 774 end;
 775
 776 function TMonaProfiler.GetMicroSec: Integer;
 777 var
 778   counter: Int64;
 779 begin
 780   counter := FTotalCounter;
 781   if FActive then
 782     Inc(counter, GetCounter - FStartCounter);
 783   try
 784     Result := Round(counter / TMonaProfiler_FFrequency * 1000000);
 785   except
 786     Result  :=  0;
 787   end;
 788 end;
 789
 790 function TMonaProfiler.GetMilliSec: Integer;
 791 var
 792   counter: Int64;
 793 begin
 794   counter := FTotalCounter;
 795   if FActive then
 796     Inc(counter, GetCounter - FStartCounter);
 797   try
 798     Result := Round(counter / TMonaProfiler_FFrequency * 1000);
 799   except
 800     Result  :=  0;
 801   end;
 802 end;
 803
 804 function TMonaProfiler.GetSec: Integer;
 805 var
 806   counter: Int64;
 807 begin
 808   counter := FTotalCounter;
 809   if FActive then
 810     Inc(counter, GetCounter - FStartCounter);
 811   try
 812     Result := Round(counter / TMonaProfiler_FFrequency);
 813   except
 814     Result  :=  0;
 815   end;
 816 end;
 817
 818 procedure TMonaProfiler.SetActive(const Value: Boolean);
 819 begin
 820   FActive := Value;
 821   if FActive then
 822     Start
 823   else
 824     Stop;
 825 end;
 826
 827 procedure TMonaProfiler.Start;
 828 begin
 829   if FActive then
 830     Exit;
 831   FActive := True;
 832   FStartCounter := GetCounter;
 833 end;
 834
 835 procedure TMonaProfiler.Stop;
 836 begin
 837   if not FActive then
 838     Exit;
 839   Inc(FTotalCounter, GetCounter - FStartCounter);
 840   FActive := False;
 841 end;
 842
 843 procedure testMonaProfiler;
 844 var
 845   profiler: TMonaProfiler;
 846 begin
 847   profiler := TMonaProfiler.Create;
 848   try
 849     profiler.Start; // \8aJ\8en
 850     Sleep(500);
 851     profiler.Stop;
 852     Check(500, (profiler.MilliSec + 50) div 100 * 100);
 853
 854     Sleep(500);
 855
 856     profiler.Start; // \8dÄ\8aJ
 857     Sleep(1000);
 858     Check(1500, (profiler.MilliSec + 50) div 100 * 100); // \89Ò\93®\92\86\82Å\82àOK
 859     profiler.Stop;
 860
 861     profiler.Clear;
 862     Check(0, profiler.MicroSec);
 863     profiler.Start; // \8aJ\8en
 864     Sleep(500);
 865     profiler.Stop;
 866     Check(500*1000, (profiler.MicroSec + 50) div 1000 * 1000);
 867   finally
 868   end;
 869 end;
 870
 871 procedure ShellOpen(const FileName: String); // \82Æ\82É\82©\82\8aJ\82
 872 begin
 873   {$IFDEF WINDOWS}
 874     if 32 >= ShellExecute(Application.Handle, 'open', PChar(FileName), nil, nil, sw_show) then
 875       RaiseLastWin32Error;
 876   {$ELSE}
 877     // ??\82È\82ñ\82¾\82ë\82Ë??
 878   {$ENDIF}
 879 end;
 880
 881 (*
 882 function AddHRefTag(s: string): string;
 883 const
 884   NORMAL_CHAR: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789:/.%?&#=-_~+*;!^`\|@[]{}$,';
 885 var
 886   url: string;
 887   i: Integer;
 888   idx: Integer;
 889 begin
 890   Result := '';
 891
 892   while True do begin
 893     idx := AnsiPos('http://', s);
 894
 895     if idx = 0 then begin
 896       //\83\8a\83\93\83N\82ª\96³\82¢\81[\82æ\81B
 897       Result := Result + s;
 898       Break;
 899     end;
 900
 901     Result := Result + Copy(s, 0, idx - 1);
 902
 903     s := Copy(s, idx, length(s));
 904
 905     for i := 0 to Length(s) do begin
 906
 907       idx := AnsiPos(s[i + 1], NORMAL_CHAR);
 908
 909       if (idx = 0) or (i = (Length(s))) then begin
 910         //URL\82¶\82á\82È\82¢\95¶\8e\9a\94\8c©\81I\82Æ\82©\81A\95¶\8e\9a\82ª\82È\82\82È\82Á\82½\81B
 911         url := Copy(s, 0, i);
 912
 913         Result := Result + '<a href="' + url + '" target="_blank">' + url + '</a>';
 914         s := Copy(s, i + 1, Length(s));
 915         Break;
 916       end;
 917     end;
 918   end;
 919 end;
 920 *)
 921 function AddHRefTag(s: string): string;
 922 const
 923   NORMAL_CHAR: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789:/.%?&#=-_~+*;!^`\|@[]{}$,';
 924 var
 925   url: string;
 926   i, x: Integer;
 927   idx, idx1, idx2, idx3, idx4: Integer;
 928   prefix: string;
 929   s1: string;
 930 begin
 931   Result := '';
 932
 933   while True do begin
 934     idx1 := AnsiPos('http://', s);
 935     idx2 := AnsiPos('ttp://', s);
 936     idx3 := AnsiPos('www.', s);
 937
 938     if  (idx1 > 1) then  begin
 939       for x :=  idx1  downto  1 do  begin
 940         if  (s[x] = '>')  then  begin
 941           Break;
 942         end else
 943         if  (s[x] = '<')  then  begin
 944           idx1  :=  0;
 945           idx2  :=  0;
 946           idx3  :=  0;
 947           Break;
 948         end;
 949       end;
 950     end;
 951     if  (idx1 > 4) then  begin
 952       s1  :=  AnsiLowerCase(Copy(s, idx1 - 4, 4));
 953       if  (s1 <> '<br>')  and
 954           (s[idx1 - 1] = '>') then
 955       begin
 956         idx1  :=  0;
 957         idx2  :=  0;
 958         idx3  :=  0;
 959       end;
 960     end;
 961     if  ((idx3 < idx2) and (idx3 > 0)) or ((idx3 > 0) and (idx2 = 0)) then  begin
 962       // www
 963       idx  :=  idx3;
 964       prefix:=  'http://';
 965     end else
 966     if  (idx2 < idx1) or ((idx2 > 0) and (idx1 = 0)) then  begin
 967       // ttp
 968       idx  :=  idx2;
 969       prefix:=  'h';
 970     end else begin
 971       idx  :=  idx1;
 972       prefix:=  '';
 973     end;
 974
 975     if (idx1 = 0) and (idx2 = 0) and (idx3 = 0) then begin
 976       //\83\8a\83\93\83N\82ª\96³\82¢\81[\82æ\81B
 977       Result := Result + s;
 978       Break;
 979     end;
 980
 981     Result := Result + Copy(s, 0, idx - 1);
 982     s := Copy(s, idx, length(s));
 983     for i := 0 to Length(s) - 1 do begin
 984       idx4 := AnsiPos(s[i + 1], NORMAL_CHAR);
 985       if (idx4 = 0) then  begin
 986         url := Copy(s, 0, i);
 987         Result := Result + '<a href="' + prefix + url + '" target="_blank">' + url + '</a>';
 988         s := Copy(s, i + 1, Length(s));
 989         Break;
 990       end else
 991       if (i = (Length(s) - 1)) then begin
 992         //URL\82¶\82á\82È\82¢\95¶\8e\9a\94\8c©\81I\82Æ\82©\81A\95¶\8e\9a\82ª\82È\82\82È\82Á\82½\81B
 993         url := Copy(s, 0, i + 1);
 994         Result := Result + '<a href="' + prefix + url + '" target="_blank">' + url + '</a>';
 995         s := Copy(s, i + 2, Length(s));
 996         Break;
 997       end;
 998     end;
 999   end;
1000 end;
1001
1002 procedure testAddHRefTag;
1003   procedure mycheck(s, s2: String);
1004   begin
1005     Check(s, AddHRefTag(s2));
1006   end;
1007 begin
1008   mycheck(
1009     '<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>',
1010     'http://piza.2ch.net/tech/');
1011   mycheck(
1012     '\8fÚ\8d×\82Í\83R\83R<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>',
1013     '\8fÚ\8d×\82Í\83R\83Rhttp://piza.2ch.net/tech/');
1014   mycheck(
1015     '<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>\82¾\82æ',
1016     'http://piza.2ch.net/tech/\82¾\82æ');
1017   mycheck(
1018     '<a href="http://piza.2ch.net/tech/index2.html#menu" target="_blank">http://piza.2ch.net/tech/index2.html#menu</a>',
1019     'http://piza.2ch.net/tech/index2.html#menu');
1020   mycheck(
1021     '<a href="http://www.yahoo.com" target="_blank">http://www.yahoo.com</a>\82¾\82Á\82½\82è<a href="http://www.goo.ne.jp" target="_blank">http://www.goo.ne.jp</a>\82¾\82Á\82½\82è',
1022     'http://www.yahoo.com\82¾\82Á\82½\82èhttp://www.goo.ne.jp\82¾\82Á\82½\82è');
1023   mycheck(
1024     'https://piza.2ch.net/tech/index2.html#menu',
1025     'https://piza.2ch.net/tech/index2.html#menu');
1026   mycheck(
1027     '<a href="http://piza.2ch.net/tech/index2.html#menu0" target="_blank">http://piza.2ch.net/tech/index2.html#menu0</a>',
1028     'http://piza.2ch.net/tech/index2.html#menu0');
1029   mycheck(
1030     'http\82Å\8en\82Ü\82é',
1031     'http\82Å\8en\82Ü\82é');
1032   mycheck(
1033     '',
1034     '');
1035   mycheck(
1036     '<a href="http://www.2ch.net/tech/" target="_blank">www.2ch.net/tech/</a>',
1037     'www.2ch.net/tech/');
1038   mycheck(
1039     'www\82Æ\82©',
1040     'www\82Æ\82©');
1041   mycheck(
1042     'www ',
1043     'www ');
1044 end;
1045
1046 //
1047 //  \95¶\8e\9a\97ñ\92\86\82©\82ç <A HREF="xxx"> </A>\83^\83O\82ð\8eæ\82è\8f\9c\82«\82Ü\82·
1048 //
1049 function TrimHRefTag(const S: string): string;
1050 var
1051   x, y : integer;
1052   BodyText : string;
1053 begin
1054   BodyText  :=  StringReplace(S,'</A>', '', [rfReplaceAll,rfIgnoreCase]);
1055   while True do  begin
1056     x :=  Pos('<a ',AnsiLowerCase(BodyText));
1057     if (AnsiPos('>',AnsiLowerCase(BodyText)) = 0) then  begin
1058       Break;
1059     end;
1060     y :=  x;
1061     if  (x > 0) then  begin
1062       while true  do  begin
1063         if  (BodyText[y] = '>') and (ByteType(BodyText, y) = mbSingleByte)  then
1064         begin
1065           BodyText  :=  Copy(BodyText,1, x-1) +
1066                         Copy(BodyText,y + 1, Length(BodyText));
1067           break;
1068         end else begin
1069           inc(y);
1070           if  (y > Length(BodyText)) then  Break;
1071         end;
1072       end;
1073     end else begin
1074       Break;
1075     end;
1076   end;
1077   Result  :=  BodyText;
1078 end;
1079
1080 procedure testTrimHRefTag;
1081   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1082   begin
1083     Check(s, TrimHRefTag(s2));
1084   end;
1085 begin
1086   mycheck(
1087     'http://piza.2ch.net/tech/',
1088     '<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>');
1089   mycheck(
1090     '\8fÚ\8d×\82Í\83R\83Rhttp://piza.2ch.net/tech/',
1091     '\8fÚ\8d×\82Í\83R\83R<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>');
1092   mycheck(
1093     'http://piza.2ch.net/tech/\82¾\82æ',
1094     '<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>\82¾\82æ');
1095   mycheck(
1096     'http://piza.2ch.net/tech/index2.html#menu',
1097     '<a href="http://piza.2ch.net/tech/index2.html#menu" target="_blank">http://piza.2ch.net/tech/index2.html#menu</a>');
1098   mycheck(
1099     'http://www.yahoo.com\82¾\82Á\82½\82èhttp://www.goo.ne.jp\82¾\82Á\82½\82è',
1100     '<a href="http://www.yahoo.com" target="_blank">http://www.yahoo.com</a>\82¾\82Á\82½\82è<a href="http://www.goo.ne.jp" target="_blank">http://www.goo.ne.jp</a>\82¾\82Á\82½\82è');
1101   mycheck(
1102     'https://piza.2ch.net/tech/index2.html#menu',
1103     'https://piza.2ch.net/tech/index2.html#menu');
1104   mycheck(
1105     'http\82Å\8en\82Ü\82é',
1106     'http\82Å\8en\82Ü\82é');
1107   mycheck(
1108     '',
1109     '');
1110 end;
1111
1112 function DecodeHtmlEsc(const s: string): string;
1113 var
1114   DispText : string;
1115 begin
1116   DispText  :=  StringReplace(S, '<br>', #13#10, [rfIgnoreCase, rfReplaceAll]);
1117   DispText  :=  StringReplace(DispText, '&lt;', '<', [rfIgnoreCase, rfReplaceAll]);
1118   DispText  :=  StringReplace(DispText, '&gt;', '>', [rfIgnoreCase, rfReplaceAll]);
1119   DispText  :=  StringReplace(DispText, '&quot;', '"', [rfIgnoreCase, rfReplaceAll]);
1120   DispText  :=  StringReplace(DispText, '&amp;', '&', [rfIgnoreCase, rfReplaceAll]);
1121   DispText  :=  StringReplace(DispText, '&nbsp;', ' ', [rfIgnoreCase, rfReplaceAll]);
1122   Result    :=  DispText;
1123 end;
1124
1125 procedure testDecodeHtmlEsc;
1126   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1127   begin
1128     Check(s, DecodeHtmlEsc(s2));
1129   end;
1130 begin
1131   mycheck(
1132     '<HTML&XML>',
1133     '&lt;HTML&amp;XML&gt;');
1134   mycheck(
1135     'BR' + #13#10  + 'BR' + #13#10#13#10,
1136     'BR<BR>BR<BR><BR>');
1137   mycheck(
1138     '<">',
1139     '&LT;&quot;&GT;');
1140   mycheck(
1141     '  ',
1142     '&nbsp;&nbsp;');
1143   mycheck(
1144     '',
1145     '');
1146 end;
1147
1148 function EncodeHtmlEsc(const s: string): string;
1149 var
1150   DispText : string;
1151 begin
1152   DispText  :=  StringReplace(S, '&', '&amp;', [rfReplaceAll]);
1153   DispText  :=  StringReplace(DispText, '<', '&lt;', [rfReplaceAll]);
1154   DispText  :=  StringReplace(DispText, '>', '&gt;', [rfReplaceAll]);
1155   DispText  :=  StringReplace(DispText, '"', '&quot;', [rfReplaceAll]);
1156   DispText  :=  StringReplace(DispText, #13#10, '<br>', [rfReplaceAll]);
1157   Result    :=  DispText;
1158 end;
1159
1160 procedure testEncodeHtmlEsc;
1161   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1162   begin
1163     Check(s, EncodeHtmlEsc(s2));
1164   end;
1165 begin
1166   mycheck(
1167     '&lt;HTML&amp;XML&gt;',
1168     '<HTML&XML>');
1169   mycheck(
1170     'BR<br>BR<br><br>',
1171     'BR' + #13#10  + 'BR' + #13#10#13#10);
1172   mycheck(
1173     '&lt;&quot;&gt;',
1174     '<">');
1175   mycheck(
1176     '',
1177     '');
1178 end;
1179
1180 function ExtractHostName(const Url: string): string;
1181 const
1182   PRE = 'http://';
1183 var
1184   n : integer;
1185 begin
1186   if  (AnsiPos(PRE, Url) = 1) then  begin
1187     n :=  Pos('/', Copy(Url,Length(PRE)+1,Length(Url))) - 1;
1188     if  (n < 0) then  n :=  Length(Url) - Length(PRE);
1189     Result :=  Copy(Url, Length(PRE) + 1, n);
1190   end else begin
1191     Result  :=  '';
1192   end;
1193 end;
1194
1195 procedure testExtractHostName;
1196   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1197   begin
1198     Check(s, ExtractHostName(s2));
1199   end;
1200 begin
1201   mycheck(
1202     'www.2ch.net',
1203     'http://www.2ch.net/');
1204
1205   mycheck(
1206     'piza.2ch.net',
1207     'http://piza.2ch.net/tech/index2.html');
1208
1209   mycheck(
1210     'piza.2ch.net',
1211     'http://piza.2ch.net/tech/index2.html#menu');
1212
1213   mycheck(
1214     'www.yahoo.co.jp',
1215     'http://www.yahoo.co.jp' );
1216
1217   mycheck(
1218     '',
1219     'www.yahoo.co.jp' );
1220   mycheck(
1221     '',
1222     '');
1223 end;
1224
1225 function Get2chDate(aDate: TDateTime): string;
1226 var
1227   d1: TDateTime;
1228   d2: TDateTime;
1229 begin
1230   d1 := EncodeDate(1970, 1, 1);
1231   d2 := aDate - EncodeTime(9, 0, 0, 0);
1232   Result := FloatToStr(Trunc((d2 - d1) * 24 * 60 * 60));
1233 end;
1234
1235 function GetDatSince(aDatNo: string): string;
1236 var
1237   s:  string;
1238   v:  double;
1239   ad: TDateTime;
1240   d1: TDateTime;
1241 begin
1242   if  (AnsiPos('_', aDatNo) > 0)  then  begin
1243     s :=  Copy(aDatNo, 1, AnsiPos('_', aDatNo) - 1);  //\82µ\82½\82ç\82Î\91Î\89\9e
1244   end else begin
1245     s :=  aDatNo;
1246   end;
1247   if  (TryStrToFloat(s, v)) then  begin
1248     v   :=  StrToFloat(s);
1249     ad  :=  v / 60 / 60 / 24;
1250     d1  :=  EncodeDate(1970, 1, 1);
1251     ad  :=  (ad + EncodeTime(9,0,0,0))  + d1;
1252     Result  :=  FormatDateTime('yyyy/mm/dd h:m:s', ad);
1253   end else begin
1254     Result  :=  '';
1255   end;
1256 end;
1257
1258 procedure testGet2chDate;
1259   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: TDateTime);
1260   begin
1261     Check(s, Get2chDate(s2));
1262   end;
1263 begin
1264   mycheck(
1265     '986094000',
1266     StrToDateTime('2001/04/01 12:00:00'));
1267
1268   mycheck(
1269     '1078023600',
1270     StrToDateTime('2004/02/29 12:00:00'));
1271 end;
1272
1273 function ChooseString(const Text, Separator: string; Index: integer): string;
1274 var
1275   S : string;
1276   i, p : integer;
1277 begin
1278   S :=  Text;
1279   for i :=  0 to  Index - 1 do  begin
1280     if  (AnsiPos(Separator, S) = 0) then  S :=  ''
1281     else  S :=  Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
1282   end;
1283   p :=  AnsiPos(Separator, S);
1284   if  (p > 0) then  Result  :=  Copy(S, 1, p - 1) else Result :=  S;
1285 end;
1286
1287 procedure testChooseString;
1288   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2, s3{\8aÖ\90\94\82É\93n\82·\93à\97e}: String;
1289                     n: integer);
1290   begin
1291     Check(s, ChooseString(s2, s3, n));
1292   end;
1293 begin
1294   mycheck(
1295     'a',
1296     'a/b/c/', '/', 0);
1297
1298   mycheck(
1299     'b',
1300     'a/b/c/', '/', 1);
1301
1302   mycheck(
1303     'c',
1304     'a/b/c/', '/', 2);
1305
1306   mycheck(
1307     '',
1308     'a/b/c/', '/', 3);
1309
1310   mycheck(
1311     '',
1312     'a/b/c', '/', 3);
1313
1314   mycheck(
1315     'arakabu',
1316     'http://www.2ch.com/arakabu/', '/', 3);
1317
1318   mycheck(
1319     '\82É\82È\82é',
1320     '\82±\82Ì\96Ø\82È\82ñ\82Ì\96Ø\96Ø\82É\82È\82é\96Ø', '\96Ø', 3);
1321
1322   mycheck(
1323     'C++Builder',
1324     'BorlandDelphiBorlandC++BuilderBorlandKylix', 'Borland', 2);
1325
1326   mycheck(
1327     '',
1328     '', '/', 0);
1329 end;
1330
1331 function ExtractQuotedStr(S: string; Quote: char): string;
1332 begin
1333   if  (Length(S) > 1) then  begin
1334     if  (S[1] = Quote) and (Copy(S, Length(S), 1) = Quote)  then  begin
1335       Result  :=  Copy(S, 2, Length(S) - 2);
1336     end else begin
1337       Result  :=  S;
1338     end;
1339   end else begin
1340     Result  :=  S;
1341   end;
1342 end;
1343
1344 procedure testExtractQuotedStr;
1345   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String; s3: char);
1346   begin
1347     Check(s, ExtractQuotedStr(s2, s3));
1348   end;
1349 begin
1350   mycheck('ABC',    '"ABC"',  '"');
1351   mycheck('ABC ',   '"ABC "', '"');
1352   mycheck('ABC',    'ABC',    '"');
1353   mycheck('"ABC"',  '"ABC"',  '''');
1354   mycheck('""',     '""""',   '"');
1355   mycheck('A',      'A',      '"');
1356   mycheck('',       '',       '"');
1357 end;
1358
1359 function ExtractUrlLastPath(Url: string): string;
1360 var
1361   I: Integer;
1362 begin
1363   if  (Length(Url) > 0) then  begin
1364     if  (Url[Length(Url)] <> '/')  then Url :=  ExtractURLPath(Url);
1365     Url :=  Copy(Url,1,Length(Url) - 1);
1366     I := LastDelimiter('/:', Url);
1367     Result := Copy(Url, I + 1, Length(Url) - I);
1368   end else begin
1369     Result  :=  '';
1370   end;
1371 end;
1372
1373 procedure testExtractURLLastPath;
1374   procedure mycheck(s{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1375   begin
1376     Check(s, ExtractURLLastPath(s2));
1377   end;
1378 begin
1379   mycheck('www.2ch.net',  'http://www.2ch.net/');
1380   mycheck('tech',         'http://piza.2ch.net/tech/index2.html');
1381   mycheck('tech',         'http://piza.2ch.net/tech/index2.html#menu');
1382   mycheck('',             'http://www.yahoo.co.jp' );
1383   mycheck('',             'www.yahoo.co.jp' );
1384   mycheck('','');
1385 end;
1386
1387 function IsNumeric(s: string): boolean;
1388 begin
1389   try
1390         StrToInt(s);
1391         Result := true;
1392   except
1393     on EConvertError do
1394         Result := false;
1395   end;
1396
1397 end;
1398
1399 procedure testIsNumeric;
1400   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: boolean; s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1401   begin
1402     Check(r, IsNumeric(s2));
1403   end;
1404 begin
1405   mycheck(True, '12345');
1406   mycheck(True, '-12345');
1407   mycheck(False,'123.45');
1408   mycheck(False,'12345F' );
1409   mycheck(True,  '+50');
1410   mycheck(False,'\82P\82Q\82R\82S\82T');
1411   mycheck(False,'');
1412 end;
1413
1414 function IsFloat(s: string): boolean;
1415 var
1416   v: Extended;
1417 begin
1418   Result := TextToFloat(PChar(s), v, fvExtended);
1419 end;
1420
1421 procedure testIsFloat;
1422   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: boolean; s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1423   begin
1424     Check(r, IsFloat(s2));
1425   end;
1426 begin
1427   mycheck(True, '12345.0');
1428   mycheck(True, '-12345.0');
1429   mycheck(True,'123.45');
1430   mycheck(True, '12345');
1431   mycheck(False,'12345F' );
1432   mycheck(True,  '+50');
1433   mycheck(False,'\82P\82Q\82R\82S\82T');
1434   mycheck(False,'');
1435 end;
1436
1437
1438 function Fmt2chToDateTime(Fmt2ch: String): TDateTime;
1439 var
1440   Year, Month, Day: word;
1441   Hour, Min, Sec, MSec: word;
1442 begin
1443   try
1444     Fmt2ch  :=  Trim(Fmt2ch); //dax
1445     Year    := StrToInt(Copy(Fmt2ch, 1, 4));
1446     Month   := StrToInt(Copy(Fmt2ch, 6, 2));
1447     Day     := StrToInt(Copy(Fmt2ch, 9, 2));
1448
1449     Hour    := StrToInt(Copy(Fmt2ch,16, 2));
1450     Min     := StrToInt(Copy(Fmt2ch,19, 2));
1451     Sec := 0;
1452     MSec:= 0;
1453
1454     Result := EncodeDate(Year, Month, Day)
1455                 + EncodeTime(Hour, Min, Sec, MSec);
1456   except
1457     raise EConvertError.Create('\93ú\95t\95Ï\8a·\82ª\90³\82µ\82\82Ë\82¦\82¼(ß\84Dß)ºÞÙ§');
1458   end;
1459 end;
1460
1461 procedure testFmt2chToDateTime;
1462   procedure mycheck(d{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: TDateTime; s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1463   begin
1464     Check(d, Fmt2chToDateTime(s2));
1465   end;
1466 begin
1467   mycheck(StrToDateTime('2001/02/18 15:23:00'),
1468           '2001/02/18(\93ú) 15:23');
1469
1470   mycheck(StrToDateTime('2001/02/18 15:23:00'),
1471           '2001/02/18(\93ú) 15:23 ID=???');
1472
1473   //\82±\82ê\82Í\83G\83\89\81[\81«
1474   {
1475   mycheck(StrToDateTime('0'),
1476           '\82 \82Ú\81[\82ñ');
1477   }
1478 end;
1479
1480 //S\82Ì\92\86\82ÉSubStr\82ª\82¢\82\82Â\82 \82é\82©\83J\83E\83\93\83g\82·\82é(2\83o\83C\83g\91Î\89\9e)
1481 {\95¶\8e\9a\82ð\8c©\82Â\82¯\82é\82Æ\82»\82Ì\95¶\8e\9a\82ð\8dí\8f\9c\82µ\82Ä\8c\9f\8dõ\82·\82é\82Æ\82¢\82¤\95û\8e®\82È\82Ì\82Å
1482  "\82 \82 \82 \82 \82 \82 "\82Æ\82¢\82¤\95¶\8e\9a\97ñ\82©\82ç"\82 \82 "\82Ì\8cÂ\90\94\82ð\91ª\92è\82·\82é\82Æ3\82ð\95Ô\82·}
1483 function StrCount1(const Substr, S: string): Integer;
1484 var
1485   Str: String;
1486 begin
1487   Result := 0;
1488   if (Substr = '') or (S = '') then exit;
1489
1490   Str := S;
1491   try
1492     while AnsiPos( Substr, Str) <> 0 do
1493     begin
1494       Inc(Result);
1495       delete(Str, AnsiPos( Substr, Str), Length(Substr));
1496     end;
1497   except
1498     Result := -1;
1499   end;
1500 end;
1501
1502 procedure testStrCount1;
1503   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: integer; s2, s3{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1504   begin
1505     Check(r, StrCount1(s3, s2));
1506   end;
1507 begin
1508   mycheck(3, '\82 \82 \82 \82 \82 \82 ', '\82 \82 ');
1509   mycheck(3, 'BorlandDelphiBorlandC++BuilderBorlandKylix', 'Borland');
1510   mycheck(2, 'BorlandDelphiBorlandC++BuilderBorlandKylix', '+');
1511   mycheck(4, 'http://www.2ch.net/hogehoge/test', '/');
1512   mycheck(0, 'http://www.2ch.net/hogehoge/test', '+');
1513   mycheck(0, '+', '+++++');
1514   mycheck(0, '', '+');
1515 end;
1516
1517 //\95¶\8e\9a\97ñ\82Ì\8cã\95û\8c\9f\8dõ
1518 {"\82 \82 \82 \82 \82 "\82©\82ç"\82 \82 "\82ð\8c\9f\8dõ\82·\82é\82Æ\83o\83C\83g\90\94\82Å7\82ð\95Ô\82·}
1519 function BackAnsiPos(const SubStr,S: String): Integer;
1520 var
1521   SearchStr: String;
1522   BackPosIndex: Integer;
1523   MbcsFlag: TMbcsByteType;
1524 begin
1525   Result := 0;
1526   MbcsFlag := mbSingleByte; {\93Á\82É\88Ó\96¡\82Ì\82È\82¢\8f\89\8aú\89»}
1527   if AnsiPos(subStr,S)=0 then exit;
1528
1529   SearchStr := S;
1530   while AnsiPos(subStr,SearchStr)<>0 do
1531   begin
1532     BackPosIndex := AnsiPos(subStr,SearchStr);
1533     MbcsFlag := ByteType(SearchStr, BackPosIndex);
1534     case MbcsFlag of
1535
1536       mbSingleByte:  { \94¼\8ap }
1537         Delete(SearchStr,1,BackPosIndex);
1538
1539       mbLeadByte:    { \91S\8ap\82Ì\82P\83o\83C\83g\96Ú }
1540         Delete(SearchStr,1,BackPosIndex  +1  );
1541
1542       mbTrailByte:   { \91S\8ap\82Ì\82Q\83o\83C\83g\96Ú }
1543         Delete(SearchStr,1,BackPosIndex);
1544     else
1545       raise Exception.Create('\83G\83\89\81[');
1546     end;
1547   end; //while
1548
1549   case MbcsFlag of
1550     mbSingleByte:
1551       Result := length(S)-Length(SearchStr);
1552
1553     mbLeadByte:
1554       Result := length(S)-Length(SearchStr) - 1;
1555
1556     mbTrailByte:
1557       Result := length(S)-Length(SearchStr);
1558   else
1559     raise Exception.Create('\83G\83\89\81[');
1560   end;
1561 end;
1562
1563 procedure testBackAnsiPos;
1564   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: integer; s2, s3{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1565   begin
1566     Check(r, BackAnsiPos(s3, s2));
1567   end;
1568 begin
1569   mycheck(9, '\82 \82 \82 \82 \82 \82 ', '\82 \82 ');
1570   mycheck(31,'BorlandDelphiBorlandC++BuilderBorlandKylix', 'Borland');
1571   mycheck(28,'http://www.2ch.net/hogehoge/test', '/');
1572   mycheck(0, 'http://www.2ch.net/hogehoge/test', '+');
1573   mycheck(0, '+', '+++++');
1574   mycheck(0, '', '+');
1575 end;
1576
1577 //URL\82ðDOS\83p\83X\82É\95Ï\8dX
1578 function  UrlToDosPath(const Url: string): string;
1579 const
1580   PATH_TERMINATE = '\';
1581 var
1582   S : string;
1583   n, m : integer;
1584 begin
1585   if  (AnsiPos('http://', Url) = 1) then  begin
1586     s :=  Copy(Url, 8, Length(Url));
1587   end else begin
1588     s :=  Url;
1589   end;
1590   n :=  AnsiPos(':', s);
1591   if  (n > 0) then  begin
1592     m :=  AnsiPos('/', s);
1593     s :=  'http://' +
1594           Copy(s, 1, n - 1) +
1595           Copy(s, m, Length(Url));
1596   end;
1597
1598   S :=  AnsiLowerCase(
1599           MonaUtils.ExcludeTrailingSlash(
1600             MonaUtils.ExtractUrlPath(S)));
1601   if  (S = '')  then  begin
1602     Result  :=  Url;
1603     Exit;
1604   end;
1605   if  (Copy(S,1,7) = 'http://') then  begin
1606     S :=  Copy(S,8,Length(S) - 7);
1607   end;
1608
1609   S :=  StringReplace(S, '/', PATH_TERMINATE, [rfReplaceAll]);
1610
1611   if  (Copy(S,Length(S) - 3, 4) = PATH_TERMINATE + 'dat') then  begin
1612     S :=  Copy(S,1,Length(S) - 4);
1613   end;
1614   Result  :=    S + PATH_TERMINATE + MonaUtils.ExtractUrlName(Url);
1615 end;
1616
1617 procedure testUrlToDosPath;
1618   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1619   begin
1620     Check(r, UrlToDosPath(s1));
1621   end;
1622 begin
1623   mycheck('www.2ch.net\',               'http://www.2ch.net/');
1624   mycheck('www.2ch.net\test\read.cgi',  'http://www.2ch.net/test/read.cgi');
1625   mycheck('www.2ch.net\test\',          'www.2ch.net/test/');
1626   mycheck('www.2ch.net\test',           'www.2ch.net/test');
1627   mycheck('ABCDEFG',                    'ABCDEFG');
1628   mycheck('\abcdefg\',                  '/abcdefg/');
1629   mycheck('www.2ch.net\abc\def',        'http://www.2ch.net/abc\def');
1630 end;
1631
1632 //?param=value\82Ì param\82ð\8ew\92è\82·\82é\82Æ value\82ð\95Ô\82·
1633 function ChooseValue(const Url, Key: string): string;
1634 var
1635   List  : TStringList;
1636   S : PChar;
1637 begin
1638   GetMem(S, Length(Url) + 1);
1639   StrCopy(S, PChar(Url));
1640   List  :=  TStringList.Create;
1641   {$IFDEF VER120}
1642     ExtractHttpFields(['?','&'], [], S, List);
1643   {$ELSE}
1644     ExtractHttpFields(['?','&'], [], S, List, False);
1645   {$ENDIF}
1646   Result  :=  List.Values[Key];
1647   List.Free;
1648   FreeMem(S);
1649 end;
1650
1651 procedure testChooseValue;
1652   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1653   begin
1654     Check(r, ChooseValue(s1, s2));
1655   end;
1656 begin
1657   mycheck('tech',
1658           'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1659           'bbs');
1660   mycheck('12345678',
1661           'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1662           'key');
1663   mycheck('10',
1664           'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1665           'st');
1666   mycheck('',
1667           'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1668           'to');
1669   mycheck('',
1670           'http://www.2ch.net/test/read.cgi',
1671           'bbs');
1672   mycheck('10',
1673           'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10&st=20',
1674           'st');
1675 end;
1676
1677 //URL\82Ì\83}\81[\83W
1678 function MargeUrl(const BaseUrl, NewUrl: string): string;
1679 var
1680   s,r,b : string;
1681   l : TStringList;
1682   i, count : integer;
1683 begin
1684   if  (NewUrl = '') then  begin
1685     Result  :=  BaseUrl;
1686     Exit;
1687   end else
1688   if  (NewUrl[1]  = '/')  then  begin
1689     Result  :=  'http://' + ExtractHostName(BaseUrl) + NewUrl;
1690     Exit;
1691   end;
1692   count :=  0;
1693   s :=  NewUrl;
1694   while true  do  begin
1695     if  (Copy(s,1,3) = '../')  then  begin
1696       s :=  Copy(s, 4, Length(s) - 3);
1697       inc(count);
1698     end else
1699     if  (Copy(s,1,2) = './')  then  begin
1700       s :=  Copy(s, 3, Length(s) - 2);
1701     end else begin
1702       Break;
1703     end;
1704   end;
1705   r := '';
1706   b := ExtractUrlPath(BaseUrl);
1707   b := Copy(b,7,Length(b));
1708   l :=  TStringList.Create;
1709   ExtractHTTPFields(['/'],[],PChar(b), l);
1710   for i :=  0 to  l.Count - count - 1 do  begin
1711     r :=  r + '/'+ l[i];
1712   end;
1713   Result  :=  'http:/' + r + '/' + s;
1714 end;
1715
1716 procedure testMargeUrl;
1717   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1, s2{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1718   begin
1719     Check(r, MargeUrl(s1, s2));
1720   end;
1721 begin
1722   mycheck('http://www.2ch.net/dat',
1723           'http://www.2ch.net/test/',
1724           '../dat');
1725   mycheck('http://www.2ch.net/dat',
1726           'http://www.2ch.net/test/data',
1727           '../dat');
1728   mycheck('http://www.2ch.net/test/dat',
1729           'http://www.2ch.net/test/data',
1730           './dat');
1731   mycheck('http://www.2ch.net/test/dat/',
1732           'http://www.2ch.net/test/data',
1733           './dat/');
1734   mycheck('http://www.2ch.net/',
1735           'http://www.2ch.net/test/',
1736           '../');
1737   mycheck('http://www.2ch.net/',
1738           'http://www.2ch.net/test/',
1739           '/');
1740   mycheck('http://www.2ch.net/test/a/',
1741           'http://www.2ch.net/test/',
1742           'a/');
1743 end;
1744
1745 //A HREF\83^\83O\82Ì\92\86\82©\82çURL\82ð\92\8a\8fo\82·\82é
1746 function ExtractHrefUrl(const s: string): string;
1747 var
1748   r : string;
1749   n : integer;
1750 begin
1751   n :=  AnsiPos('href', AnsiLowerCase(s));
1752   r :=  Copy(s, n, Length(s));
1753   n :=  AnsiPos('>', r);
1754   if  (n > 0) then  r :=  Copy(r, 1, n - 1);
1755   n :=  AnsiPos(' ', r);
1756   if  (n > 0) then  r :=  Copy(r, 1, n - 1);
1757   n :=  AnsiPos('=', r);
1758   r :=  Copy(r, n + 1, Length(r));
1759   n :=  AnsiPos('"', r);
1760   if  (n > 0) then  r :=  Copy(r, 2, Length(r)  - 2);
1761   Result  :=  r;
1762 end;
1763
1764 procedure testExtractHrefUrl;
1765   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1766   begin
1767     Check(r, ExtractHrefUrl(s1));
1768   end;
1769 begin
1770   mycheck('http://www.2ch.net/dat/',
1771           '<A HREF="http://www.2ch.net/dat/">');
1772   mycheck('http://www.2ch.net/dat/',
1773           '<a href=http://www.2ch.net/dat/>');
1774   mycheck('http://www.2ch.net/dat/',
1775           '<a target=_blank href=http://www.2ch.net/dat/>');
1776   mycheck('http://www.2ch.net/dat/',
1777           '<a target=_blank href=http://www.2ch.net/dat/><a href=http://www.2ch.net/test/>');
1778 end;
1779
1780 function ZenToHan(const s: string): string;
1781 var
1782   Chr : array [0..255]  of  char;
1783 begin
1784   {$IFDEF LINUX}
1785   //**LINUX**
1786   {$ENDIF}
1787   {$IFDEF MSWINDOWS}
1788   Windows.LCMapString(
1789      GetUserDefaultLCID(),
1790      LCMAP_HALFWIDTH,
1791      PChar(s),
1792      Length(s) + 1,
1793      chr,
1794      Sizeof(chr)
1795      );
1796   Result :=  Chr;
1797   {$ENDIF}
1798 end;
1799
1800 procedure testZenToHan;
1801   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1802   begin
1803     Check(r, ZenToHan(s1));
1804   end;
1805 begin
1806   mycheck('±²³´µ',      '\83A\83C\83E\83G\83I');
1807   mycheck('±²³´µ±²³´µ', '\83A\83C\83E\83G\83I±²³´µ');
1808   mycheck('ABC',        '\82`\82a\82b');
1809   mycheck('\8a¿\8e\9a',       '\8a¿\8e\9a');
1810   mycheck('\8a¿\8e\9aABC',    '\8a¿\8e\9a\82`\82a\82b');
1811 end;
1812
1813 function GetContentLength(S : string): integer;
1814 var
1815   p : PChar;
1816   p_end : PChar;
1817   n : integer;
1818 begin
1819   p :=  PChar(s);
1820   p_end :=  PChar(s) + Length(s);
1821   n :=  0;
1822   while p < p_end do begin
1823     if p^ = #13 then begin
1824       //
1825     end else begin
1826       inc(n);
1827     end;
1828     Inc(p);
1829   end;
1830   Result  :=  n;
1831 end;
1832
1833 procedure testGetContentLength;
1834   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: integer; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1835   begin
1836     Check(r, GetContentLength(s1));
1837   end;
1838 begin
1839   mycheck(1,      'A');
1840   mycheck(0,      '');
1841   mycheck(14,     '<HTML>' + #13#10 + '</HTML>');
1842   mycheck(14,     '<HTML>' + #10 + '</HTML>');
1843   mycheck(15,     '<HTML>' + #13#10 + #9 + '</HTML>');
1844   mycheck(20,     '<HTML>' + #13#10 + 'Hello' + #0 + '</HTML>');  //#0\82à\83J\83E\83\93\83g
1845 end;
1846
1847 function TrimTag(const s: string): string;
1848 var
1849   r : string;
1850   b : boolean;
1851   i : integer;
1852 begin
1853   r :=  '';
1854   b :=  False;
1855   for i :=  1 to  Length(s) do  begin
1856     if  (ByteType(s, i) = mbSingleByte) then  begin
1857       if  (s[i] = '<') then  begin
1858         b :=  True;
1859       end else
1860       if  (s[i] = '>') and (b) then  begin
1861         b :=  False;
1862       end else
1863       if  (not b) then  begin
1864         r :=  r + s[i];
1865       end;
1866     end else begin
1867       if  (not b) then  begin
1868         r :=  r + s[i];
1869       end;
1870     end;
1871   end;
1872   Result  :=  Trim(r);
1873 end;
1874
1875 procedure testTrimTag;
1876   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
1877   begin
1878     Check(r, TrimTag(s1));
1879   end;
1880 begin
1881   mycheck('\83A\83C\83E\83G\83I',   '<ABC>\83A\83C\83E\83G\83I</ABC>');
1882   mycheck('\83A\83C\83E\83G\83I',   '<\90À\82Á\82Ä\82æ\82µ>\83A\83C\83E\83G\83I</\83I\83}\83G\83\82\83i\81[>');
1883   mycheck('\82 \82 ',         '<<<a>>>\82 \82 <<</a>>>');
1884   mycheck('\83A\83C\83E\83G\83I',   '\83A\83C\83E\83G\83I');
1885   mycheck('',             '<A HREF="\83A\83C\83E\83G\83I">');
1886   mycheck('ABC',          '<A HREF="\83A\83C\83E\83G\83I">ABC</A>');
1887 end;
1888
1889 function AddTargetBlank(const Value: string): string;
1890 var
1891   Org, s, r : string;
1892   x, y, z, t : string;
1893   p, i : integer;
1894 begin
1895   r   :=  '';
1896   Org :=  Value;
1897   while true  do  begin
1898     p :=  AnsiPos('<a', AnsiLowerCase(Org));
1899     if  (p > 0) then  begin
1900       //\90æ\93ª\82©\82ç<A \82Ü\82Å\82ð --> r
1901       s :=  Copy(Org, 1, p - 1);
1902       r :=  r + s;
1903       //<A \82©\82ç > \82Ü\82Å\82ð --> s
1904
1905       // s = "<A xxxx xxxxxx>"
1906       //t :=  Copy(Org, p, Length(org));
1907       s :=  Copy(Org, p, Length(org));
1908       i :=  AnsiPos('>', s);
1909       t :=  Copy(s, i + 1, Length(s));
1910       s :=  Copy(S, 1, i);
1911
1912       if  (AnsiPos('href', AnsiLowerCase(s)) > 0) then  begin
1913         //TARGET=
1914         p :=  AnsiPos('TARGET=', AnsiUpperCase(s));
1915         if  (p > 0) then  begin
1916           x :=  Copy(s, 1, p - 1);  //TARGET\82Ü\82Å
1917           y :=  Copy(s, p, Length(s));  //TARGET\88È\8d~
1918           i :=  AnsiPos(' ', y);
1919           if  (i > 0) then  begin
1920             y :=  Copy(y, 1, i - 1);
1921           end;
1922           i :=  AnsiPos('>', y);
1923           if  (i > 0) then  begin
1924             y :=  Copy(y, 1, i - 1);
1925           end;
1926           //TARGET \82Ì\82Ý --> y
1927           z :=  Copy(s, Length(x) + Length(y) + 1, Length(s)); //TARGET\82æ\82è\8cã\82ë
1928           //
1929           s :=  x + 'TARGET="_blank"' + z;
1930           r :=  r + s;
1931           //org :=  Copy(org, AnsiPos('>', Org) + 1, Length(org));
1932           Org := t;
1933         end else begin
1934           //<A xxxxxxx>
1935           s :=  Copy(s, 1, Length(S) - 1) + ' TARGET="_blank">';
1936           r :=  r + s;
1937           //org :=  Copy(org, AnsiPos('>', Org) + 1, Length(org));
1938           Org := t;
1939         end;
1940
1941
1942       end else begin
1943         r :=  r + s;
1944         org :=  t; //Copy(org, Length(t) + 1, Length(org));
1945       end;
1946
1947     end else begin;
1948       r :=  r + Org;
1949       Break;
1950     end;
1951   end;
1952   Result  :=  r;
1953 end;
1954
1955 {
1956 function AddTargetBlank(const Value: string): string;
1957 var
1958   org , s, r, w, x, y, z : string;
1959   frx, tox, i : integer;
1960   b : boolean;
1961 begin
1962   org :=  Value;
1963   r   :=  '';
1964   while true  do  begin
1965     //frx :=  AnsiPos('<A HREF=', AnsiUpperCase(org));
1966     frx :=  AnsiPos('<A ', AnsiUpperCase(org));
1967     if  (frx > 0) then  begin
1968       r :=  r + Copy(org, 1, frx);
1969       org :=  Copy(org, frx + 1, Length(org));
1970       tox :=  AnsiPos('>', AnsiUpperCase(org));
1971       if  (tox > 0) then  begin
1972         s   :=  Copy(org, 1, tox - 1);
1973         if  (AnsiPos('TARGET=', AnsiUpperCase(org)) = 0)  then  begin
1974           s :=  s + ' TARGET="_blank"';
1975           r :=  r + s;
1976           org :=  Copy(org, tox, Length(org));
1977         end else begin
1978           //
1979           //  x = '<A HREF=xxxxxxxx |TARGET
1980           //x :=  Copy(S, 1, AnsiPos('TARGET=', S) - 1);
1981           //y :=  Copy(S, AnsiPos('TARGET=', S), Length(S));
1982           //z :=  Copy(y, AnsiPos(' ', y) + 1, Length(y));
1983           b := False;
1984           x :=  Copy(org, 1, AnsiPos('TARGET=', org) - 1);
1985           w :=  Trim(Copy(org, Length(x) + 1, Length(org)));
1986           i :=  AnsiPos(' ', w);
1987           if  (i > 0) then  begin
1988             y :=  Copy(w, 1, i - 1);
1989           end else begin
1990             y :=  w;
1991             b :=  True;
1992           end;
1993           i :=  AnsiPos('>', y);
1994           if  (i > 0) then  begin
1995             y :=  Copy(y, 1, i - 1);
1996           end;
1997           z :=  Copy(org, Length(x) + Length(y) + 1, Length(org));
1998
1999           if  (Length(x) > 0) then  begin
2000             if  (Copy(x, Length(x), 1) <> ' ')  then  begin
2001               x :=  x + ' ';
2002             end;
2003           end;
2004           if  (b) then begin
2005             s :=  x + 'TARGET="_blank"' + z;
2006           end else begin
2007             s :=  x + 'TARGET="_blank"';// + z;
2008           end;
2009
2010           //x :=  x + ' TARGET="_blank"';
2011           //s :=  s + ' TARGET="_blank"';
2012           r :=  r + s;
2013           org :=  Copy(org, Length(s), Length(org));
2014           if  (Length(org) > 0) then  begin
2015             if  (org[1] = '"')  then  begin
2016               org :=  Copy(org, 2, Length(org));
2017             end;
2018           end;
2019         end;
2020       end else begin
2021         r :=  r + org;
2022         Break;
2023       end;
2024     end else begin
2025       r :=  r + org;
2026       Break;
2027     end;
2028   end;
2029   Result  :=  r;
2030 end;
2031 }
2032 procedure testAddTargetBlank;
2033   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
2034   begin
2035     Check(r, AddTargetBlank(s1));
2036   end;
2037 begin
2038   mycheck('\82»\82Ì\82P\82ª\82P\82O\82O\82O\82ð\92´\82¦\82½\82Ì\82Å\82Q\82É\88Ú\8ds\82·\82é\82Æ\82¢\82¤\82±\82Æ\82Å\81B<BR><BR><BR>\82P\82Í\82±\82Á\82¿\82Å\82·\81B<BR><BR><a href=http://www.megabbs.com/cgi-bin/readres.cgi TARGET="_blank">\82±\82±</a><BR>',
2039           '\82»\82Ì\82P\82ª\82P\82O\82O\82O\82ð\92´\82¦\82½\82Ì\82Å\82Q\82É\88Ú\8ds\82·\82é\82Æ\82¢\82¤\82±\82Æ\82Å\81B<BR><BR><BR>\82P\82Í\82±\82Á\82¿\82Å\82·\81B<BR><BR><a href=http://www.megabbs.com/cgi-bin/readres.cgi>\82±\82±</a><BR>');
2040   mycheck('<A HREF="http://www.2ch.net" TARGET="_blank">2ch</A>',
2041           '<A HREF="http://www.2ch.net" TARGET="_blank">2ch</A>');
2042   mycheck('AAA<A HREF="http://www.2ch.net" TARGET="_blank">2ch</A>',
2043           'AAA<A HREF="http://www.2ch.net">2ch</A>');
2044   mycheck('<A HREF="http://www.2ch.net" TARGET="_blank">2ch</A>',
2045           '<A HREF="http://www.2ch.net">2ch</A>');
2046   mycheck('<a href="http://www.2ch.net" TARGET="_blank">2ch</A>',
2047           '<a href="http://www.2ch.net">2ch</A>');
2048   mycheck('<a href=http://www.2ch.net TARGET="_blank">2ch</A>',
2049           '<a href=http://www.2ch.net>2ch</A>');
2050   mycheck('<A HREF="http://www.2ch.net" TARGET="_blank">2ch</A>',
2051           '<A HREF="http://www.2ch.net" TARGET="parent">2ch</A>');
2052   mycheck('<A TARGET="_blank" HREF="http://www.2ch.net">2ch</A>',
2053           '<A TARGET="_blank" HREF="http://www.2ch.net">2ch</A>');
2054   mycheck('<A TARGET="_blank" HREF=http://www.2ch.net>2ch</A>',
2055           '<A TARGET=_top HREF=http://www.2ch.net>2ch</A>');
2056   mycheck('<A NAME="AA">2ch</A>',
2057           '<A NAME="AA">2ch</A>');
2058   mycheck('<A>2ch</A>',
2059           '<A>2ch</A>');
2060   mycheck('2ch',
2061           '2ch');
2062 end;
2063
2064 function  ExtractDatNo(const DatFileName: string): string;
2065 var
2066   s, ext : string;
2067 begin
2068   if  (AnsiPos('http:', DatFileName) = 1) then  begin
2069     s   :=  ExtractUrlName(DatFileName);
2070   end else begin
2071     s   :=  ExtractFileName(DatFileName);
2072   end;
2073   ext :=  ExtractFileExt(s);
2074   if  (ext <> '') then  begin
2075     s :=  Copy(s, 1, Length(s) - Length(ext));
2076   end;
2077   Result  :=  s;
2078 end;
2079
2080 procedure testExtractDatNo;
2081   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: string; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
2082   begin
2083     Check(r, ExtractDatNo(s1));
2084   end;
2085 begin
2086   mycheck('123456789',
2087           '123456789.dat');
2088   mycheck('123456789',
2089           '123456789');
2090   mycheck('123456789',
2091           'http://www.2ch.net/tech/dat/123456789.dat');
2092   mycheck('123456789',
2093           'C:\monazilla\monaplorer\dat\123456789.dat');
2094   mycheck('123456789_1',
2095           '123456789_1.dat');
2096   mycheck('123456789_1',
2097           '123456789_1');
2098   mycheck('123456789_1',
2099           'http://www.2ch.net/tech/dat/123456789_1.dat');
2100   mycheck('123456789_1',
2101           'C:\monazilla\monaplorer\dat\123456789_1.dat');
2102 end;
2103
2104 //Tue, 17 Dec 2002 12:18:07 GMT \81¨ TDateTime\82Ö
2105 function  DateStrToDateTime(const DateStr: string): TDateTime;
2106   function  StrMonthToMonth(const s: string): integer;
2107   const
2108     m: array[1..12] of string = ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec');
2109   var
2110     i: integer;
2111   begin
2112     Result  :=  -1;
2113     for i :=  Low(m)  to  High(m) do  begin
2114       if  (SameText(s, m[i]))  then  begin
2115         Result  :=  i;
2116         Break;
2117       end;
2118     end;
2119   end;
2120 var
2121   wDay, wMonth, wYear: word;
2122   wHour, wMinute, wSecond: word;
2123   sTime: string;
2124   d: TDateTime;
2125 begin
2126   wDay    :=  StrToIntDef(ChooseString(DateStr, ' ', 1), 0);
2127   wMonth  :=  StrMonthToMonth(ChooseString(DateStr, ' ', 2));
2128   wYear   :=  StrToIntDef(ChooseString(DateStr, ' ', 3), 0);
2129   sTime   :=  ChooseString(DateStr, ' ', 4);
2130   wHour   :=  StrToIntDef(ChooseString(sTime, ':', 0), 0);
2131   wMinute :=  StrToIntDef(ChooseString(sTime, ':', 1), 0);
2132   wSecond :=  StrToIntDef(ChooseString(sTime, ':', 2), 0);
2133   d :=  EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, 0);
2134   Result  :=  d;
2135 end;
2136
2137 procedure testDateStrToDateTime;
2138   procedure mycheck(r{\8aú\91Ò\82³\82ê\82é\8c\8b\89Ê}: TDateTime; s1{\8aÖ\90\94\82É\93n\82·\93à\97e}: String);
2139   begin
2140     Check(r, DateStrToDateTime(s1));
2141   end;
2142 begin
2143   mycheck(StrToDateTime('2002/12/17 12:18:07'),
2144                         'Tue, 17 Dec 2002 12:18:07 GMT');
2145   mycheck(StrToDateTime('2003/1/10 23:15:10'),
2146                         'Fri, 10 Jan 2003 23:15:10 GMT');
2147   mycheck(StrToDateTime('2004/2/29 00:00:00'),
2148                         'Fri, 29 Feb 2004 00:00:00 GMT');
2149   mycheck(StrToDateTime('2001/11/11 11:22:33'),
2150                         'Fri, 11 Nov 2001 11:22:33 JST');
2151 end;
2152
2153
2154 procedure testMonaUtils;
2155 begin
2156   ClearTestResult;
2157   try
2158     //testMonaHtmlParser;
2159     //testMonaProfiler;
2160     //testExtractUrlPath;
2161     //testExtractUrlName;
2162     //testMaxMin;
2163     //testIncludeTrailingSlash;
2164     //testExcludeTrailingSlash;
2165     //testIsUrlDelimiter;
2166     //testLoadSaveString;
2167     //testFindFile;
2168     //testAddHRefTag;
2169     //testTrimHRefTag;
2170     //testDecodeHtmlEsc;
2171     //testEncodeHtmlEsc;
2172     //testExtractHostName;
2173     //testGet2chDate;
2174     //testChooseString;
2175     //testExtractQuotedStr;
2176     //testExtractUrlLastPath;
2177     //testIsNumeric;
2178     //testFmt2chToDateTime;
2179     //testStrCount1;
2180     //testBackAnsiPos;
2181     //testIsFloat;
2182     //testUrlToDosPath;
2183     //testChooseValue;
2184     //testMargeUrl;
2185     //testExtractHrefUrl;
2186     //testZenToHan;
2187     //testGetContentLength;
2188     //testTrimTag;
2189     //testAddTargetBlank;
2190     //testExtractDatNo;
2191     //testAddTargetBlank;
2192     testDateStrToDateTime;
2193   except
2194     on E:ETestFailure do
2195       ;
2196     on E:Exception do
2197       Inc(TestResult.Error);
2198   end;
2199 end;
2200
2201 initialization
2202         if not QueryPerformanceFrequency(TMonaProfiler_FFrequency) then
2203                 RaiseLastWin32Error;
2204
2205 end.