5 {----------------------------------------------------------
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¬
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(<
\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é
88 TMonaHtmlParser ......... HTML
\83p
\81[
\83T
\81[
\83N
\83\89\83X
89 TMonaProfiler ...........
\83v
\83\8d\83t
\83@
\83C
\83\89
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 ----------------------------------------------------------}
103 Windows, ShellApi, Forms,
105 Classes, SysUtils, {HTTPApp,} YofUtils, DateUtils;
111 EMonaError = class(Exception);
113 // EMonaError
\82ðraise
114 procedure MonaError(msg: String); overload;
115 procedure MonaError(format: String; args: array of const); overload;
118 //
\8eè
\91±
\82«
\81E
\8aÖ
\90\94
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;
165 procedure testMonaUtils;
168 //
\83N
\83\89\83X
\81E
\83\8c\83R
\81[
\83h
171 TMonaHtmlTokenType = (
173 htTag, //
\83^
\83O
\82Ì
\92\86
174 htText //
\83^
\83O
\82Ì
\8aO
177 TMonaHtmlParser = class(TObject)
182 FTokenType: TMonaHtmlTokenType;
183 FAttributes: TStrings;
184 procedure SetAttributes(const Value: TStrings); // Dax
185 procedure makeAttributes(const Token: string); // Dax
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
199 TMonaProfiler = class(TObject)
202 FStartCounter, FTotalCounter: Int64;
203 function GetMicroSec: Integer;
204 function GetMilliSec: Integer;
205 function GetSec: Integer;
206 procedure SetActive(const Value: Boolean);
208 function GetCounter: Int64;
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;
220 ////////////////////////////////////////////////////////////////////////////////
222 ////////////////////////////////////////////////////////////////////////////////
227 procedure MonaError(msg: String);
229 raise EMonaError.Create(msg);
232 procedure MonaError(format: String; args: array of const);
234 MonaError(SysUtils.Format(format, args));
237 function ExtractUrlPath(const FileName: string): string;
241 I := LastDelimiter('/:', FileName);
242 Result := Copy(FileName, 1, I);
245 procedure testExtractUrlPath;
246 procedure mycheck(s, s2: String);
248 Check(s, ExtractUrlPath(s2));
252 'http://piza.2ch.net/tech/',
253 'http://piza.2ch.net/tech/index2.html');
256 'http://piza.2ch.net/tech/',
257 'http://piza.2ch.net/tech/index2.html#menu');
261 'http://www.yahoo.co.jp' );
268 function ExtractUrlName(const FileName: string): string;
272 I := LastDelimiter('/:', FileName);
273 Result := Copy(FileName, I + 1, MaxInt);
276 procedure testExtractUrlName;
277 procedure mycheck(s, s2: String);
279 Check(s, ExtractUrlName(s2));
284 'http://piza.2ch.net/tech/index2.html');
288 'http://piza.2ch.net/tech/index2.html#menu');
292 'http://www.yahoo.co.jp' );
300 function Max(A, B: Integer): Integer;
302 if B < A then Result := A else Result := B;
305 function Max(A, B: Int64): Int64;
307 if B < A then Result := A else Result := B;
310 function Max(A, B: Single): Single;
312 if B < A then Result := A else Result := B;
315 function Max(A, B: Double): Double;
317 if B < A then Result := A else Result := B;
320 function Max(A, B: Extended): Extended;
322 if B < A then Result := A else Result := B;
325 function Min(A, B: Integer): Integer;
327 if A < B then Result := A else Result := B;
330 function Min(A, B: Int64): Int64; overload;
332 if A < B then Result := A else Result := B;
335 function Min(A, B: Single): Single; overload;
337 if A < B then Result := A else Result := B;
340 function Min(A, B: Double): Double; overload;
342 if A < B then Result := A else Result := B;
345 function Min(A, B: Extended): Extended; overload;
347 if A < B then Result := A else Result := B;
350 procedure testMaxMin;
352 LowInteger, HighInteger: Integer;
353 LowInt64, HighInt64: Int64;
354 LowSingle, HighSingle: Single;
355 LowDouble, HighDouble: Double;
356 LowExtended, HighExtended: Extended;
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;
365 Max(LowInteger, HighInteger));
368 Max(LowInt64, HighInt64));
371 Max(LowSingle, HighSingle));
374 Max(LowDouble, HighDouble));
377 Max(LowExtended, HighExtended));
380 Min(LowInteger, HighInteger));
383 Min(LowInt64, HighInt64));
386 Min(LowSingle, HighSingle));
389 Min(LowDouble, HighDouble));
392 Min(LowExtended, HighExtended));
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;
401 if not IsUrlDelimiter(Result, Length(Result)) then
402 Result := Result + '/';
405 procedure testIncludeTrailingSlash;
406 procedure mycheck(s, s2: string);
408 Check(s, IncludeTrailingSlash(s2));
412 'http://www.yahoo.co.jp/',
413 'http://www.yahoo.co.jp' );
415 'http://www.yahoo.co.jp/',
416 'http://www.yahoo.co.jp/' );
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;
423 if IsUrlDelimiter(Result, Length(Result)) then
424 SetLength(Result, Length(Result)-1);
427 procedure testExcludeTrailingSlash;
428 procedure mycheck(s, s2: String);
430 Check(s, ExcludeTrailingSlash(s2));
434 'http://www.yahoo.co.jp',
435 'http://www.yahoo.co.jp/' );
437 'http://www.yahoo.co.jp',
438 'http://www.yahoo.co.jp' );
441 function IsUrlDelimiter(const S: string; Index: Integer): Boolean;
443 Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = '/')
444 and (ByteType(S, Index) = mbSingleByte);
447 procedure testIsUrlDelimiter;
448 procedure mycheck(b: Boolean; s: String; Index: Integer);
450 Check(b, IsUrlDelimiter(s, Index));
455 'http://www.yahoo.co.jp/index.htm', 6 );
458 'http://www.yahoo.co.jp/index.htm', 3 );
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;
467 size := FindFile(FileName).Size;
475 SetLength(Result, size);
476 AssignFile(F, FileName);
478 BlockRead(F, PChar(Result)^, 1);
484 procedure SaveStringToFile(const FileName, Str: String);
489 path := ExtractFileDir(FileName);
490 if (path <> '') and not DirectoryExists(path) then
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é}
497 ForceDirectories(path);
499 MonaError('
\83f
\83B
\83\8c\83N
\83g
\83\8a%s
\82ª
\8dì
\82ê
\82Ü
\82¹
\82ñ
\81B', [path]);
503 AssignFile(F, FileName);
504 Rewrite(F, Length(Str));
505 if Length(Str) > 0 then
506 BlockWrite(F, PChar(Str)^, 1);
512 procedure testLoadSaveString;
513 procedure mycheck(s: String);
517 SaveStringToFile('testString.txt', s);
518 s2 := LoadStringFromFile('testString.txt');
519 Check(s, s2, 'testLoadSaveString');
521 on E:Exception do Error(E);
525 mycheck('hello,world');
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ñ'
532 mycheck('test' + #13 + 'LoadString' + #10 + 'SaveString' + #13 + #10 + 'xxx');
535 function FindFile(const FileName: String): TSearchRec;
537 if FindFirst(FileName, faAnyFile, Result) = 0 then
540 MonaError('%s
\82Ì
\8fî
\95ñ
\82Ì
\8eæ
\93¾
\82É
\8e¸
\94s
\82µ
\82Ü
\82µ
\82½
\81B', [FileName]);
543 procedure testFindFile;
547 sl := TStringList.Create;
549 sl.Text := 'hello,world';
550 sl.SaveToFile('fileinfo.txt');
551 with FindFile('fileinfo.txt') do
553 Check(Size, Length(sl.Text));
554 Check(Name, 'fileinfo.txt');
562 procedure TMonaHtmlParser.Error;
564 MonaError('HTML
\82Ì
\89ð
\90Í
\82É
\8e¸
\94s
\82µ
\82Ü
\82µ
\82½:%s', [p]);
567 constructor TMonaHtmlParser.Create(s: String);
569 FAttributes := TStringList.Create;
573 procedure TMonaHtmlParser.Assign(s: String);
579 function TMonaHtmlParser.GetToken: TMonaHtmlTokenType;
592 FTokenType := htNone;
607 makeAttributes(FToken); // add Dax 2001/10/30
611 FToken := FToken + p^;
618 FTokenType := htText;
630 FToken := FToken + p^;
636 Result := FTokenType;
639 function TMonaHtmlParser.GetToken(ATokenType: TMonaHtmlTokenType): String;
641 if GetToken <> ATokenType then
646 procedure TMonaHtmlParser.GetToken(ATokenType: TMonaHtmlTokenType;
647 AToken: String; IgnoreCase: Boolean);
651 if UpperCase(GetToken(ATokenType)) <> UpperCase(AToken) then
654 if GetToken(ATokenType) <> AToken then
660 destructor TMonaHtmlParser.Destory;
665 procedure TMonaHtmlParser.makeAttributes(const Token: string);
671 //'<AAA BBB=CCC DDD=EEE>'
673 xend := PChar(Token) + Length(Token) + 1;
675 while (x < xend) do begin
676 if (x^ = ' ') or (x^ = #0) then begin
677 if (Attr <> '') then begin
678 FAttributes.Values[Attr] := S;
683 if (x^ = '=') then begin
693 procedure TMonaHtmlParser.SetAttributes(const Value: TStrings);
695 FAttributes.Assign(Value);
698 procedure testMonaHtmlParser;
700 parser: TMonaHtmlParser;
703 parser := TMonaHtmlParser.Create( // TStrings.Text
\82È
\82Ç
\82ð
\93n
\82·
704 '<!-- saved from url=(0032)http://www.2ch.net/bbstable.html -->' +
707 '<TITLE>BBS TABLE for 2ch</TITLE>' +
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>' +
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');
722 Check(TokenType = htTag, 'GetToken = htTag');
723 Check(Token, 'html');
725 // GetToken(htTag, 'HEAD');
726 Check(GetToken(htTag), 'HEAD');
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¢
751 // PerformanceCounter
\97p
752 var TMonaProfiler_FFrequency: Int64;
754 procedure TMonaProfiler.Clear;
758 FStartCounter := GetCounter;
761 constructor TMonaProfiler.Create;
766 function TMonaProfiler.GetCounter: Int64;
771 if not QueryPerformanceCounter(Result) then
776 function TMonaProfiler.GetMicroSec: Integer;
780 counter := FTotalCounter;
782 Inc(counter, GetCounter - FStartCounter);
784 Result := Round(counter / TMonaProfiler_FFrequency * 1000000);
790 function TMonaProfiler.GetMilliSec: Integer;
794 counter := FTotalCounter;
796 Inc(counter, GetCounter - FStartCounter);
798 Result := Round(counter / TMonaProfiler_FFrequency * 1000);
804 function TMonaProfiler.GetSec: Integer;
808 counter := FTotalCounter;
810 Inc(counter, GetCounter - FStartCounter);
812 Result := Round(counter / TMonaProfiler_FFrequency);
818 procedure TMonaProfiler.SetActive(const Value: Boolean);
827 procedure TMonaProfiler.Start;
832 FStartCounter := GetCounter;
835 procedure TMonaProfiler.Stop;
839 Inc(FTotalCounter, GetCounter - FStartCounter);
843 procedure testMonaProfiler;
845 profiler: TMonaProfiler;
847 profiler := TMonaProfiler.Create;
849 profiler.Start; //
\8aJ
\8en
852 Check(500, (profiler.MilliSec + 50) div 100 * 100);
856 profiler.Start; //
\8dÄ
\8aJ
858 Check(1500, (profiler.MilliSec + 50) div 100 * 100); //
\89Ò
\93®
\92\86\82Å
\82àOK
862 Check(0, profiler.MicroSec);
863 profiler.Start; //
\8aJ
\8en
866 Check(500*1000, (profiler.MicroSec + 50) div 1000 * 1000);
871 procedure ShellOpen(const FileName: String); //
\82Æ
\82É
\82©
\82
\8aJ
\82
874 if 32 >= ShellExecute(Application.Handle, 'open', PChar(FileName), nil, nil, sw_show) then
877 // ??
\82È
\82ñ
\82¾
\82ë
\82Ë??
882 function AddHRefTag(s: string): string;
884 NORMAL_CHAR: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789:/.%?&#=-_~+*;!^`\|@[]{}$,';
893 idx := AnsiPos('http://', s);
895 if idx = 0 then begin
896 //
\83\8a\83\93\83N
\82ª
\96³
\82¢
\81[
\82æ
\81B
897 Result := Result + s;
901 Result := Result + Copy(s, 0, idx - 1);
903 s := Copy(s, idx, length(s));
905 for i := 0 to Length(s) do begin
907 idx := AnsiPos(s[i + 1], NORMAL_CHAR);
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);
913 Result := Result + '<a href="' + url + '" target="_blank">' + url + '</a>';
914 s := Copy(s, i + 1, Length(s));
921 function AddHRefTag(s: string): string;
923 NORMAL_CHAR: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789:/.%?&#=-_~+*;!^`\|@[]{}$,';
927 idx, idx1, idx2, idx3, idx4: Integer;
934 idx1 := AnsiPos('http://', s);
935 idx2 := AnsiPos('ttp://', s);
936 idx3 := AnsiPos('www.', s);
938 if (idx1 > 1) then begin
939 for x := idx1 downto 1 do begin
940 if (s[x] = '>') then begin
943 if (s[x] = '<') then begin
951 if (idx1 > 4) then begin
952 s1 := AnsiLowerCase(Copy(s, idx1 - 4, 4));
953 if (s1 <> '<br>') and
954 (s[idx1 - 1] = '>') then
961 if ((idx3 < idx2) and (idx3 > 0)) or ((idx3 > 0) and (idx2 = 0)) then begin
966 if (idx2 < idx1) or ((idx2 > 0) and (idx1 = 0)) then begin
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;
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));
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));
1002 procedure testAddHRefTag;
1003 procedure mycheck(s, s2: String);
1005 Check(s, AddHRefTag(s2));
1009 '<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>',
1010 'http://piza.2ch.net/tech/');
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/');
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æ');
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');
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è');
1024 'https://piza.2ch.net/tech/index2.html#menu',
1025 'https://piza.2ch.net/tech/index2.html#menu');
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');
1030 'http
\82Å
\8en
\82Ü
\82é',
1031 'http
\82Å
\8en
\82Ü
\82é');
1036 '<a href="http://www.2ch.net/tech/" target="_blank">www.2ch.net/tech/</a>',
1037 'www.2ch.net/tech/');
1047 //
\95¶
\8e\9a\97ñ
\92\86\82©
\82ç <A HREF="xxx"> </A>
\83^
\83O
\82ð
\8eæ
\82è
\8f\9c\82«
\82Ü
\82·
1049 function TrimHRefTag(const S: string): string;
1054 BodyText := StringReplace(S,'</A>', '', [rfReplaceAll,rfIgnoreCase]);
1056 x := Pos('<a ',AnsiLowerCase(BodyText));
1057 if (AnsiPos('>',AnsiLowerCase(BodyText)) = 0) then begin
1061 if (x > 0) then begin
1063 if (BodyText[y] = '>') and (ByteType(BodyText, y) = mbSingleByte) then
1065 BodyText := Copy(BodyText,1, x-1) +
1066 Copy(BodyText,y + 1, Length(BodyText));
1070 if (y > Length(BodyText)) then Break;
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);
1083 Check(s, TrimHRefTag(s2));
1087 'http://piza.2ch.net/tech/',
1088 '<a href="http://piza.2ch.net/tech/" target="_blank">http://piza.2ch.net/tech/</a>');
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>');
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æ');
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>');
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è');
1102 'https://piza.2ch.net/tech/index2.html#menu',
1103 'https://piza.2ch.net/tech/index2.html#menu');
1105 'http
\82Å
\8en
\82Ü
\82é',
1106 'http
\82Å
\8en
\82Ü
\82é');
1112 function DecodeHtmlEsc(const s: string): string;
1116 DispText := StringReplace(S, '<br>', #13#10, [rfIgnoreCase, rfReplaceAll]);
1117 DispText := StringReplace(DispText, '<', '<', [rfIgnoreCase, rfReplaceAll]);
1118 DispText := StringReplace(DispText, '>', '>', [rfIgnoreCase, rfReplaceAll]);
1119 DispText := StringReplace(DispText, '"', '"', [rfIgnoreCase, rfReplaceAll]);
1120 DispText := StringReplace(DispText, '&', '&', [rfIgnoreCase, rfReplaceAll]);
1121 DispText := StringReplace(DispText, ' ', ' ', [rfIgnoreCase, rfReplaceAll]);
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);
1128 Check(s, DecodeHtmlEsc(s2));
1133 '<HTML&XML>');
1135 'BR' + #13#10 + 'BR' + #13#10#13#10,
1136 'BR<BR>BR<BR><BR>');
1148 function EncodeHtmlEsc(const s: string): string;
1152 DispText := StringReplace(S, '&', '&', [rfReplaceAll]);
1153 DispText := StringReplace(DispText, '<', '<', [rfReplaceAll]);
1154 DispText := StringReplace(DispText, '>', '>', [rfReplaceAll]);
1155 DispText := StringReplace(DispText, '"', '"', [rfReplaceAll]);
1156 DispText := StringReplace(DispText, #13#10, '<br>', [rfReplaceAll]);
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);
1163 Check(s, EncodeHtmlEsc(s2));
1167 '<HTML&XML>',
1171 'BR' + #13#10 + 'BR' + #13#10#13#10);
1180 function ExtractHostName(const Url: string): string;
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);
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);
1198 Check(s, ExtractHostName(s2));
1203 'http://www.2ch.net/');
1207 'http://piza.2ch.net/tech/index2.html');
1211 'http://piza.2ch.net/tech/index2.html#menu');
1215 'http://www.yahoo.co.jp' );
1219 'www.yahoo.co.jp' );
1225 function Get2chDate(aDate: TDateTime): string;
1230 d1 := EncodeDate(1970, 1, 1);
1231 d2 := aDate - EncodeTime(9, 0, 0, 0);
1232 Result := FloatToStr(Trunc((d2 - d1) * 24 * 60 * 60));
1235 function GetDatSince(aDatNo: string): string;
1242 if (AnsiPos('_', aDatNo) > 0) then begin
1243 s := Copy(aDatNo, 1, AnsiPos('_', aDatNo) - 1); //
\82µ
\82½
\82ç
\82Î
\91Î
\89\9e
1247 if (TryStrToFloat(s, v)) then begin
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);
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);
1261 Check(s, Get2chDate(s2));
1266 StrToDateTime('2001/04/01 12:00:00'));
1270 StrToDateTime('2004/02/29 12:00:00'));
1273 function ChooseString(const Text, Separator: string; Index: integer): string;
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));
1283 p := AnsiPos(Separator, S);
1284 if (p > 0) then Result := Copy(S, 1, p - 1) else Result := S;
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;
1291 Check(s, ChooseString(s2, s3, n));
1316 'http://www.2ch.com/arakabu/', '/', 3);
1320 '
\82±
\82Ì
\96Ø
\82È
\82ñ
\82Ì
\96Ø
\96Ø
\82É
\82È
\82é
\96Ø', '
\96Ø', 3);
1324 'BorlandDelphiBorlandC++BuilderBorlandKylix', 'Borland', 2);
1331 function ExtractQuotedStr(S: string; Quote: char): string;
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);
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);
1347 Check(s, ExtractQuotedStr(s2, s3));
1350 mycheck('ABC', '"ABC"', '"');
1351 mycheck('ABC ', '"ABC "', '"');
1352 mycheck('ABC', 'ABC', '"');
1353 mycheck('"ABC"', '"ABC"', '''');
1354 mycheck('""', '""""', '"');
1355 mycheck('A', 'A', '"');
1356 mycheck('', '', '"');
1359 function ExtractUrlLastPath(Url: string): string;
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);
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);
1376 Check(s, ExtractURLLastPath(s2));
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' );
1387 function IsNumeric(s: string): boolean;
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);
1402 Check(r, IsNumeric(s2));
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');
1414 function IsFloat(s: string): boolean;
1418 Result := TextToFloat(PChar(s), v, fvExtended);
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);
1424 Check(r, IsFloat(s2));
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');
1438 function Fmt2chToDateTime(Fmt2ch: String): TDateTime;
1440 Year, Month, Day: word;
1441 Hour, Min, Sec, MSec: word;
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));
1449 Hour := StrToInt(Copy(Fmt2ch,16, 2));
1450 Min := StrToInt(Copy(Fmt2ch,19, 2));
1454 Result := EncodeDate(Year, Month, Day)
1455 + EncodeTime(Hour, Min, Sec, MSec);
1457 raise EConvertError.Create('
\93ú
\95t
\95Ï
\8a·
\82ª
\90³
\82µ
\82
\82Ë
\82¦
\82¼(ß
\84Dß)ºÞÙ§');
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);
1464 Check(d, Fmt2chToDateTime(s2));
1467 mycheck(StrToDateTime('2001/02/18 15:23:00'),
1468 '2001/02/18(
\93ú) 15:23');
1470 mycheck(StrToDateTime('2001/02/18 15:23:00'),
1471 '2001/02/18(
\93ú) 15:23 ID=???');
1473 //
\82±
\82ê
\82Í
\83G
\83\89\81[
\81«
1475 mycheck(StrToDateTime('0'),
1476 '
\82 \82Ú
\81[
\82ñ');
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;
1488 if (Substr = '') or (S = '') then exit;
1492 while AnsiPos( Substr, Str) <> 0 do
1495 delete(Str, AnsiPos( Substr, Str), Length(Substr));
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);
1505 Check(r, StrCount1(s3, s2));
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, '', '+');
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;
1522 BackPosIndex: Integer;
1523 MbcsFlag: TMbcsByteType;
1526 MbcsFlag := mbSingleByte; {
\93Á
\82É
\88Ó
\96¡
\82Ì
\82È
\82¢
\8f\89\8aú
\89»}
1527 if AnsiPos(subStr,S)=0 then exit;
1530 while AnsiPos(subStr,SearchStr)<>0 do
1532 BackPosIndex := AnsiPos(subStr,SearchStr);
1533 MbcsFlag := ByteType(SearchStr, BackPosIndex);
1536 mbSingleByte: {
\94¼
\8ap }
1537 Delete(SearchStr,1,BackPosIndex);
1539 mbLeadByte: {
\91S
\8ap
\82Ì
\82P
\83o
\83C
\83g
\96Ú }
1540 Delete(SearchStr,1,BackPosIndex +1 );
1542 mbTrailByte: {
\91S
\8ap
\82Ì
\82Q
\83o
\83C
\83g
\96Ú }
1543 Delete(SearchStr,1,BackPosIndex);
1545 raise Exception.Create('
\83G
\83\89\81[');
1551 Result := length(S)-Length(SearchStr);
1554 Result := length(S)-Length(SearchStr) - 1;
1557 Result := length(S)-Length(SearchStr);
1559 raise Exception.Create('
\83G
\83\89\81[');
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);
1566 Check(r, BackAnsiPos(s3, s2));
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, '', '+');
1577 //URL
\82ðDOS
\83p
\83X
\82É
\95Ï
\8dX
1578 function UrlToDosPath(const Url: string): string;
1580 PATH_TERMINATE = '\';
1585 if (AnsiPos('http://', Url) = 1) then begin
1586 s := Copy(Url, 8, Length(Url));
1590 n := AnsiPos(':', s);
1591 if (n > 0) then begin
1592 m := AnsiPos('/', s);
1595 Copy(s, m, Length(Url));
1599 MonaUtils.ExcludeTrailingSlash(
1600 MonaUtils.ExtractUrlPath(S)));
1601 if (S = '') then begin
1605 if (Copy(S,1,7) = 'http://') then begin
1606 S := Copy(S,8,Length(S) - 7);
1609 S := StringReplace(S, '/', PATH_TERMINATE, [rfReplaceAll]);
1611 if (Copy(S,Length(S) - 3, 4) = PATH_TERMINATE + 'dat') then begin
1612 S := Copy(S,1,Length(S) - 4);
1614 Result := S + PATH_TERMINATE + MonaUtils.ExtractUrlName(Url);
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);
1620 Check(r, UrlToDosPath(s1));
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');
1632 //?param=value
\82Ì param
\82ð
\8ew
\92è
\82·
\82é
\82Æ value
\82ð
\95Ô
\82·
1633 function ChooseValue(const Url, Key: string): string;
1638 GetMem(S, Length(Url) + 1);
1639 StrCopy(S, PChar(Url));
1640 List := TStringList.Create;
1642 ExtractHttpFields(['?','&'], [], S, List);
1644 ExtractHttpFields(['?','&'], [], S, List, False);
1646 Result := List.Values[Key];
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);
1654 Check(r, ChooseValue(s1, s2));
1658 'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1661 'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1664 'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1667 'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10',
1670 'http://www.2ch.net/test/read.cgi',
1673 'http://www.2ch.net/test/read.cgi?bbs=tech&key=12345678&st=10&st=20',
1677 //URL
\82Ì
\83}
\81[
\83W
1678 function MargeUrl(const BaseUrl, NewUrl: string): string;
1684 if (NewUrl = '') then begin
1688 if (NewUrl[1] = '/') then begin
1689 Result := 'http://' + ExtractHostName(BaseUrl) + NewUrl;
1695 if (Copy(s,1,3) = '../') then begin
1696 s := Copy(s, 4, Length(s) - 3);
1699 if (Copy(s,1,2) = './') then begin
1700 s := Copy(s, 3, Length(s) - 2);
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
1713 Result := 'http:/' + r + '/' + s;
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);
1719 Check(r, MargeUrl(s1, s2));
1722 mycheck('http://www.2ch.net/dat',
1723 'http://www.2ch.net/test/',
1725 mycheck('http://www.2ch.net/dat',
1726 'http://www.2ch.net/test/data',
1728 mycheck('http://www.2ch.net/test/dat',
1729 'http://www.2ch.net/test/data',
1731 mycheck('http://www.2ch.net/test/dat/',
1732 'http://www.2ch.net/test/data',
1734 mycheck('http://www.2ch.net/',
1735 'http://www.2ch.net/test/',
1737 mycheck('http://www.2ch.net/',
1738 'http://www.2ch.net/test/',
1740 mycheck('http://www.2ch.net/test/a/',
1741 'http://www.2ch.net/test/',
1745 //A HREF
\83^
\83O
\82Ì
\92\86\82©
\82çURL
\82ð
\92\8a\8fo
\82·
\82é
1746 function ExtractHrefUrl(const s: string): string;
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);
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);
1767 Check(r, ExtractHrefUrl(s1));
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/>');
1780 function ZenToHan(const s: string): string;
1782 Chr : array [0..255] of char;
1788 Windows.LCMapString(
1789 GetUserDefaultLCID(),
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);
1803 Check(r, ZenToHan(s1));
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');
1813 function GetContentLength(S : string): integer;
1820 p_end := PChar(s) + Length(s);
1822 while p < p_end do begin
1823 if p^ = #13 then begin
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);
1836 Check(r, GetContentLength(s1));
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
1847 function TrimTag(const s: string): string;
1855 for i := 1 to Length(s) do begin
1856 if (ByteType(s, i) = mbSingleByte) then begin
1857 if (s[i] = '<') then begin
1860 if (s[i] = '>') and (b) then begin
1863 if (not b) then begin
1867 if (not b) then begin
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);
1878 Check(r, TrimTag(s1));
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>');
1889 function AddTargetBlank(const Value: string): string;
1892 x, y, z, t : string;
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);
1903 //<A
\82©
\82ç >
\82Ü
\82Å
\82ð --> s
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));
1912 if (AnsiPos('href', AnsiLowerCase(s)) > 0) then begin
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);
1922 i := AnsiPos('>', y);
1923 if (i > 0) then begin
1924 y := Copy(y, 1, i - 1);
1926 //TARGET
\82Ì
\82Ý --> y
1927 z := Copy(s, Length(x) + Length(y) + 1, Length(s)); //TARGET
\82æ
\82è
\8cã
\82ë
1929 s := x + 'TARGET="_blank"' + z;
1931 //org := Copy(org, AnsiPos('>', Org) + 1, Length(org));
1935 s := Copy(s, 1, Length(S) - 1) + ' TARGET="_blank">';
1937 //org := Copy(org, AnsiPos('>', Org) + 1, Length(org));
1944 org := t; //Copy(org, Length(t) + 1, Length(org));
1956 function AddTargetBlank(const Value: string): string;
1958 org , s, r, w, x, y, z : string;
1959 frx, tox, i : integer;
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"';
1976 org := Copy(org, tox, Length(org));
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));
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);
1993 i := AnsiPos('>', y);
1994 if (i > 0) then begin
1995 y := Copy(y, 1, i - 1);
1997 z := Copy(org, Length(x) + Length(y) + 1, Length(org));
1999 if (Length(x) > 0) then begin
2000 if (Copy(x, Length(x), 1) <> ' ') then begin
2005 s := x + 'TARGET="_blank"' + z;
2007 s := x + 'TARGET="_blank"';// + z;
2010 //x := x + ' TARGET="_blank"';
2011 //s := s + ' TARGET="_blank"';
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));
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);
2035 Check(r, AddTargetBlank(s1));
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>',
2064 function ExtractDatNo(const DatFileName: string): string;
2068 if (AnsiPos('http:', DatFileName) = 1) then begin
2069 s := ExtractUrlName(DatFileName);
2071 s := ExtractFileName(DatFileName);
2073 ext := ExtractFileExt(s);
2074 if (ext <> '') then begin
2075 s := Copy(s, 1, Length(s) - Length(ext));
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);
2083 Check(r, ExtractDatNo(s1));
2086 mycheck('123456789',
2088 mycheck('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',
2096 mycheck('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');
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;
2108 m: array[1..12] of string = ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec');
2113 for i := Low(m) to High(m) do begin
2114 if (SameText(s, m[i])) then begin
2121 wDay, wMonth, wYear: word;
2122 wHour, wMinute, wSecond: word;
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);
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);
2140 Check(r, DateStrToDateTime(s1));
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');
2154 procedure testMonaUtils;
2158 //testMonaHtmlParser;
2160 //testExtractUrlPath;
2161 //testExtractUrlName;
2163 //testIncludeTrailingSlash;
2164 //testExcludeTrailingSlash;
2165 //testIsUrlDelimiter;
2166 //testLoadSaveString;
2170 //testDecodeHtmlEsc;
2171 //testEncodeHtmlEsc;
2172 //testExtractHostName;
2175 //testExtractQuotedStr;
2176 //testExtractUrlLastPath;
2178 //testFmt2chToDateTime;
2185 //testExtractHrefUrl;
2187 //testGetContentLength;
2189 //testAddTargetBlank;
2191 //testAddTargetBlank;
2192 testDateStrToDateTime;
2194 on E:ETestFailure do
2197 Inc(TestResult.Error);
2202 if not QueryPerformanceFrequency(TMonaProfiler_FFrequency) then
2203 RaiseLastWin32Error;