1 { Version 050602. Copyright � Alexey A.Chernobaev, 1996-2005 }
2 
3 { Some functions are based on a code from other freeware units:
4   1) StrUtils (RX Library) Copyright (c) 1995, 1996 AO ROSNO;
5      Copyright (c) 1997, 1998 Master-Bank;
6   2) QStrings Copyright (c) 2000, Andrew N. Driazgov; Portions (c) 2000,
7      Sergey G. Shcherbakov) }
8 
9 unit VectStr;
10 
11 interface
12 
13 {$I VCheck.inc}
14 
15 uses
16   {$IFDEF V_WIN}{$IFNDEF WIN32}Windows,{WinTypes, WinProcs,}{$ELSE}Windows,{$ENDIF}{$ENDIF} {by zcad}
17   SysUtils, ExtSys, ExtType{$IFNDEF UNIX},Windows{$ENDIF}
18   {$IFDEF V_WIDESTRINGS}{$IFDEF V_D4},SysConst{$ENDIF}{$ENDIF};
19 
20 const
21   LoASCII = [#0..#31];
22   LoASCIIAndSpace = LoASCII + [' '];
23   Digits = ['0'..'9'];
24   OctalDigits = ['0'..'7'];
25   HexadecimalDigits = Digits + ['A'..'F', 'a'..'f'];
26   ASCIIUpperAlpha = ['A'..'Z'];
27   ASCIILowerAlpha = ['a'..'z'];
28   ASCIIAlpha = ASCIIUpperAlpha + ASCIILowerAlpha;
29   ASCIIAlphaNumeric = ASCIIAlpha + Digits;
30   ASCII_32to127 = [#32..#127];
31   Punctuation = ['!', ',', '.', ':', ';', '?'];
32   Brackets = ['(', ')', '[', ']', '{', '}'];
33 
34 type
35   TCharSet = set of Char;
36 
LoCasenull37 function LoCase(C: Char): Char; {$IFDEF V_INLINE}inline;{$ENDIF}
38 { ����������� ������ � ������ ������� ('A'..'Z' -> 'a'..'z') }
39 { converts a character to lowercase ('A'..'Z' -> 'a'..'z') }
40 
NumOfCharsnull41 function NumOfChars(C: Char; const S: String): Integer;
42 {$IFDEF V_WIDESTRINGS}
NumOfWideCharsnull43 function NumOfWideChars(C: WideChar; const S: WideString): Integer;
44 {$ENDIF}
45 { ���������� ���������� ��������� ������� C � ������ S }
46 { returns the number of occurrences of the character C in the string S }
47 
NumOfSubStrnull48 function NumOfSubStr(const SubS, S: String): Integer;
49 {$IFDEF V_WIDESTRINGS}
WideNumOfSubStrnull50 function WideNumOfSubStr(const SubS, S: WideString): Integer;
51 {$ENDIF}
52 { ���������� ���������� ��������� ��������� SubS � ������ S }
53 { returns the number of occurrences of the substring SubS in the string S }
54 
55 {$IFDEF V_WIDESTRINGS}
WideCharInnull56 function WideCharIn(W: WideChar; const Chars: TCharSet): Boolean;
57 { Result:=(W < #256) and (Char(W) in Chars) }
58 {$ENDIF}
59 
IsASCIIStringnull60 function IsASCIIString(const S: String): Boolean;
61 {$IFDEF V_WIDESTRINGS}
IsASCIIWideStringnull62 function IsASCIIWideString(const S: WideString): Boolean;
63 {$ENDIF}
64 { ���������� True ����� � ������ �����, ����� ������ S �� �������� ��������
65   � ������ >= 128 }
66 { returns True if and only if the string S doesn't contain characters with
67   codes >= 128 }
68 
CharPosnull69 function CharPos(C: Char; const S: String;
70   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
71 {$IFDEF V_WIDESTRINGS}
WideCharPosnull72 function WideCharPos(C: WideChar; const S: WideString;
73   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
74 {$ENDIF}
75 { ���������� ������ ������� ��������� ������� � � ������ S, ������� � �������
76   From (>= 1); ���������� 0, ���� ������ �� ������ }
77 { returns the index of the first occurrence of the character C in the string S
78   starting from position From (>= 1); returns 0 if the character not found }
79 
CharNPosnull80 function CharNPos(C: Char; const S: String; N: Integer;
81   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
82 {$IFDEF V_WIDESTRINGS}
WideCharNPosnull83 function WideCharNPos(C: WideChar; const S: WideString; N: Integer;
84   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
85 {$ENDIF}
86 { ���������� ������ N-�� (N >= 1) ��������� ������� � � ������ S, ������� �
87   ������� From (>= 1); ���������� 0, ���� ������ �� ������ }
88 { returns the index of the Nth (N >= 1) occurrence of the character C in the
89   string S starting from position From (>= 1); returns 0 if the character not
90   found }
91 
LastPosnull92 function LastPos(C: Char; const S: String): Integer;
93 {$IFDEF V_WIDESTRINGS}
WideLastPosnull94 function WideLastPos(C: WideChar; const S: WideString): Integer;
95 {$ENDIF}
96 { ���� ������ C ������ � ������ S, �� ���������� ������ ���������� ���������
97   ����� �������, ����� ���������� 0 }
98 { if the string S contains the character C then returns the index of the last
99   occurrence of this character, otherwise returns 0 }
100 
CharInSetPosnull101 function CharInSetPos(const Chars: TCharSet; const S: String;
102   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
103 {$IFDEF V_WIDESTRINGS}
WideCharInSetPosnull104 function WideCharInSetPos(const Chars: TCharSet; const S: WideString;
105   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
106 {$ENDIF}
107 { ���������� ������ ������� ��������� ������ �� ��������, �������� � Chars, �
108   ������ S, ������� � ������� From (>= 1); ���������� 0, ���� ������ �� ������ }
109 { returns the index of the first occurrence of any character from Chars in the
110   string S starting from position From (>= 1); returns 0 if the character
111   not found }
112 
CharNotInSetPosnull113 function CharNotInSetPos(const Chars: TCharSet; const S: String;
114   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
115 {$IFDEF V_WIDESTRINGS}
WideCharNotInSetPosnull116 function WideCharNotInSetPos(const Chars: TCharSet; const S: WideString;
117   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
118 {$ENDIF}
119 { ���������� ������ ������� ��������� ������ �� ��������, �� �������� � Chars,
120   � ������ S, ������� � ������� From (>= 1); ���������� 0, ���� ����� ������
121   �� ��� ������ }
122 { returns the index of the first occurrence of any character NOT from Chars in
123   the string S starting from position From (>= 1); returns 0 if such character
124   was not found }
125 
126 {$IFDEF V_WIN}
AnsiTextPosnull127 function AnsiTextPos(const SubS, S: String): Integer;
128 { ������ Pos, ���������������� � �������� �������� }
129 { case-insensitive analog of Pos }
130 {$ENDIF}
131 
FirstUppernull132 function FirstUpper(const S: String): String;
133 procedure FirstUpperProc(var S: String);
134 { �������� ������ ������ S �� ��������� ����� }
135 { changes the first character of S to uppercase }
136 
FirstLowernull137 function FirstLower(const S: String): String;
138 procedure FirstLowerProc(var S: String);
139 { �������� ������ ������ S �� �������� ����� }
140 { changes the first character of S to lowercase }
141 
DelLastNnull142 function DelLastN(const S: String; N: Integer): String;
143 { ���������� ����� S ��� N ��������� �������� }
144 { returns a copy of S without the last N characters }
145 
DelLastIfnull146 function DelLastIf(const S: String; C: Char): String;
147 { ���� ������ S ������������ �������� �, �� ��������� ����� ������ �� 1 �
148   ���������� ��, ����� ���������� ����� S }
149 { if the string S terminates with the character C then decreases the string
150   length by 1 and returns it, otherwise returns a copy of S }
151 
FirstCharnull152 function FirstChar(const S: String): Char;
LastCharnull153 function LastChar(const S: String): Char;
154 {$IFDEF V_WIDESTRINGS}
WideFirstCharnull155 function WideFirstChar(const S: WideString): WideChar;
WideLastCharnull156 function WideLastChar(const S: WideString): WideChar;
157 {$ENDIF}
158 { see code }
159 
EnsureLastnull160 function EnsureLast(const S: String; C: Char): String;
161 { ���� ������ S �� ������ � �� ������������ �������� �, �� ���������� (S + C),
162   ����� ���������� ����� S }
163 { if the string S is not empty and it doesn't end up with the character C then
164   returns (S + C), otherwise returns a copy of S }
165 {$IFDEF V_WIDESTRINGS}
WideEnsureLastnull166 function WideEnsureLast(const S: WideString; C: WideChar): WideString;
167 {$ENDIF}
168 
CloseSentencenull169 function CloseSentence(const S: String): String;
170 procedure CloseSentenceProc(var S: String);
171 {$IFDEF V_WIDESTRINGS}
WideCloseSentencenull172 function WideCloseSentence(const S: WideString): WideString;
173 procedure WideCloseSentenceProc(var S: WideString);
174 {$ENDIF}
175 
176 procedure ConcatDelimited(var S: String; const Tail: String; Delimiter: Char);
177 {$IFDEF V_WIDESTRINGS}
178 procedure WideConcatDelimited(var S: WideString; const Tail: WideString; Delimiter: WideChar);
179 {$ENDIF}
180 
181 {$IFDEF V_WIDESTRINGS}
182 procedure WideAppend(var S: WideString; C: WideChar);
183 { S:=S + C }
184 procedure WideAppendStr(var S: WideString; const Tail: WideString);
185 { S:=S + Tail }
186 {$ENDIF}
187 
PosFromnull188 function PosFrom(const SubStr, S: String; From: Integer): Integer;
189 { ������ System.Pos, �� SubStr ������, ������� � ������� From (>=1) }
190 { analog of System.Pos which searches for SubStr from the position From (>=1) }
191 {$IFDEF V_WIDESTRINGS}
WidePosFromnull192 function WidePosFrom(const SubStr, S: WideString; From: Integer): Integer;
193 {$ENDIF}
194 
StartsWithnull195 function StartsWith(const S, What: String): Boolean;
196 { Result = (Copy(S, 1, Length(What)) = What) }
197 {$IFDEF V_WIDESTRINGS}
WideStartsWithnull198 function WideStartsWith(const S, What: WideString): Boolean;
199 {$ENDIF}
200 
201 {$IFDEF V_WIN}
AnsiStartsWithnull202 function AnsiStartsWith(const S, What: String): Boolean;
203 { ������ StartsWith, ���������������� � �������� �������� }
204 { case-insensitive analog of StartsWith }
205 {$ENDIF}
206 
EndsWithnull207 function EndsWith(const S, What: String): Boolean;
208 {$IFDEF V_WIDESTRINGS}
WideEndsWithnull209 function WideEndsWith(const S, What: WideString): Boolean;
210 {$ENDIF}
211 
212 {$IFDEF V_DELPHI}
213 {$IFNDEF V_D3}
Trimnull214 function Trim(const S: String): String;
215 { ������� ������� � ������ <= ' ' � ������ � ����� ������ }
216 { removes leading and trailing characters with codes <= ' ' from the string }
217 {$ELSE}
TrimWnull218 function TrimW(const S: WideString): WideString;
219 {$ENDIF}
220 {$ENDIF}
221 
222 {$IFNDEF V_D5} { Delphi 1-4, Free Pascal }
AnsiSameTextnull223 function AnsiSameText(const S1, S2: String): Boolean;
224 {$ENDIF}
225 
226 {$IFDEF V_WIDESTRINGS}
227 {$IFNDEF V_D6}
WideCompareTextnull228 function WideCompareText(const S1, S2: WideString): Integer;
WideSameTextnull229 function WideSameText(const S1, S2: WideString): Boolean;
230 {$ENDIF}
231 {$ENDIF}
232 
TrimTrailnull233 function TrimTrail(const S: String): String;
234 {$IFDEF V_WIDESTRINGS}
TrimTrailWnull235 function TrimTrailW(const S: WideString): WideString;
236 {$ENDIF}
237 { ������� ������� � ������ <= ' ' � ����� ������ }
238 { removes trailing characters with codes <= ' ' from the string }
239 
TruncateAtZeronull240 function TruncateAtZero(const S: String): String;
241 procedure TruncateAtZeroProc(var S: String);
242 {$IFDEF V_WIDESTRINGS}
TruncateAtZeroWidenull243 function TruncateAtZeroWide(const S: WideString): WideString;
244 procedure TruncateAtZeroProcWide(var S: WideString);
245 {$ENDIF}
246 { �������� ������ �� ������ ��������� #0 }
247 { truncates the string at first #0 }
248 
TrimLastNnull249 function TrimLastN(const S: String; N: Integer): String;
250 procedure TrimLastNProc(var S: String; N: Integer);
251 {$IFDEF V_WIDESTRINGS}
WideTrimLastNnull252 function WideTrimLastN(const S: WideString; N: Integer): WideString;
253 procedure WideTrimLastNProc(var S: WideString; N: Integer);
254 {$ENDIF}
255 { �������� ��������� N �������� ������ S (�.�. ��������� ����� S �� N) }
256 { truncates the last N characters from S (i.e. decreases the length of S by N) }
257 
IsWhiteSpacenull258 function IsWhiteSpace(const S: String): Boolean;
259 { ���������� True, ���� ��� ������� S ������ ���� ����� #32 }
260 { returns True if all characters of S are lower or equal to #32 }
261 
MakeStringnull262 function MakeString(C: Char; N: Integer): String;
263 {$IFDEF V_WIDESTRINGS}
MakeWideStringnull264 function MakeWideString(C: WideChar; N: Integer): WideString;
265 {$ENDIF}
266 { ������ MakeStr �� RX Library: ���������� ������, ��������� �� N �������� C }
267 { analog of MakeStr from RX Library: returns the string consisting of N
268   characters C }
269 
AddCharnull270 function AddChar(C: Char; const S: String; N: Integer): String;
271 { �� RX Library: ���������� ����� S, ����������� �� ����� N ��������� C ����� }
272 { from RX Library: returns copy of S left-padded to length N with characters C }
273 
ReplaceStrnull274 function ReplaceStr(const Value, FromStr, ToStr: String): String;
275 {$IFDEF V_WIDESTRINGS}
WideReplaceStrnull276 function WideReplaceStr(const Value, FromStr, ToStr: WideString): WideString;
277 {$ENDIF}
278 { �� RX Library: ���������� ������, ���������� �� Value ������� ���� ���������
279   FromStr �� ToStr }
280 { from RX Library: returns the result of replacing all occurrences of FromStr in
281   Value to ToStr }
282 
283 procedure ReplaceCharProc(var S: String; FromChar, ToChar: Char);
ReplaceCharnull284 function ReplaceChar(const S: String; FromChar, ToChar: Char): String;
285 {$IFDEF V_WIDESTRINGS}
286 procedure WideReplaceCharProc(var S: WideString; FromChar, ToChar: WideChar);
WideReplaceCharnull287 function WideReplaceChar(const S: WideString; FromChar, ToChar: WideChar): WideString;
288 {$ENDIF}
289 { ���������� ������, ���������� �� Value ������� ���� �������� FromChar ��
290   ToChar }
291 { returns the result of replacing all occurrences of the FromChar character in
292   Value to ToChar }
293 
ContainsCharsnull294 function ContainsChars(const S: String; Chars: TCharSet): Boolean;
ContainsCharsBufnull295 function ContainsCharsBuf(const Buf: PChar; Size: Integer;
296   const Chars: TCharSet): Boolean;
297 {$IFDEF V_WIDESTRINGS}
WideContainsCharsnull298 function WideContainsChars(const S: WideString; Chars: TCharSet): Boolean;
299 {$ENDIF}
300 { ���������, �������� �� S ���� �� ���� ������ �� ��������� Chars }
301 { checks whether S contains at least one character from Chars set }
302 
ContainsOnlyCharsnull303 function ContainsOnlyChars(const S: String; const Chars: TCharSet): Boolean;
ContainsOnlyCharsBufnull304 function ContainsOnlyCharsBuf(const Buf: PChar; Size: Integer;
305   const Chars: TCharSet): Boolean;
306 { ���������� True, ���� ������ �������� ������ ������� �� Chars }
307 { returns True if the given string contains only characters from Chars }
308 
DelDupCharnull309 function DelDupChar(const S: String; C: Char): String;
310 { ���������� ������, ���������� �� S ��������� ������������� �������� C (�������
311   �������, �� ������ ������ ������ ������ �������� C �������� ���� ������) }
312 { returns the result of deleting duplicate characters C in the string S (in other
313   words, only one character remains from every group of adjacent characters C) }
314 
315 {$IFDEF V_LONGSTRINGS}
DecodeCEscapesnull316 function DecodeCEscapes(const S: String): String;
317 { ���������� ������, ���������� �� S ������� ���� escape-�������������������
318   �� ��������������� ������������������ ASCII-��������, ��� ��� ������ �������
319   ��������� printf ����������� ���������� ������� ���������� ����� C (��������,
320   "\n" ���������� �� #13#10, "\t" - �� #9 � �.�.) }
321 { returns the result of replacing all escape-sequences in the string S to the
322   corresponding sequences of ASCII codes as the printf-family functions of the
323   standard C-language run-time library do (e.g. "\n" will be replaced to #13#10,
324   "\t" - to #9, etc.) }
325 
EncodeCEscapesnull326 function EncodeCEscapes(const S: String; Only7Bit: Boolean): String;
327 { �������, �������� � DecodeCEscapes; ��� ������� � ������ [#0..#31] �����
328   ������������ escape-�������������������� \xNN, ��� NN - ����������������� ���
329   ������� (���� Only7Bit = True, �� ������� � ������ >= #128 ����� �����
330   ������������) }
331 { inverse function for DecodeCEscapes; all characters with codes [#0..#31] will
332   be encoded with escape-sequences \xNN, where NN is the hexadecimal character
333   code (if Only7Bit = True then characters with codes >= #128 will be encoded
334   also) }
335 {$ENDIF}
336 
337 {$IFDEF WIN32}
WordPosnull338 function WordPos(SubWord, S: String; CaseSensitive: Boolean): Integer;
339 { ���� SubWord ������ � ������ S ��� ����� �����, �� ���������� ������ �������
340   ������ ���������, ����� ���������� 0 }
341 { if the string S contains SubWord as the whole word then returns the index of
342   the first such occurrence, otherwise returns 0 }
343 
AnsiToOemnull344 function AnsiToOem(const S: String): String;
OemToAnsinull345 function OemToAnsi(const S: String): String;
346 
347 procedure AnsiToOemProc(var S: String);
348 procedure OemToAnsiProc(var S: String);
349 {$ENDIF}
350 
IsCorrectIdentifiernull351 function IsCorrectIdentifier(const S: String;
352   AcceptIndexes: Boolean{$IFDEF V_DEFAULTS} = False{$ENDIF}): Boolean;
353 { ���������, �������� �� ������ S ���������� ��������������� (�.�. ������
354   �� ����� � ������� �� ��������� ����, ���� � ������� �������������, ������
355   ������ ������ �� �������� ������); ���� AcceptIndexes = True, �� �����������
356   ��������������, ��������, "Pixels[10, 20]" }
357 { checks whether the string S is the correct identifier (i.e. the string is not
358   empty and contains only latin characters, digits and '_' characters, moreover,
359   first character isn't a digit); ; if AcceptIndexes = True then indexing is
360   allowed, e.g. "Pixels[10, 20]" }
361 
IsCorrectQualifiedIdentifiernull362 function IsCorrectQualifiedIdentifier(S: String;
363   AcceptIndexes: Boolean{$IFDEF V_DEFAULTS} = False{$ENDIF}): Boolean;
364 { ���������� ������� IsCorrectIdentifier, ������� ��������� �����������������
365   �������������� (��������� ���������������, ���������� �������); ����
366   AcceptIndexes = True, �� ����������� ��������������, ��������,
367   "Canvas.Pixels[10, 20]" }
368 { more general variant of IsCorrectIdentifier which accepts qualified
369   identifiers (several identifiers delimited by dots); if AcceptIndexes = True
370   then indexing is allowed, e.g. "Canvas.Pixels[10, 20]" }
371 
RemoveCharnull372 function RemoveChar(const S: String; C: Char): String;
373 {$IFDEF V_WIDESTRINGS}
RemoveCharWidenull374 function RemoveCharWide(const S: WideString; C: WideChar): WideString;
375 {$ENDIF}
376 { ������� �� ������ S ��� �������, ������ C }
377 { removes all characters equal to C from the string S }
378 
RemoveCharsnull379 function RemoveChars(const S: String; const CharsToRemove: TCharSet): String;
380 {$IFDEF V_WIDESTRINGS}
RemoveCharsWidenull381 function RemoveCharsWide(const S: WideString; const CharsToRemove: TCharSet): WideString;
382 {$ENDIF}
383 { ������� �� ������ S ��� �������, �������� �� ��������� CharsToRemove }
384 { removes all characters containing in the set CharsToRemove from the string S }
385 
RemoveCommentnull386 function RemoveComment(const S: String; CommentPrefix: Char): String;
387 { ������� �� S ����������� - ����� ������, ������� ���������� � CommentPrefix,
388   ������� ���� ������, ���� ������ CommentPrefix �� ��������� ������ ����������
389   ��������, ������������� ���������� ��� �������� ���������; ������� ����������
390   ���������� ����� ������, ������ �� ��� ��������� � �������� ������� �
391   ����������� ������� (������� � ������ <= ' '). ������:
392   RemoveComment('Point="2.0;3.5" ; coordinates', ';') = 'Point="2.0;3.5"' }
393 { removes any comments from the string S; comment is the part of the string
394   starting with CommentPrefix character, including this symbol, if only
395   CommentPrefix isn't located inside the string literal enclosed in the single or
396   double quotes; returns the remaining part of the string with deleted leading
397   and trailing spaces and special characters (characters with codes <= ' ').
398   E.g.: RemoveComment('Point="2.0;3.5" ; coordinates', ';') = 'Point="2.0;3.5"' }
399 
StringToLiteralnull400 function StringToLiteral(const S: String): String;
401 {$IFDEF V_WIDESTRINGS}
WideStringToLiteralnull402 function WideStringToLiteral(const S: WideString): WideString;
403 {$ENDIF}
404 { ����������� ������ S � �������, �������� S � ��������� ������� � ��������
405   ��������� �������, �������� � S. ������: 'cause => '''cause' }
406 { converts the string S to the literal enclosing S in the single quotes and
407   duplicating single quotes inside S. E.g.: 'cause => '''cause' }
408 
StringToLiteral2null409 function StringToLiteral2(const S: String): String;
410 {$IFDEF V_WIDESTRINGS}
WideStringToLiteral2null411 function WideStringToLiteral2(const S: WideString): WideString;
412 {$ENDIF}
413 { ����������� ������ S � �������, �������� S � ������� ������� � ��������
414   ������� �������, �������� � S. ������: "cause => """cause" }
415 { converts the string S to the literal enclosing S in the double quotes and
416   duplicating double quotes inside S. E.g.: "cause => """cause" }
417 
TextToLiteralnull418 function TextToLiteral(const S: String): String;
419 {$IFDEF V_WIDESTRINGS}
WideTextToLiteralnull420 function WideTextToLiteral(const S: WideString): WideString;
421 {$ENDIF}
422 { ���� � ������ S ������ �������, �������� �� ��������� ����, ���� � ���� ������
423   �������� (��. CheckText), ��� S - ������ ������, �� ����������� S � �������,
424   �������� S � ��������� ������� � �������� ��������� �������, �������� � S,
425   ����� ���������� ����� S }
426 { if there are characters differing from the Latin letters, digits and some
427   other characters (see CheckText) in the string S or S is the empty string then
428   converts S to the literal enclosing S in the single quotes and duplicating
429   single quotes inside S, otherwise returns the copy of S }
430 
TextToLiteral2null431 function TextToLiteral2(const S: String): String;
432 {$IFDEF V_WIDESTRINGS}
WideTextToLiteral2null433 function WideTextToLiteral2(const S: WideString): WideString;
434 {$ENDIF}
435 { ���� � ������ S ������ �������, �������� �� ��������� ����, ���� � ���� ������
436   �������� (��. CheckText), ��� S - ������ ������, �� ����������� S � �������,
437   �������� S � ������� ������� � �������� ������� �������, �������� � S,
438   ����� ���������� ����� S }
439 { if there are characters differing from the Latin letters, digits and some
440   other characters (see CheckText) in the string S or S is the empty string then
441   converts S to the literal enclosing S in the double quotes and duplicating
442   double quotes inside S, otherwise returns the copy of S }
443 
LiteralToStringnull444 function LiteralToString(const S: String): String;
445 {$IFDEF V_WIDESTRINGS}
LiteralToWideStringnull446 function LiteralToWideString(const S: WideString): WideString;
447 {$ENDIF}
448 { �������� ������� � StringToLiteral: ������� ��������� ������� � ������ � �����
449   S, � �� ������ ���� ��������� ������� ������ ������ ��������� ���� �������;
450   ����������� ������������� ������� ������� ������ ��������� (� ���� ������
451   ��������� ������� ���������������� ��� ������� �������, � ������� �������
452   ��������������, ��� ��������� � ������ ������). �������: '''cause' => 'cause;
453   "'cause" => 'cause; """London""" => "London"; "'London'" => 'London'; ���� S
454   �� ��������� � ������� (���������� � ������ � �����), �� ������������ ����� S }
455 { inverse function for StringToLiteral; accepts both single and double quotes.
456   E.g.: '''cause' => 'cause; "'cause" => 'cause; """London""" => "London";
457   "'London'" => 'London'; if the string S isn't enclosed in any quotes (the same
458   at the beginning and at the end of the string) then returns the copy of S }
459 
GetValueByNamenull460 function GetValueByName(const S, Name: String; var Value: String;
461   CaseSensitive: Boolean{$IFDEF V_DEFAULTS} = False{$ENDIF};
462   const QuoteChars: TCharSet{$IFDEF V_DEFAULTS} = ['"', '''']{$ENDIF}): Boolean;
463 { in: S = '... Name = XXXX ...'; out: Value = XXXX; example:
464   if S = <META content="text/html; charset=ISO-8859-1" http-equiv=Content-Type>,
465      Name = 'content', QuoteChars = ['"', '''']
466   then
467      Value:='text/html; charset=ISO-8859-1' }
468 
469 {$IFDEF V_WIDESTRINGS}{$IFDEF V_D4}{$IFNDEF V_D6} { from Delphi 6 RTL (SysUtils) }
WideFormatBufnull470 function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
471   FmtLen: Cardinal; const Args: array of const): Cardinal;
472 
473 procedure WideFmtStr(var Result: WideString; const Format: WideString;
474   const Args: array of const);
475 
WideFormatnull476 function WideFormat(const Format: WideString; const Args: array of const): WideString;
477 {$ENDIF}{$ENDIF}{$ENDIF}
478 
479 {$IFDEF V_D4}
IntToStrSeparatednull480 function IntToStrSeparated(Value: Int64): String;
481 {$ENDIF}
482 
IntToRomannull483 function IntToRoman(N: Integer): String;
484 { if N in [1..5000] then converts it to Roman number else returns empty string;
485   from unit QStrings; modified }
486 
ValOctPCharnull487 function ValOctPChar(P: PChar; L: Integer; var Value: Integer): Boolean;
ValOctStrnull488 function ValOctStr(const S: String; var Value: Integer): Boolean;
OctToIntnull489 function OctToInt(P: PChar; MaxLen: Integer; var Value: Integer): Boolean;
490 
491 const
492 {$IFDEF WIN32}
493   iSystemLocale = LOCALE_SYSTEM_DEFAULT; { $0800: system default locale }
494   iUserLocale = LOCALE_USER_DEFAULT; { $0400: user default locale }
495 
496   iCaseInsensitive = NORM_IGNORECASE; { $0001: case-insensitive }
497   iIgnoreNonSpace = NORM_IGNORENONSPACE; { $0002: ignore non-spacing characters }
498   iIgnoreSymbols = NORM_IGNORESYMBOLS; { $0004: ignore symbols }
499   iStringSort = SORT_STRINGSORT; { $1000: use string-order instead of word-order }
500   FlagsMask = iCaseInsensitive or iIgnoreNonSpace or iIgnoreSymbols or iStringSort;
501 {$ELSE}
502   iSystemLocale = $0800; { iSystemLocale and iUserLocale are the same for D1 }
503   iUserLocale = $0400;
504 
505   iCaseInsensitive = $0001; { case-insensitive }
506   FlagsMask = iCaseInsensitive;
507 {$ENDIF}
508   LocaleMask = iSystemLocale or iUserLocale;
509 
510   { iLocaled: user locale, ascending, case insensitive, word sort order }
511   iLocaled = iUserLocale;
512   { iDefault: don't take into account user locale, ascending, case insensitive,
513     word sort order }
514   iDefault = 0;
515 
CmpStrFnull516 function CmpStrF(const S1, S2: String; Flags: LongInt): Integer;
517 { Result value >0 if S1 greater then S2, <0 if S1 less then S2, and 0 if equal.
518   If Flags = 0 then CmpStrF compares S1 and S2 in the same way as if they were
519   compared using "<" and ">" operators.
520   If Flags <> 0 then CmpStrF uses Windows API CompareString function which
521   supports several methods for comparing strings: at first, it can use either
522   System Locale or Current User Locale; then, it can treat strings in the
523   case-sensitive or case-insensitive manner; and, at last, it uses "word sort"
524   or "string sort" variants (see Windows Help for details). Specify the mode you
525   want in the Flags parameter (see constants above). }
526 
527 {$IFDEF V_WIDESTRINGS}
WStrCmpnull528 function WStrCmp(PLeft, PRight: PWideChar): Integer;
CompareWidenull529 function CompareWide(const Left, Right: WideString): Integer;
CompareStrBufWidenull530 function CompareStrBufWide(PW1, PW2: PWideChar; Count1, Count2: Integer): Integer;
CompareStrWidenull531 function CompareStrWide(const W1, W2: WideString): Integer;
532 { compare strings case sensitively }
533 {$ENDIF}
534 
CompareStrBufnull535 function CompareStrBuf(P1, P2: PChar; Count1, Count2: Integer): Integer;
CompareTextBufnull536 function CompareTextBuf(P1, P2: PChar; Count1, Count2: Integer): Integer;
537 
MemEqualStrnull538 function MemEqualStr(const X; const S: String): Boolean;
539 
CompareVersionsnull540 function CompareVersions(Ver1, Ver2: String;
541   pError: PBoolean{$IFDEF V_DEFAULTS} = nil{$ENDIF}): Integer;
542 { compares version strings; version string consists of several numbers,
543   delimited by dots ('NN.NN.NN') }
544 
545 implementation
546 
547 {$IFDEF V_INLINE}
LoCasenull548 function LoCase(C: Char): Char;
549 begin
550   Result:=C;
551   if C in ['A'..'Z'] then
552     Result:=Chr(Ord(Result) or $20);
553 end;
554 {$ELSE}
LoCasenull555 function LoCase(C: Char): Char;
556 {$IFNDEF USE_ASM}
557 begin
558   Result:=C;
559   if C in ['A'..'Z'] then
560     Result:=Chr(Ord(Result) or $20);
561 end;
562 {$ELSE}
563 asm
564 { ->    AL      Character       }
565 { <-    AL      Result          }
566         {$IFDEF V_FREEPASCAL}
567         mov     al, C
568         {$ENDIF}
569         CMP     AL, 'A'
570         JB      @@exit
571         CMP     AL, 'Z'
572         JA      @@exit
573         ADD     AL, 'a' - 'A'
574 @@exit:
575 end;
576 {$ENDIF} {USSE_ASM}
577 {$ENDIF} {V_INLINE}
578 
NumOfCharsnull579 function NumOfChars(C: Char; const S: String): Integer;
580 var
581   I: Integer;
582 begin
583   Result:=0;
584   for I:=1 to Length(S) do
585     if S[I] = C then
586       Inc(Result);
587 end;
588 
589 {$IFDEF V_WIDESTRINGS}
NumOfWideCharsnull590 function NumOfWideChars(C: WideChar; const S: WideString): Integer;
591 var
592   I: Integer;
593 begin
594   Result:=0;
595   for I:=1 to Length(S) do
596     if S[I] = C then
597       Inc(Result);
598 end;
599 {$ENDIF}
600 
NumOfSubStrnull601 function NumOfSubStr(const SubS, S: String): Integer;
602 var
603   I: Integer;
604 begin
605   Result:=0;
606   I:=0;
607   repeat
608     I:=PosFrom(SubS, S, I);
609     if I = 0 then
610       Exit;
611     Inc(Result);
612     Inc(I, Length(SubS));
613   until False;
614 end;
615 
616 {$IFDEF V_WIDESTRINGS}
WideNumOfSubStrnull617 function WideNumOfSubStr(const SubS, S: WideString): Integer;
618 var
619   I: Integer;
620 begin
621   Result:=0;
622   I:=0;
623   repeat
624     I:=WidePosFrom(SubS, S, I);
625     if I = 0 then
626       Exit;
627     Inc(Result);
628     Inc(I, Length(SubS));
629   until False;
630 end;
631 {$ENDIF}
632 
633 {$IFDEF V_WIDESTRINGS}
WideCharInnull634 function WideCharIn(W: WideChar; const Chars: TCharSet): Boolean;
635 begin
636   Result:=(W < #256) and (Char(W) in Chars);
637 end;
638 {$ENDIF}
639 
IsASCIIStringnull640 function IsASCIIString(const S: String): Boolean;
641 var
642   I: Integer;
643 begin
644   for I:=1 to Length(S) do
645     if S[I] >= #128 then begin
646       Result:=False;
647       Exit;
648     end;
649   Result:=True;
650 end;
651 
652 {$IFDEF V_WIDESTRINGS}
IsASCIIWideStringnull653 function IsASCIIWideString(const S: WideString): Boolean;
654 var
655   I: Integer;
656 begin
657   for I:=1 to Length(S) do
658     if S[I] >= #128 then begin
659       Result:=False;
660       Exit;
661     end;
662   Result:=True;
663 end;
664 {$ENDIF}
665 
CharPosnull666 function CharPos(C: Char; const S: String; From: Integer): Integer;
667 var
668   I, J: Integer;
669 begin
670   if From < 1 then
671     From:=1;
672   {$IFDEF V_LONGSTRINGS}
673   Result:=0;
674   I:=Length(S);
675   if From <= I then begin
676     J:=From - 1;
677     I:=IndexOfValue8((PChar(Pointer(S)) + J)^, Ord(C), I - J);
678     if I >= 0 then
679       Result:=I + From;
680   end;
681   {$ELSE}
682   for I:=From to Length(S) do
683     if S[I] = C then begin
684       Result:=I;
685       Exit;
686     end;
687   Result:=0;
688   {$ENDIF}
689 end;
690 
691 {$IFDEF V_WIDESTRINGS}
WideCharPosnull692 function WideCharPos(C: WideChar; const S: WideString; From: Integer): Integer;
693 var
694   I, J: Integer;
695 begin
696   Result:=0;
697   if From < 1 then
698     From:=1;
699   I:=Length(S);
700   if From <= I then begin
701     J:=From - 1;
702     I:=IndexOfValue16((PWideChar(Pointer(S)) + J)^, Ord(C), I - J);
703     if I >= 0 then
704       Result:=I + From;
705   end;
706 end;
707 {$ENDIF}
708 
CharNPosnull709 function CharNPos(C: Char; const S: String; N: Integer;
710   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
711 var
712   I{$IFDEF V_LONGSTRINGS}, J, L{$ENDIF}: Integer;
713 begin
714   if From < 1 then
715     From:=1;
716   {$IFDEF V_LONGSTRINGS}
717   L:=Length(S);
718   while From <= L do begin
719     J:=From - 1;
720     I:=IndexOfValue8((PChar(Pointer(S)) + J)^, Ord(C), L - J);
721     if I < 0 then
722       Break;
723     Dec(N);
724     if N <= 0 then begin
725       Result:=I + From;
726       Exit;
727     end;
728     Inc(From, I + 1);
729   end;
730   Result:=0;
731   {$ELSE}
732   for I:=From to Length(S) do
733     if S[I] = C then begin
734       Dec(N);
735       if N <= 0 then begin
736         Result:=I;
737         Exit;
738       end;
739     end;
740   Result:=0;
741   {$ENDIF}
742 end;
743 
744 {$IFDEF V_WIDESTRINGS}
WideCharNPosnull745 function WideCharNPos(C: WideChar; const S: WideString; N: Integer;
746   From: Integer{$IFDEF V_DEFAULTS} = 1{$ENDIF}): Integer;
747 var
748   I, J, L: Integer;
749 begin
750   if From < 1 then
751     From:=1;
752   L:=Length(S);
753   while From <= L do begin
754     J:=From - 1;
755     I:=IndexOfValue16((PWideChar(Pointer(S)) + J)^, Ord(C), L - J);
756     if I < 0 then
757       Break;
758     Dec(N);
759     if N <= 0 then begin
760       Result:=I + From;
761       Exit;
762     end;
763     Inc(From, I + 1);
764   end;
765   Result:=0;
766 end;
767 {$ENDIF}
768 
LastPosnull769 function LastPos(C: Char; const S: String): Integer;
770 var
771   I: Integer;
772 begin
773   Result:=0;
774   for I:=Length(S) downto 1 do
775     if S[I] = C then begin
776       Result:=I;
777       Exit;
778     end;
779 end;
780 
781 {$IFDEF V_WIDESTRINGS}
WideLastPosnull782 function WideLastPos(C: WideChar; const S: WideString): Integer;
783 var
784   I: Integer;
785 begin
786   Result:=0;
787   for I:=Length(S) downto 1 do
788     if S[I] = C then begin
789       Result:=I;
790       Exit;
791     end;
792 end;
793 {$ENDIF}
794 
CharInSetPosnull795 function CharInSetPos(const Chars: TCharSet; const S: String; From: Integer): Integer;
796 var
797   I: Integer;
798 begin
799   if From < 1 then
800     From:=1;
801   for I:=From to Length(S) do
802     if S[I] in Chars then begin
803       Result:=I;
804       Exit;
805     end;
806   Result:=0;
807 end;
808 
809 {$IFDEF V_WIDESTRINGS}
WideCharInSetPosnull810 function WideCharInSetPos(const Chars: TCharSet; const S: WideString; From: Integer): Integer;
811 var
812   I: Integer;
813   W: WideChar;
814 begin
815   if From < 1 then
816     From:=1;
817   for I:=From to Length(S) do begin
818     W:=S[I];
819     if (W < #256) and (Char(W) in Chars) then begin
820       Result:=I;
821       Exit;
822     end;
823   end;
824   Result:=0;
825 end;
826 {$ENDIF}
827 
CharNotInSetPosnull828 function CharNotInSetPos(const Chars: TCharSet; const S: String; From: Integer): Integer;
829 var
830   I: Integer;
831 begin
832   if From < 1 then
833     From:=1;
834   for I:=From to Length(S) do
835     if not (S[I] in Chars) then begin
836       Result:=I;
837       Exit;
838     end;
839   Result:=0;
840 end;
841 
842 {$IFDEF V_WIDESTRINGS}
WideCharNotInSetPosnull843 function WideCharNotInSetPos(const Chars: TCharSet; const S: WideString; From: Integer): Integer;
844 var
845   I: Integer;
846   W: WideChar;
847 begin
848   if From < 1 then
849     From:=1;
850   for I:=From to Length(S) do begin
851     W:=S[I];
852     if (W >= #256) or not (Char(W) in Chars) then begin
853       Result:=I;
854       Exit;
855     end;
856   end;
857   Result:=0;
858 end;
859 {$ENDIF}
860 
861 {$IFDEF V_WIN}
AnsiTextPosnull862 function AnsiTextPos(const SubS, S: String): Integer;
863 begin
864   Result:=Pos(AnsiUpperCase(SubS), AnsiUpperCase(S));
865 end;
866 {$ENDIF}
867 
FirstUppernull868 function FirstUpper(const S: String): String;
869 begin
870   Result:=S;
871   FirstUpperProc(Result);
872 end;
873 
874 procedure FirstUpperProc(var S: String);
875 {$IFDEF V_WIN}
876 var
877   Buf: array [0..1] of Char;
878 {$ENDIF}
879 begin
880   if S <> '' then begin
881     {$IFDEF V_WIN}
882     Buf[0]:=S[1];
883     Buf[1]:=#0;
884     {$IFDEF WIN32}
885     CharUpper(Buf);
886     {$ELSE}
887     AnsiUpper(Buf);
888     {$ENDIF}
889     S[1]:=Buf[0];
890     {$ELSE}
891     S[1]:=UpCase(S[1]);
892     {$ENDIF}
893   end;
894 end;
895 
FirstLowernull896 function FirstLower(const S: String): String;
897 begin
898   Result:=S;
899   FirstLowerProc(Result);
900 end;
901 
902 procedure FirstLowerProc(var S: String);
903 {$IFDEF V_WIN}
904 var
905   Buf: array [0..1] of Char;
906 {$ENDIF}
907 begin
908   if S <> '' then begin
909     {$IFDEF V_WIN}
910     Buf[0]:=S[1];
911     Buf[1]:=#0;
912     {$IFDEF WIN32}
913     CharLower(Buf);
914     {$ELSE}
915     AnsiLower(Buf);
916     {$ENDIF}
917     S[1]:=Buf[0];
918     {$ELSE}
919     S[1]:=LoCase(S[1]);
920     {$ENDIF}
921   end;
922 end;
923 
DelLastNnull924 function DelLastN(const S: String; N: Integer): String;
925 begin
926   N:=Length(S) - N;
927   if N > 0 then
928     Result:=Copy(S, 1, N)
929   else
930     Result:='';
931 end;
932 
DelLastIfnull933 function DelLastIf(const S: String; C: Char): String;
934 begin
935   Result:=S;
936   if (S <> '') and (S[Length(S)] = C) then
937     SetLength(Result, Length(S) - 1);
938 end;
939 
FirstCharnull940 function FirstChar(const S: String): Char;
941 begin
942   Result:=#0;
943   if S <> '' then
944     Result:=S[1];
945 end;
946 
LastCharnull947 function LastChar(const S: String): Char;
948 begin
949   Result:=#0;
950   if S <> '' then
951     Result:=S[Length(S)];
952 end;
953 
954 {$IFDEF V_WIDESTRINGS}
WideFirstCharnull955 function WideFirstChar(const S: WideString): WideChar;
956 begin
957   Result:=#0;
958   if S <> '' then
959     Result:=S[1];
960 end;
961 
WideLastCharnull962 function WideLastChar(const S: WideString): WideChar;
963 begin
964   Result:=#0;
965   if S <> '' then
966     Result:=S[Length(S)];
967 end;
968 {$ENDIF}
969 
EnsureLastnull970 function EnsureLast(const S: String; C: Char): String;
971 var
972   L: Integer;
973 begin
974   Result:=S;
975   L:=Length(S);
976   if (L > 0) and (S[L] <> C) then
977     Result:=Result + C;
978 end;
979 
980 {$IFDEF V_WIDESTRINGS}
WideEnsureLastnull981 function WideEnsureLast(const S: WideString; C: WideChar): WideString;
982 var
983   L: Integer;
984 begin
985   Result:=S;
986   L:=Length(Result);
987   if (L > 0) and (Result[L] <> C) then begin
988     Inc(L);
989     SetLength(Result, L);
990     Result[L]:=C;
991   end;
992 end;
993 {$ENDIF}
994 
CloseSentencenull995 function CloseSentence(const S: String): String;
996 begin
997   Result:=S;
998   CloseSentenceProc(Result);
999 end;
1000 
1001 procedure CloseSentenceProc(var S: String);
1002 begin
1003   if (S <> '') and not (S[Length(S)] in ['.', '!', '?']) then
1004     S:=S + '.';
1005 end;
1006 
1007 {$IFDEF V_WIDESTRINGS}
WideCloseSentencenull1008 function WideCloseSentence(const S: WideString): WideString;
1009 begin
1010   Result:=S;
1011   WideCloseSentenceProc(Result);
1012 end;
1013 
1014 procedure WideCloseSentenceProc(var S: WideString);
1015 var
1016   WC: WideChar;
1017 begin
1018   if S <> '' then begin
1019     WC:=S[Length(S)];
1020     if not ((WC < #256) and (Char(WC) in ['.', '!', '?'])) then
1021       S:=S + '.';
1022   end;
1023 end;
1024 {$ENDIF}
1025 
1026 procedure ConcatDelimited(var S: String; const Tail: String; Delimiter: Char);
1027 begin
1028   if Tail <> '' then begin
1029     if S <> '' then
1030       S:=S + Delimiter;
1031     S:=S + Tail;
1032   end;
1033 end;
1034 
1035 {$IFDEF V_WIDESTRINGS}
1036 procedure WideConcatDelimited(var S: WideString; const Tail: WideString; Delimiter: WideChar);
1037 begin
1038   if Tail <> '' then begin
1039     {$IFDEF V_WIDESTRING_PLUS}
1040     if S <> '' then
1041       S:=S + Delimiter;
1042     S:=S + Tail;
1043     {$ELSE}
1044     if S <> '' then
1045       WideAppend(S, Delimiter);
1046     WideAppendStr(S, Tail);
1047     {$ENDIF}
1048   end;
1049 end;
1050 {$ENDIF}
1051 
1052 {$IFDEF V_WIDESTRINGS}
1053 procedure WideAppend(var S: WideString; C: WideChar);
1054 var
1055   L: Integer;
1056 begin
1057   L:=Length(S) + 1;
1058   SetLength(S, L);
1059   S[L]:=C;
1060 end;
1061 
1062 procedure WideAppendStr(var S: WideString; const Tail: WideString);
1063 var
1064   L, T: Integer;
1065 begin
1066   T:=Length(Tail);
1067   if T = 0 then
1068     Exit;
1069   L:=Length(S);
1070   if L = 0 then
1071     S:=Tail
1072   else begin
1073     SetLength(S, L + T);
1074     Move(Pointer(Tail)^, PWideChar(Pointer(S))[L], T * 2);
1075   end;
1076 end;
1077 {$ENDIF}
1078 
PosFromnull1079 function PosFrom(const SubStr, S: String; From: Integer): Integer;
1080 begin
1081   if From < 1 then
1082     From:=1;
1083   Result:=Pos(SubStr, Copy(S, From, Length(S)));
1084   if Result > 0 then
1085     Inc(Result, From - 1);
1086 end;
1087 
1088 {$IFDEF V_WIDESTRINGS}
WidePosFromnull1089 function WidePosFrom(const SubStr, S: WideString; From: Integer): Integer;
1090 begin
1091   if From < 1 then
1092     From:=1;
1093   Result:=Pos(SubStr, Copy(S, From, Length(S)));
1094   if Result > 0 then
1095     Inc(Result, From - 1);
1096 end;
1097 {$ENDIF}
1098 
StartsWithnull1099 function StartsWith(const S, What: String): Boolean;
1100 var
1101   I, L: Integer;
1102 begin
1103   Result:=False;
1104   L:=Length(What);
1105   if L > Length(S) then
1106     Exit;
1107   for I:=1 to L do
1108     if S[I] <> What[I] then
1109       Exit;
1110   Result:=True;
1111 end;
1112 
1113 {$IFDEF V_WIDESTRINGS}
WideStartsWithnull1114 function WideStartsWith(const S, What: WideString): Boolean;
1115 var
1116   I, L: Integer;
1117 begin
1118   Result:=False;
1119   L:=Length(What);
1120   if L > Length(S) then
1121     Exit;
1122   for I:=1 to L do
1123     if S[I] <> What[I] then
1124       Exit;
1125   Result:=True;
1126 end;
1127 {$ENDIF}
1128 
AnsiStartsWithnull1129 function AnsiStartsWith(const S, What: String): Boolean;
1130 var
1131   L: Integer;
1132 begin
1133   Result:=False;
1134   L:=Length(What);
1135   if L > Length(S) then
1136     Exit;
1137   Result:=AnsiSameText(Copy(S, 1, L), What);
1138 end;
1139 
EndsWithnull1140 function EndsWith(const S, What: String): Boolean;
1141 var
1142   I, J, N, L: Integer;
1143 begin
1144   Result:=False;
1145   L:=Length(S);
1146   N:=L - Length(What);
1147   if N < 0 then
1148     Exit;
1149   J:=1;
1150   for I:=N + 1 to L do begin
1151     if S[I] <> What[J] then
1152       Exit;
1153     Inc(J);
1154   end;
1155   Result:=True;
1156 end;
1157 
1158 {$IFDEF V_WIDESTRINGS}
WideEndsWithnull1159 function WideEndsWith(const S, What: WideString): Boolean;
1160 var
1161   I, J, N, L: Integer;
1162 begin
1163   Result:=False;
1164   L:=Length(S);
1165   N:=L - Length(What);
1166   if N < 0 then
1167     Exit;
1168   J:=1;
1169   for I:=N + 1 to L do begin
1170     if S[I] <> What[J] then
1171       Exit;
1172     Inc(J);
1173   end;
1174   Result:=True;
1175 end;
1176 {$ENDIF}
1177 
1178 {$IFDEF V_DELPHI}
1179 {$IFNDEF V_D3}
Trimnull1180 function Trim(const S: String): String;
1181 {$ELSE}
TrimWnull1182 function TrimW(const S: WideString): WideString;
1183 {$ENDIF}
1184 var
1185   I, J: Integer;
1186 begin
1187   I:=1;
1188   while (I <= Length(S)) and (S[I] <= ' ') do Inc(I);
1189   J:=Length(S);
1190   while (J >= 1) and (S[J] <= ' ') do Dec(J);
1191   Result:=Copy(S, I, J - I + 1)
1192 end;
1193 {$ENDIF}
1194 
1195 {$IFNDEF V_D5} { Delphi 1-4, Free Pascal }
AnsiSameTextnull1196 function AnsiSameText(const S1, S2: String): Boolean;
1197 begin
1198   {$IFDEF WIN32}
1199   Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1),
1200     Length(S1), PChar(S2), Length(S2)) = 2;
1201   {$ELSE}
1202   Result:=AnsiCompareText(S1, S2) = 0;
1203   {$ENDIF}
1204 end;
1205 {$ENDIF}
1206 
1207 {$IFDEF V_WIDESTRINGS}
1208 {$IFNDEF V_D6}
WideCompareTextnull1209 function WideCompareText(const S1, S2: WideString): Integer;
1210 begin
1211 {$IFDEF MSWINDOWS}
1212   SetLastError(0);
1213   Result:=CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PWideChar(S1),
1214     Length(S1), PWideChar(S2), Length(S2)) - 2;
1215   Case GetLastError of
1216     0: ;
1217     ERROR_CALL_NOT_IMPLEMENTED:
1218       Result:=CompareStringA(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
1219         PChar(String(S1)), Length(S1), PChar(String(S2)), Length(S2)) - 2;
1220   Else
1221     RaiseLastOSError;
1222   End;
1223 {$ENDIF}
1224 {$IFDEF UNIX}
1225   Result:=WideCompareStr(WideUpperCase(S1), WideUpperCase(S2));
1226 {$ENDIF}
1227 end;
1228 
WideSameTextnull1229 function WideSameText(const S1, S2: WideString): Boolean;
1230 begin
1231   Result:=WideCompareText(S1, S2) = 0;
1232 end;
1233 {$ENDIF}
1234 {$ENDIF}
1235 
TrimTrailnull1236 function TrimTrail(const S: String): String;
1237 var
1238   I: Integer;
1239 begin
1240   I:=Length(S);
1241   while (I >= 1) and (S[I] <= ' ') do Dec(I);
1242   Result:=S;
1243   SetLength(Result, I);
1244 end;
1245 
1246 {$IFDEF V_WIDESTRINGS}
TrimTrailWnull1247 function TrimTrailW(const S: WideString): WideString;
1248 var
1249   I: Integer;
1250 begin
1251   I:=Length(S);
1252   while (I >= 1) and (S[I] <= ' ') do Dec(I);
1253   Result:=S;
1254   SetLength(Result, I);
1255 end;
1256 {$ENDIF}
1257 
TruncateAtZeronull1258 function TruncateAtZero(const S: String): String;
1259 begin
1260   Result:=S;
1261   TruncateAtZeroProc(Result);
1262 end;
1263 
1264 procedure TruncateAtZeroProc(var S: String);
1265 var
1266   I: Integer;
1267 begin
1268   I:=CharPos(#0, S, 1);
1269   if I > 0 then
1270     SetLength(S, I - 1);
1271 end;
1272 
1273 {$IFDEF V_WIDESTRINGS}
TruncateAtZeroWidenull1274 function TruncateAtZeroWide(const S: WideString): WideString;
1275 begin
1276   Result:=S;
1277   TruncateAtZeroProcWide(Result);
1278 end;
1279 
1280 procedure TruncateAtZeroProcWide(var S: WideString);
1281 var
1282   I: Integer;
1283 begin
1284   I:=WideCharPos(#0, S, 1);
1285   if I > 0 then
1286     SetLength(S, I - 1);
1287 end;
1288 {$ENDIF}
1289 
TrimLastNnull1290 function TrimLastN(const S: String; N: Integer): String;
1291 var
1292   L: Integer;
1293 begin
1294   L:=Length(S) - N;
1295   if L < 0 then
1296     L:=0;
1297   Result:=Copy(S, 1, L);
1298 end;
1299 
1300 procedure TrimLastNProc(var S: String; N: Integer);
1301 var
1302   L: Integer;
1303 begin
1304   L:=Length(S) - N;
1305   if L < 0 then
1306     L:=0;
1307   SetLength(S, L);
1308 end;
1309 
1310 {$IFDEF V_WIDESTRINGS}
WideTrimLastNnull1311 function WideTrimLastN(const S: WideString; N: Integer): WideString;
1312 var
1313   L: Integer;
1314 begin
1315   L:=Length(S) - N;
1316   if L < 0 then
1317     L:=0;
1318   Result:=Copy(S, 1, L);
1319 end;
1320 
1321 procedure WideTrimLastNProc(var S: WideString; N: Integer);
1322 var
1323   L: Integer;
1324 begin
1325   L:=Length(S) - N;
1326   if L < 0 then
1327     L:=0;
1328   SetLength(S, L);
1329 end;
1330 {$ENDIF}
1331 
IsWhiteSpacenull1332 function IsWhiteSpace(const S: String): Boolean;
1333 var
1334   I: Integer;
1335 begin
1336   for I:=1 to Length(S) do
1337     if S[I] > ' ' then begin
1338       Result:=False;
1339       Exit;
1340     end;
1341   Result:=True;
1342 end;
1343 
MakeStringnull1344 function MakeString(C: Char; N: Integer): String;
1345 begin
1346   if N > 0 then begin
1347     {$IFDEF V_LONGSTRINGS}
1348     SetLength(Result, N);
1349     {$ELSE}
1350     if N > 255 then
1351       N:=255;
1352     Result[0]:=Chr(N);
1353     {$ENDIF}
1354     FillChar(Result[1], Length(Result), C);
1355   end
1356   else
1357     Result:='';
1358 end;
1359 
1360 {$IFDEF V_WIDESTRINGS}
MakeWideStringnull1361 function MakeWideString(C: WideChar; N: Integer): WideString;
1362 begin
1363   SetLength(Result, N);
1364   if N > 0 then
1365     FillValue16(Result[1], Int16(C), N);
1366 end;
1367 {$ENDIF}
1368 
AddCharnull1369 function AddChar(C: Char; const S: String; N: Integer): String;
1370 begin
1371   if Length(S) < N then
1372     Result:=MakeString(C, N - Length(S)) + S
1373   else
1374     Result := S;
1375 end;
1376 
ReplaceStrnull1377 function ReplaceStr(const Value, FromStr, ToStr: String): String;
1378 var
1379   I: Integer;
1380   Source: String;
1381 begin
1382   Source:=Value;
1383   Result:='';
1384   repeat
1385     I:=Pos(FromStr, Source);
1386     if I > 0 then begin
1387       Result:=Result + Copy(Source, 1, I - 1) + ToStr;
1388       Source:=Copy(Source, I + Length(FromStr), Length(Source));
1389     end
1390     else begin
1391       Result:=Result + Source;
1392       Break;
1393     end;
1394   until False;
1395 end;
1396 
1397 {$IFDEF V_WIDESTRINGS}
WideReplaceStrnull1398 function WideReplaceStr(const Value, FromStr, ToStr: WideString): WideString;
1399 var
1400   I: Integer;
1401   Source: WideString;
1402 begin
1403   Source:=Value;
1404   Result:='';
1405   repeat
1406     I:=Pos(FromStr, Source);
1407     if I > 0 then begin
1408       Result:=Result + Copy(Source, 1, I - 1) + ToStr;
1409       Source:=Copy(Source, I + Length(FromStr), Length(Source));
1410     end
1411     else begin
1412       Result:=Result + Source;
1413       Break;
1414     end;
1415   until False;
1416 end;
1417 {$ENDIF}
1418 
1419 procedure ReplaceCharProc(var S: String; FromChar, ToChar: Char);
1420 var
1421   I: Integer;
1422 begin
1423   for I:=1 to Length(S) do
1424     if S[I] = FromChar then
1425       S[I]:=ToChar;
1426 end;
1427 
ReplaceCharnull1428 function ReplaceChar(const S: String; FromChar, ToChar: Char): String;
1429 begin
1430   Result:=S;
1431   ReplaceCharProc(Result, FromChar, ToChar);
1432 end;
1433 
1434 {$IFDEF V_WIDESTRINGS}
1435 procedure WideReplaceCharProc(var S: WideString; FromChar, ToChar: WideChar);
1436 var
1437   I: Integer;
1438 begin
1439   for I:=1 to Length(S) do
1440     if S[I] = FromChar then
1441       S[I]:=ToChar;
1442 end;
1443 
WideReplaceCharnull1444 function WideReplaceChar(const S: WideString; FromChar, ToChar: WideChar): WideString;
1445 begin
1446   Result:=S;
1447   WideReplaceCharProc(Result, FromChar, ToChar);
1448 end;
1449 {$ENDIF}
1450 
ContainsCharsnull1451 function ContainsChars(const S: String; Chars: TCharSet): Boolean;
1452 { alternative:
1453     Result:=ContainsCharsBuf(PChar(S), Length(S), Chars); }
1454 var
1455   I: Integer;
1456 begin
1457   for I:=1 to Length(S) do
1458     if S[I] in Chars then begin
1459       Result:=True;
1460       Exit;
1461     end;
1462   Result:=False;
1463 end;
1464 
ContainsCharsBufnull1465 function ContainsCharsBuf(const Buf: PChar; Size: Integer;
1466   const Chars: TCharSet): Boolean;
1467 var
1468   P, Limit: PChar;
1469 begin
1470   Result:=False;
1471   if (Buf = nil) or (Size <= 0) then
1472     Exit;
1473   P:=Buf;
1474   Limit:=Buf + Size;
1475   repeat
1476     if P^ in Chars then begin
1477       Result:=True;
1478       Exit;
1479     end;
1480     Inc(P);
1481   until P >= Limit;
1482 end;
1483 
1484 {$IFDEF V_WIDESTRINGS}
WideContainsCharsnull1485 function WideContainsChars(const S: WideString; Chars: TCharSet): Boolean;
1486 var
1487   I: Integer;
1488   C: WideChar;
1489 begin
1490   for I:=1 to Length(S) do begin
1491     C:=S[I];
1492     if (C < #256) and (Char(C) in Chars) then begin
1493       Result:=True;
1494       Exit;
1495     end;
1496   end;
1497   Result:=False;
1498 end;
1499 {$ENDIF}
1500 
ContainsOnlyCharsnull1501 function ContainsOnlyChars(const S: String; const Chars: TCharSet): Boolean;
1502 { alternative:
1503     Result:=ContainsOnlyCharsBuf(PChar(S), Length(S), Chars); }
1504 var
1505   I: Integer;
1506 begin
1507   Result:=False;
1508   if S = '' then
1509     Exit;
1510   for I:=1 to Length(S) do
1511     if not (S[I] in Chars) then
1512       Exit;
1513   Result:=True;
1514 end;
1515 
ContainsOnlyCharsBufnull1516 function ContainsOnlyCharsBuf(const Buf: PChar; Size: Integer;
1517   const Chars: TCharSet): Boolean;
1518 var
1519   P, Limit: PChar;
1520 begin
1521   Result:=False;
1522   if (Buf = nil) or (Size <= 0) then
1523     Exit;
1524   P:=Buf;
1525   Limit:=Buf + Size;
1526   repeat
1527     if not (P^ in Chars) then
1528       Exit;
1529     Inc(P);
1530   until P >= Limit;
1531   Result:=True;
1532 end;
1533 
DelDupCharnull1534 function DelDupChar(const S: String; C: Char): String;
1535 var
1536   I, J: Integer;
1537   CurChar, LastChar: Char;
1538 begin
1539   SetLength(Result, Length(S));
1540   if Length(S) > 0 then begin
1541     LastChar:=S[1];
1542     Result[1]:=LastChar;
1543     J:=1;
1544     for I:=2 to Length(S) do begin
1545       CurChar:=S[I];
1546       if (CurChar <> C) or (CurChar <> LastChar) then begin
1547         Inc(J);
1548         Result[J]:=CurChar;
1549         LastChar:=CurChar;
1550       end;
1551     end;
1552     SetLength(Result, J);
1553   end;
1554 end;
1555 
1556 {$IFDEF V_LONGSTRINGS}
DecodeCEscapesnull1557 function DecodeCEscapes(const S: String): String;
1558 var
1559   State: (sNeutral, sWasSlash, sOct, sHex);
1560 
ConvertToNumbernull1561   function ConvertToNumber(S: String; var Num: Integer): Boolean;
1562   var
1563     I, J, Code: Integer;
1564   begin
1565     Result:=False;
1566     if State = sHex then begin
1567       Val(S, J, Code);
1568       if (Code <> 0) or (J > 255) then
1569         Exit;
1570     end
1571     else begin
1572       J:=0;
1573       for I:=1 to Length(S) do begin
1574         Code:=Ord(S[I]) - Ord('0');
1575         if (Code < 0) or (Code > 7) then
1576           Exit;
1577         J:=J * 8 + Code;
1578         if J > 255 then
1579           Exit;
1580       end;
1581     end;
1582     Num:=J;
1583     Result:=True;
1584   end;
1585 
1586 var
1587   I, J, CharCode: Integer;
1588   C: Char;
1589   InP, OutP, InLimit: PChar;
1590   Number: String;
1591 begin
1592   I:=CharPos('\', S, 1);
1593   if I = 0 then
1594     Result:=S
1595   else begin
1596     CharCode:=-1;
1597     State:=sWasSlash;
1598     J:=I - 1;
1599     Result:=Copy(S, 1, J);
1600     InP:=PChar(Pointer(S)) + I;
1601     I:=Length(S);
1602     InLimit:=PChar(Pointer(S)) + I;
1603     SetLength(Result, I);
1604     OutP:=PChar(Pointer(Result)) + J;
1605     while InP < InLimit do begin
1606       C:=InP^;
1607       Case State of
1608         sNeutral: begin
1609           if C <> '\' then begin
1610             OutP^:=C;
1611             Inc(OutP);
1612           end
1613           else
1614             State:=sWasSlash;
1615           Inc(InP);
1616         end;
1617         sWasSlash: begin
1618           Case C of
1619             '0'..'7': begin
1620               Number:=C;
1621               CharCode:=Ord(C) - Ord('0');
1622               State:=sOct;
1623               Inc(InP);
1624               Continue;
1625             end;
1626             'a': C:=#7;
1627             'b': C:=#8;
1628             'f': C:=#$0C;
1629             'n': begin
1630               OutP^:=#$0D;
1631               Inc(OutP);
1632               C:=#$0A;
1633             end;
1634             'r': C:=#$0D;
1635             't': C:=#9;
1636             'v': C:=#$0B;
1637             '\', '''', '"', '?': ; // C:=C
1638             'x': begin
1639               Number:='$';
1640               State:=sHex;
1641               Inc(InP);
1642               Continue;
1643             end;
1644           Else begin
1645             OutP^:='\';
1646             Inc(OutP);
1647           end;
1648           End;
1649           OutP^:=C;
1650           Inc(InP);
1651           Inc(OutP);
1652           State:=sNeutral;
1653         end;
1654         sOct, sHex: begin
1655           Number:=Number + C;
1656           if ConvertToNumber(Number, CharCode) then
1657             Inc(InP)
1658           else begin
1659             if CharCode >= 0 then begin
1660               OutP^:=Chr(CharCode);
1661               CharCode:=-1;
1662             end
1663             else begin
1664               OutP^:='\';
1665               if State = sHex then begin
1666                 Inc(OutP);
1667                 OutP^:='x';
1668               end;
1669             end;
1670             Inc(OutP);
1671             State:=sNeutral;
1672           end;
1673         end;
1674       End;
1675     end; {while}
1676     Case State of
1677       sOct, sHex:
1678         if CharCode >= 0 then begin
1679           OutP^:=Chr(CharCode);
1680           Inc(OutP);
1681         end;
1682       sWasSlash: begin
1683         OutP^:='\';
1684         Inc(OutP);
1685       end;
1686     End;
1687     SetLength(Result, OutP - PChar(Pointer(Result)));
1688   end;
1689 end;
1690 
EncodeCEscapesnull1691 function EncodeCEscapes(const S: String; Only7Bit: Boolean): String;
1692 var
1693   I, L: Integer;
1694   C, Slash: Char;
1695   OutP: PChar;
1696   Hex: String[2];
1697 begin
1698   L:=Length(S);
1699   SetLength(Result, 4 * L);
1700   OutP:=Pointer(Result);
1701   I:=1;
1702   while I <= L do begin
1703     C:=S[I];
1704     Case C of
1705       #7: Slash:='a';
1706       #8: Slash:='b';
1707       #9: Slash:='t';
1708       #$0B: Slash:='v';
1709       #$0C: Slash:='f';
1710       #$0D:
1711         if (I < L) and (S[I + 1] = #$0A) then begin
1712           Slash:='n';
1713           Inc(I);
1714         end
1715         else
1716           Slash:='r';
1717       '\', '''', '"', '?': Slash:=C;
1718     Else begin
1719       Slash:=#0;
1720       if (C < ' ') or Only7Bit and (C >= #128) then
1721         if C < #8 then
1722           Slash:=Chr(Ord(C) + Ord('0'))
1723         else begin
1724           OutP^:='\';
1725           Inc(OutP);
1726           OutP^:='x';
1727           Inc(OutP);
1728           Hex:=IntToHex(Ord(C), 0);
1729           OutP^:=Hex[1];
1730           Inc(OutP);
1731           if Length(Hex) > 1 then begin
1732             OutP^:=Hex[2];
1733             Inc(OutP);
1734           end;
1735         end
1736       else begin
1737         OutP^:=C;
1738         Inc(OutP);
1739       end;
1740     end;
1741     End;
1742     if Slash <> #0 then begin
1743       OutP^:='\';
1744       Inc(OutP);
1745       OutP^:=Slash;
1746       Inc(OutP);
1747     end;
1748     Inc(I);
1749   end; {while}
1750   SetLength(Result, OutP - PChar(Pointer(Result)));
1751 end;
1752 {$ENDIF}
1753 
1754 {$IFDEF WIN32}
WordPosnull1755 function WordPos(SubWord, S: String; CaseSensitive: Boolean): Integer;
1756 var
1757   LSub, LStr: Integer;
1758   P, PSub, PStr, Limit: PChar;
1759 begin
1760   Result:=0;
1761   LSub:=Length(SubWord);
1762   LStr:=Length(S);
1763   if (LSub = 0) or (LSub > LStr) then
1764     Exit;
1765   if not CaseSensitive then begin
1766     UniqueString(SubWord);
1767     CharUpperBuff(Pointer(SubWord), LSub);
1768     UniqueString(S);
1769     CharUpperBuff(Pointer(S), LStr);
1770   end;
1771   PSub:=Pointer(SubWord);
1772   PStr:=Pointer(S);
1773   P:=PStr;
1774   Limit:=PStr + LStr;
1775   repeat
1776     P:=StrPos(P, PSub);
1777     if P = nil then
1778       Exit;
1779     if ((P = PStr) or not IsCharAlphaNumeric((P - 1)^)) and
1780       ((P + LSub >= Limit) or not IsCharAlphaNumeric((P + LSub)^))
1781     then
1782       Break;
1783     Inc(P);
1784   until P >= Limit;
1785   Result:=P - PStr + 1;
1786 end;
1787 
AnsiToOemnull1788 function AnsiToOem(const S: String): String;
1789 begin
1790   SetLength(Result, Length(S));
1791   if S <> '' then
1792     CharToOEM(Pointer(S), Pointer(Result));
1793 end;
1794 
OemToAnsinull1795 function OemToAnsi(const S: String): String;
1796 begin
1797   SetLength(Result, Length(S));
1798   if S <> '' then
1799     OemToChar(Pointer(S), Pointer(Result));
1800 end;
1801 
1802 procedure AnsiToOemProc(var S: String);
1803 begin
1804   UniqueString(S);
1805   CharToOEM(Pointer(S), Pointer(S));
1806 end;
1807 
1808 procedure OemToAnsiProc(var S: String);
1809 begin
1810   UniqueString(S);
1811   OEMToChar(Pointer(S), Pointer(S));
1812 end;
1813 {$ENDIF}
1814 
IsCorrectIdentifiernull1815 function IsCorrectIdentifier(const S: String; AcceptIndexes: Boolean): Boolean;
1816 var
1817   I, J, K, L, M, LT: Integer;
1818   T, Indexes: String;
1819 begin
1820   Result:=False;
1821   if S <> '' then begin
1822     if S[1] in Digits then
1823       Exit;
1824     L:=Length(S);
1825     if AcceptIndexes then begin
1826       I:=CharPos('[', S, 1);
1827       if I > 0 then begin
1828         if S[L] <> ']' then
1829           Exit;
1830         Indexes:=Copy(S, I + 1, L - (I + 1));
1831         repeat
1832           J:=CharPos(',', Indexes, 1);
1833           if J > 0 then
1834             T:=Copy(Indexes, 1, J - 1)
1835           else
1836             T:=Indexes;
1837           K:=0;
1838           LT:=Length(T);
1839           repeat
1840             Inc(K);
1841             if K > LT then
1842               Exit;
1843           until T[K] <> ' ';
1844           while (LT > 0) and (T[LT] = ' ') do
1845             Dec(LT);
1846           for M:=K to LT do
1847             if not (T[M] in Digits) then
1848               Exit;
1849           if J = 0 then
1850             Break;
1851           Delete(Indexes, 1, J);
1852         until False;
1853         L:=I - 1;
1854       end;
1855     end;
1856     for I:=1 to L do
1857       if not (S[I] in ASCIIAlphaNumeric + ['_']) then
1858         Exit;
1859     Result:=True;
1860   end;
1861 end;
1862 
IsCorrectQualifiedIdentifiernull1863 function IsCorrectQualifiedIdentifier(S: String; AcceptIndexes: Boolean): Boolean;
1864 var
1865   I: Integer;
1866 begin
1867   repeat
1868     I:=CharPos('.', S, 1);
1869     if I = 0 then begin
1870       Result:=IsCorrectIdentifier(S, AcceptIndexes);
1871       Exit;
1872     end;
1873     if not IsCorrectIdentifier(Copy(S, 1, I - 1), AcceptIndexes) then
1874       Break;
1875     Delete(S, 1, I);
1876   until False;
1877   Result:=False;
1878 end;
1879 
RemoveCharnull1880 function RemoveChar(const S: String; C: Char): String;
1881 var
1882   L: Integer;
1883   P1, P2, Limit: PChar;
1884 begin
1885   L:=Length(S);
1886   P1:={$IFDEF V_LONGSTRINGS}Pointer(S){$ELSE}@S[1]{$ENDIF};
1887   SetLength(Result, L);
1888   P2:={$IFDEF V_LONGSTRINGS}Pointer(Result){$ELSE}@Result[1]{$ENDIF};
1889   Limit:=P1 + L;
1890   while P1 < Limit do begin
1891     if P1^ <> C then begin
1892       P2^:=P1^;
1893       Inc(P2);
1894     end;
1895     Inc(P1);
1896   end; {while}
1897   SetLength(Result,
1898     {$IFNDEF V_FREEPASCAL}
1899     P2 - {$IFDEF V_LONGSTRINGS}Pointer(Result){$ELSE}@Result[1]{$ENDIF}
1900     {$ELSE}
1901     Cardinal(P2) - Cardinal(Pointer(Result))
1902     {$ENDIF}
1903     );
1904 end;
1905 
1906 {$IFDEF V_WIDESTRINGS}
RemoveCharWidenull1907 function RemoveCharWide(const S: WideString; C: WideChar): WideString;
1908 var
1909   L: Integer;
1910   P1, P2, Limit: PWideChar;
1911 begin
1912   L:=Length(S);
1913   P1:=Pointer(S);
1914   SetLength(Result, L);
1915   P2:=Pointer(Result);
1916   Limit:=P1 + L;
1917   while P1 < Limit do begin
1918     if P1^ <> C then begin
1919       P2^:=P1^;
1920       Inc(P2);
1921     end;
1922     Inc(P1);
1923   end; {while}
1924   SetLength(Result, P2 - Pointer(Result));
1925 end;
1926 {$ENDIF}
1927 
RemoveCharsnull1928 function RemoveChars(const S: String; const CharsToRemove: TCharSet): String;
1929 var
1930   L: Integer;
1931   P1, P2, Limit: PChar;
1932 begin
1933   L:=Length(S);
1934   P1:={$IFDEF V_LONGSTRINGS}Pointer(S){$ELSE}@S[1]{$ENDIF};
1935   SetLength(Result, L);
1936   P2:={$IFDEF V_LONGSTRINGS}Pointer(Result){$ELSE}@Result[1]{$ENDIF};
1937   Limit:=P1 + L;
1938   while P1 < Limit do begin
1939     if not (P1^ in CharsToRemove) then begin
1940       P2^:=P1^;
1941       Inc(P2);
1942     end;
1943     Inc(P1);
1944   end; {while}
1945   SetLength(Result,
1946     {$IFNDEF V_FREEPASCAL}
1947     P2 - {$IFDEF V_LONGSTRINGS}Pointer(Result){$ELSE}@Result[1]{$ENDIF}
1948     {$ELSE}
1949     Cardinal(P2) - Cardinal(Pointer(Result))
1950     {$ENDIF}
1951     );
1952 end;
1953 
1954 {$IFDEF V_WIDESTRINGS}
RemoveCharsWidenull1955 function RemoveCharsWide(const S: WideString; const CharsToRemove: TCharSet): WideString;
1956 var
1957   L: Integer;
1958   P1, P2, Limit: PWideChar;
1959 begin
1960   L:=Length(S);
1961   P1:=Pointer(S);
1962   SetLength(Result, L);
1963   P2:=Pointer(Result);
1964   Limit:=P1 + L;
1965   while P1 < Limit do begin
1966     if (P1^ >= #256) or not (PChar(P1)^ in CharsToRemove) then begin
1967       P2^:=P1^;
1968       Inc(P2);
1969     end;
1970     Inc(P1);
1971   end; {while}
1972   SetLength(Result, P2 - Pointer(Result));
1973 end;
1974 {$ENDIF}
1975 
RemoveCommentnull1976 function RemoveComment(const S: String; CommentPrefix: Char): String;
1977 var
1978   I: Integer;
1979   C: Char;
1980 begin
1981   if CharPos(CommentPrefix, S, 1) = 0 then
1982     Result:=Trim(S)
1983   else begin
1984     C:=#0;
1985     for I:=1 to Length(S) do
1986       if S[I] = CommentPrefix then
1987         if C = #0 then begin
1988           Result:=Trim(Copy(S, 1, I - 1));
1989           Exit;
1990         end
1991         else
1992       else
1993         if S[I] in ['''', '"'] then
1994           if C = #0 then
1995             C:=S[I]
1996           else
1997             if C = S[I] then
1998               C:=#0;
1999     Result:=Trim(S);
2000   end;
2001 end;
2002 
FStringToLiteralnull2003 function FStringToLiteral(const S: String; Quote: Char): String;
2004 var
2005   I, J, K, N: Integer;
2006   C: Char;
2007 begin
2008   I:=CharPos(Quote, S, 1);
2009   if I = 0 then
2010     Result:=Quote + S + Quote
2011   else begin
2012     Result:=Quote + Copy(S, 1, I) + Quote;
2013     N:=Length(S);
2014     SetLength(Result, N + 2 + NumOfChars(Quote, S));
2015     K:=I + 3;
2016     for J:=I + 1 to N do begin
2017       C:=S[J];
2018       if C = Quote then begin
2019         Result[K]:=C;
2020         Inc(K);
2021       end;
2022       Result[K]:=C;
2023       Inc(K);
2024     end;
2025     Result[K]:=Quote;
2026   end;
2027 end;
2028 
StringToLiteralnull2029 function StringToLiteral(const S: String): String;
2030 begin
2031   Result:=FStringToLiteral(S, '''');
2032 end;
2033 
StringToLiteral2null2034 function StringToLiteral2(const S: String): String;
2035 begin
2036   Result:=FStringToLiteral(S, '"');
2037 end;
2038 
2039 {$IFDEF V_WIDESTRINGS}
FWideStringToLiteralnull2040 function FWideStringToLiteral(const S: WideString; Quote: WideChar): WideString;
2041 var
2042   I, J, K, N: Integer;
2043   C: WideChar;
2044 begin
2045   I:=WideCharPos(Quote, S, 1);
2046   if I = 0 then begin
2047     {$IFDEF V_D4}
2048     Result:=Quote + S + Quote
2049     {$ELSE}
2050     N:=Length(S);
2051     SetLength(Result, N + 2);
2052     Result[1]:=Quote;
2053     for I:=2 to N + 1 do
2054       Result[I]:=S[I - 1];
2055     Result[N + 2]:=Quote;
2056     {$ENDIF}
2057   end
2058   else begin
2059     N:=Length(S);
2060     {$IFDEF V_D4}
2061     Result:=Quote + Copy(S, 1, I) + Quote;
2062     {$ELSE}
2063     SetLength(Result, I + 2);
2064     Result[1]:=Quote;
2065     for J:=2 to I + 1 do
2066       Result[J]:=S[J - 1];
2067     Result[I + 2]:=Quote;
2068     {$ENDIF}
2069     SetLength(Result, N + 2 + NumOfWideChars(Quote, S));
2070     K:=I + 3;
2071     for J:=I + 1 to N do begin
2072       C:=S[J];
2073       if C = Quote then begin
2074         Result[K]:=C;
2075         Inc(K);
2076       end;
2077       Result[K]:=C;
2078       Inc(K);
2079     end;
2080     Result[K]:=Quote;
2081   end;
2082 end;
2083 
WideStringToLiteralnull2084 function WideStringToLiteral(const S: WideString): WideString;
2085 begin
2086   Result:=FWideStringToLiteral(S, '''');
2087 end;
2088 
WideStringToLiteral2null2089 function WideStringToLiteral2(const S: WideString): WideString;
2090 begin
2091   Result:=FWideStringToLiteral(S, '"');
2092 end;
2093 {$ENDIF}
2094 
CheckTextnull2095 function CheckText(const S: String): Boolean;
2096 var
2097   I: Integer;
2098 begin
2099   Result:=False;
2100   if S <> '' then begin
2101     for I:=1 to Length(S) do
2102       if S[I] in [#0..' ', '"', '''', #127..#255] then
2103         Exit;
2104     Result:=True;
2105   end;
2106 end;
2107 
2108 {$IFDEF V_WIDESTRINGS}
CheckWideTextnull2109 function CheckWideText(const W: WideString): Boolean;
2110 var
2111   I: Integer;
2112   C: WideChar;
2113 begin
2114   Result:=False;
2115   if W <> '' then begin
2116     for I:=1 to Length(W) do begin
2117       C:=W[I];
2118       if (C <= ' ') or (C = '"') or (C = '''') then
2119         Exit;
2120     end;
2121     Result:=True;
2122   end;
2123 end;
2124 {$ENDIF}
2125 
TextToLiteralnull2126 function TextToLiteral(const S: String): String;
2127 begin
2128   if not CheckText(S) then
2129     Result:=StringToLiteral(S)
2130   else
2131     Result:=S;
2132 end;
2133 
2134 {$IFDEF V_WIDESTRINGS}
WideTextToLiteralnull2135 function WideTextToLiteral(const S: WideString): WideString;
2136 begin
2137   if not CheckWideText(S) then
2138     Result:=WideStringToLiteral(S)
2139   else
2140     Result:=S;
2141 end;
2142 {$ENDIF}
2143 
TextToLiteral2null2144 function TextToLiteral2(const S: String): String;
2145 begin
2146   if not CheckText(S) then
2147     Result:=StringToLiteral2(S)
2148   else
2149     Result:=S;
2150 end;
2151 
2152 {$IFDEF V_WIDESTRINGS}
WideTextToLiteral2null2153 function WideTextToLiteral2(const S: WideString): WideString;
2154 begin
2155   if not CheckWideText(S) then
2156     Result:=WideStringToLiteral2(S)
2157   else
2158     Result:=S;
2159 end;
2160 {$ENDIF}
2161 
2162 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
LiteralToStringnull2163 function LiteralToString(const S: String): String;
2164 var
2165   I, J, N: Integer;
2166   Quote, C: Char;
2167 begin
2168   N:=Length(S);
2169   if N >= 2 then begin
2170     if (S[1] = '''') and (S[N] = '''') then
2171       Quote:=''''
2172     else if (S[1] = '"') and (S[N] = '"') then
2173       Quote:='"'
2174     else begin
2175       Result:=S;
2176       Exit;
2177     end;
2178     Dec(N);
2179     SetLength(Result, N - 1);
2180     I:=2;
2181     J:=0;
2182     while I <= N do begin
2183       C:=S[I];
2184       Inc(J);
2185       Result[J]:=C;
2186       Inc(I);
2187       if (C = Quote) and ((I > N) or (S[I] = Quote)) then
2188         Inc(I);
2189     end;
2190     SetLength(Result, J);
2191   end
2192   else
2193     Result:=S;
2194 end;
2195 
2196 {$IFDEF V_WIDESTRINGS}
LiteralToWideStringnull2197 function LiteralToWideString(const S: WideString): WideString;
2198 var
2199   I, J, N: Integer;
2200   Quote, C: WideChar;
2201 begin
2202   N:=Length(S);
2203   if N >= 2 then begin
2204     if (S[1] = '''') and (S[N] = '''') then
2205       Quote:=''''
2206     else if (S[1] = '"') and (S[N] = '"') then
2207       Quote:='"'
2208     else begin
2209       Result:=S;
2210       Exit;
2211     end;
2212     Dec(N);
2213     SetLength(Result, N - 1);
2214     I:=2;
2215     J:=0;
2216     while I <= N do begin
2217       C:=S[I];
2218       Inc(J);
2219       Result[J]:=C;
2220       Inc(I);
2221       if (C = Quote) and ((I > N) or (S[I] = Quote)) then
2222         Inc(I);
2223     end;
2224     SetLength(Result, J);
2225   end
2226   else
2227     Result:=S;
2228 end;
2229 {$ENDIF}
2230 {$IFDEF NOWARN}{$WARNINGS ON}{$ENDIF}
2231 
GetValueByNamenull2232 function GetValueByName(const S, Name: String; var Value: String;
2233   CaseSensitive: Boolean; const QuoteChars: TCharSet): Boolean;
2234 var
2235   QuoteChar: Char;
2236   Valid: Boolean;
2237   ParamName: String;
2238   ReadState: (rsWaitName, rsName, rsWaitEqualSign, rsWaitValue, rsValue);
2239 
2240   procedure StateReadName(C: Char);
2241   begin
2242     ReadState:=rsName;
2243     if C in QuoteChars then begin
2244       ReadState:=rsValue;
2245       QuoteChar:=C;
2246       Valid:=False;
2247     end
2248     else
2249       ParamName:=C;
2250   end;
2251 
AnalyzeNamenull2252   function AnalyzeName: Boolean;
2253   begin
2254     if Valid then
2255       if CaseSensitive then
2256         Result:=CompareStr(ParamName, Name) = 0
2257       else
2258         Result:=CompareText(ParamName, Name) = 0
2259     else
2260       Result:=False;
2261     Valid:=True;
2262   end;
2263 
2264 var
2265   C: Char;
2266   P, Limit: PChar;
2267 begin
2268   Result:=True;
2269   Valid:=True;
2270   {$IFDEF V_LONGSTRINGS}
2271   P:=PChar(S);
2272   {$ELSE}
2273   P:=@S[1];
2274   {$ENDIF}
2275   Limit:=P + Length(S);
2276   {$IFNDEF V_AUTOINITSTRINGS}
2277   ParamName:='';
2278   {$ENDIF}
2279   ReadState:=rsWaitName;
2280   while P < Limit do begin
2281     C:=P^;
2282     Case ReadState of
2283       rsWaitName:
2284         if C > ' ' then
2285           StateReadName(C);
2286       rsName:
2287         if C > ' ' then
2288           if C = '=' then
2289             ReadState:=rsWaitValue
2290           else
2291             if Valid then
2292               ParamName:=ParamName + C
2293             else
2294         else
2295           ReadState:=rsWaitEqualSign;
2296       rsWaitEqualSign:
2297         if C > ' ' then
2298           if C = '=' then
2299             ReadState:=rsWaitValue
2300           else begin
2301             if AnalyzeName then
2302               Exit;
2303             StateReadName(C);
2304           end;
2305       rsWaitValue:
2306         if C > ' ' then begin
2307           if C in QuoteChars then begin
2308             QuoteChar:=C;
2309             Value:='';
2310           end
2311           else begin
2312             QuoteChar:=#0;
2313             Value:=C;
2314           end;
2315           ReadState:=rsValue;
2316         end;
2317       rsValue: begin
2318         if QuoteChar <> #0 then
2319           if C = QuoteChar then begin
2320             ReadState:=rsWaitName;
2321             QuoteChar:=#0;
2322           end
2323           else
2324         else
2325           if C <= ' ' then
2326             ReadState:=rsWaitName;
2327         if ReadState = rsWaitName then
2328           if AnalyzeName then
2329             Exit
2330           else
2331         else
2332           if Valid then
2333             Value:=Value + C;
2334       end;
2335     End;
2336     Inc(P);
2337   end; {while}
2338   if (ReadState = rsValue) and AnalyzeName then
2339     Exit;
2340   Result:=False;
2341 end;
2342 
2343 {$IFDEF V_WIDESTRINGS}{$IFDEF V_D4}{$IFNDEF V_D6}
2344 procedure ConvertErrorFmt(ResString: PResStringRec; const Args: array of const);
2345 begin
2346   raise EConvertError.CreateFmt(LoadResString(ResString), Args);
2347 end;
2348 
2349 procedure FormatError(ErrorCode: Integer; Format: PChar; FmtLen: Cardinal);
2350 var
2351   ResStr: PResStringRec;
2352   Buffer: array[0..31] of Char;
2353 begin
2354   if FmtLen > 31 then
2355     FmtLen:=31;
2356   if StrByteType(Format, FmtLen-1) = mbLeadByte then
2357     Dec(FmtLen);
2358   StrMove(Buffer, Format, FmtLen);
2359   Buffer[FmtLen]:=#0;
2360   if ErrorCode = 0 then
2361     ResStr:=@SInvalidFormat
2362   else
2363     ResStr:=@SArgumentMissing;
2364   ConvertErrorFmt(ResStr, [PChar(@Buffer)]);
2365 end;
2366 
2367 procedure WideFormatError(ErrorCode: Integer; Format: PWideChar; FmtLen: Cardinal);
2368 var
2369   WideFormat: WideString;
2370   FormatText: string;
2371 begin
2372   SetLength(WideFormat, FmtLen);
2373   SetString(WideFormat, Format, FmtLen);
2374   FormatText := WideFormat;
2375   FormatError(ErrorCode, PChar(FormatText), FmtLen);
2376 end;
2377 
2378 {$IFDEF PACKAGE}
FWideFormatBufnull2379 function FWideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
2380   FmtLen: Cardinal; CurrencyDecimals: Byte; const Args: array of const): Cardinal;
2381 {$ELSE}
WideFormatBufnull2382 function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
2383   FmtLen: Cardinal; const Args: array of const): Cardinal;
2384 {$ENDIF}
2385 var
2386   ArgIndex, Width, Prec: Integer;
2387   BufferOrg, FormatOrg, FormatPtr: PWideChar;
2388   JustFlag: WideChar;
2389   StrBuf: array[0..64] of WideChar;
2390   TempWideStr: WideString;
2391   TempInt64 : Int64;
2392   SaveGOT: Integer;
2393 { in: eax <-> Buffer }
2394 { in: edx <-> BufLen }
2395 { in: ecx <-> Format }
2396 
2397 asm
2398         PUSH    EBX
2399         PUSH    ESI
2400         PUSH    EDI
2401         MOV     EDI,EAX
2402         MOV     ESI,ECX
2403 {$IFDEF PIC}
2404         CALL    GetGOT
2405 {$ELSE}
2406         XOR     EAX,EAX
2407 {$ENDIF}
2408         MOV     SaveGOT,EAX
2409         MOV     ECX,FmtLen
2410         LEA     ECX,[ECX*2+ESI]
2411         MOV     BufferOrg,EDI
2412         XOR     EAX,EAX
2413         MOV     ArgIndex,EAX
2414         MOV     TempWideStr,EAX
2415 
2416 @Loop:
2417         OR      EDX,EDX
2418         JE      @Done
2419 
2420 @NextChar:
2421         CMP     ESI,ECX
2422         JE      @Done
2423         LODSW
2424         CMP     AX,'%'
2425         JE      @Format
2426 
2427 @StoreChar:
2428         STOSW
2429         DEC     EDX
2430         JNE     @NextChar
2431 
2432 @Done:
2433         MOV     EAX,EDI
2434         SUB     EAX,BufferOrg
2435         SHR     EAX,1
2436         JMP     @Exit
2437 
2438 @Format:
2439         CMP     ESI,ECX
2440         JE      @Done
2441         LODSW
2442         CMP     AX,'%'
2443         JE      @StoreChar
2444         LEA     EBX,[ESI-4]
2445         MOV     FormatOrg,EBX
2446 @A0:    MOV     JustFlag,AX
2447         CMP     AX,'-'
2448         JNE     @A1
2449         CMP     ESI,ECX
2450         JE      @Done
2451         LODSW
2452 @A1:    CALL    @Specifier
2453         CMP     AX,':'
2454         JNE     @A2
2455         MOV     ArgIndex,EBX
2456         CMP     ESI,ECX
2457         JE      @Done
2458         LODSW
2459         JMP     @A0
2460 
2461 @A2:    MOV     Width,EBX
2462         MOV     EBX,-1
2463         CMP     AX,'.'
2464         JNE     @A3
2465         CMP     ESI,ECX
2466         JE      @Done
2467         LODSW
2468         CALL    @Specifier
2469 @A3:    MOV     Prec,EBX
2470         MOV     FormatPtr,ESI
2471         PUSH    ECX
2472         PUSH    EDX
2473 
2474         CALL    @Convert
2475 
2476         POP     EDX
2477         MOV     EBX,Width
2478         SUB     EBX,ECX        //(* ECX <=> number of characters output *)
2479         JAE     @A4            //(*         jump -> output smaller than width *)
2480         XOR     EBX,EBX
2481 
2482 @A4:    CMP     JustFlag,'-'
2483         JNE     @A6
2484         SUB     EDX,ECX
2485         JAE     @A5
2486         ADD     ECX,EDX
2487         XOR     EDX,EDX
2488 
2489 @A5:    REP     MOVSW
2490 
2491 @A6:    XCHG    EBX,ECX
2492         SUB     EDX,ECX
2493         JAE     @A7
2494         ADD     ECX,EDX
2495         XOR     EDX,EDX
2496 @A7:    MOV     AX,' '
2497         REP     STOSW
2498         XCHG    EBX,ECX
2499         SUB     EDX,ECX
2500         JAE     @A8
2501         ADD     ECX,EDX
2502         XOR     EDX,EDX
2503 @A8:    REP     MOVSW
2504         POP     ECX
2505         MOV     ESI,FormatPtr
2506         JMP     @Loop
2507 
2508 @Specifier:
2509         XOR     EBX,EBX
2510         CMP     AX,'*'
2511         JE      @B3
2512 @B1:    CMP     AX,'0'
2513         JB      @B5
2514         CMP     AX,'9'
2515         JA      @B5
2516         IMUL    EBX,EBX,10
2517         SUB     AX,'0'
2518         MOVZX   EAX,AX
2519         ADD     EBX,EAX
2520         CMP     ESI,ECX
2521         JE      @B2
2522         LODSW
2523         JMP     @B1
2524 @B2:    POP     EAX
2525         JMP     @Done
2526 @B3:    MOV     EAX,ArgIndex
2527         CMP     EAX,Args.Integer[-4]
2528         JA      @B4
2529         INC     ArgIndex
2530         MOV     EBX,Args
2531         CMP     [EBX+EAX*8].Byte[4],vtInteger
2532         MOV     EBX,[EBX+EAX*8]
2533         JE      @B4
2534         XOR     EBX,EBX
2535 @B4:    CMP     ESI,ECX
2536         JE      @B2
2537         LODSW
2538 @B5:    RET
2539 
2540 @Convert:
2541         AND     AL,0DFH
2542         MOV     CL,AL
2543         MOV     EAX,1
2544         MOV     EBX,ArgIndex
2545         CMP     EBX,Args.Integer[-4]
2546         JA      @ErrorExit
2547         INC     ArgIndex
2548         MOV     ESI,Args
2549         LEA     ESI,[ESI+EBX*8]
2550         MOV     EAX,[ESI].Integer[0]       // TVarRec.data
2551         MOVZX   EDX,[ESI].Byte[4]          // TVarRec.VType
2552 {$IFDEF PIC}
2553         MOV     EBX, SaveGOT
2554         ADD     EBX, offset @CvtVector
2555         MOV     EBX, [EBX+EDX*4]
2556         ADD     EBX, SaveGOT
2557         JMP     EBX
2558 {$ELSE}
2559         JMP     @CvtVector.Pointer[EDX*4]
2560 {$ENDIF}
2561 
2562 @CvtVector:
2563         DD      @CvtInteger                // vtInteger
2564         DD      @CvtBoolean                // vtBoolean
2565         DD      @CvtChar                   // vtChar
2566         DD      @CvtExtended               // vtExtended
2567         DD      @CvtShortStr               // vtString
2568         DD      @CvtPointer                // vtPointer
2569         DD      @CvtPChar                  // vtPChar
2570         DD      @CvtObject                 // vtObject
2571         DD      @CvtClass                  // vtClass
2572         DD      @CvtWideChar               // vtWideChar
2573         DD      @CvtPWideChar              // vtPWideChar
2574         DD      @CvtAnsiStr                // vtAnsiString
2575         DD      @CvtCurrency               // vtCurrency
2576         DD      @CvtVariant                // vtVariant
2577         DD      @CvtInterface              // vtInterface
2578         DD      @CvtWideString             // vtWideString
2579         DD      @CvtInt64                  // vtInt64
2580 
2581 @CvtBoolean:
2582 @CvtObject:
2583 @CvtClass:
2584 @CvtInterface:
2585 @CvtError:
2586         XOR     EAX,EAX
2587 
2588 @ErrorExit:
2589         CALL    @ClearTmpWideStr
2590         MOV     EDX,FormatOrg
2591         MOV     ECX,FormatPtr
2592         SUB     ECX,EDX
2593         SHR     ECX,1
2594         MOV     EBX, SaveGOT
2595 {$IFDEF PC_MAPPED_EXCEPTIONS}
2596         //  Because of all the assembly code here, we can't call a routine
2597         //  that throws an exception if it looks like we're still on the
2598         //  stack.  The static disassembler cannot give sufficient unwind
2599         //  frame info to unwind the confusion that is generated from the
2600         //  assembly code above.  So before we throw the exception, we
2601         //  go to some lengths to excise ourselves from the stack chain.
2602         //  We were passed 12 bytes of parameters on the stack, and we have
2603         //  to make sure that we get rid of those, too.
2604         MOV     ESP, EBP        // Ditch everthing to the frame
2605         MOV     EBP, [ESP + 4]  // Get the return addr
2606         MOV     [ESP + 16], EBP // Move the ret addr up in the stack
2607         POP     EBP             // Ditch the rest of the frame
2608         ADD     ESP, 12         // Ditch the space that was taken by params
2609         JMP     WideFormatError // Off to FormatErr
2610 {$ELSE}
2611         CALL    WideFormatError
2612 {$ENDIF}
2613         // The above call raises an exception and does not return
2614 
2615 @CvtInt64:
2616         // CL  <= format character
2617         // EAX <= address of int64
2618         // EBX <= TVarRec.VType
2619 
2620         LEA     EBX, TempInt64       // (input is array of const; save original)
2621         MOV     EDX, [EAX]
2622         MOV     [EBX], EDX
2623         MOV     EDX, [EAX + 4]
2624         MOV     [EBX + 4], EDX
2625 
2626         // EBX <= address of TempInt64
2627 
2628         CMP     CL,'D'
2629         JE      @DecI64
2630         CMP     CL,'U'
2631         JE      @DecI64_2
2632         CMP     CL,'X'
2633         JNE     @CvtError
2634 
2635 @HexI64:
2636         MOV     ECX,16               // hex divisor
2637         JMP     @CvtI64
2638 
2639 @DecI64:
2640         TEST    DWORD PTR [EBX + 4], $80000000      // sign bit set?
2641         JE      @DecI64_2            //   no -> bypass '-' output
2642 
2643         NEG     DWORD PTR [EBX]      // negate lo-order, then hi-order
2644         ADC     DWORD PTR [EBX+4], 0
2645         NEG     DWORD PTR [EBX+4]
2646 
2647         CALL    @DecI64_2
2648 
2649         MOV     AX,'-'
2650         INC     ECX
2651         INC     ECX
2652         DEC     ESI
2653         DEC     ESI
2654         MOV     [ESI],AX
2655         RET
2656 
2657 @DecI64_2:                           // unsigned int64 output
2658         MOV     ECX,10               // decimal divisor
2659 
2660 @CvtI64:
2661         LEA     ESI,StrBuf[64]
2662 
2663 @CvtI64_1:
2664         PUSH    EBX
2665         PUSH    ECX                  // save radix
2666         PUSH    0
2667         PUSH    ECX                  // radix divisor (10 or 16 only)
2668         MOV     EAX, [EBX]
2669         MOV     EDX, [EBX + 4]
2670         MOV     EBX, SaveGOT
2671         CALL    System.@_llumod
2672         POP     ECX                  // saved radix
2673         POP     EBX
2674 
2675         XCHG    EAX, EDX             // lo-value to EDX for character output
2676         ADD     DX,'0'
2677         CMP     DX,'0'+10
2678         JB      @CvtI64_2
2679 
2680         ADD     DX,('A'-'0')-10
2681 
2682 @CvtI64_2:
2683         DEC     ESI
2684         DEC     ESI
2685         MOV     [ESI],DX
2686 
2687         PUSH    EBX
2688         PUSH    ECX                  // save radix
2689         PUSH    0
2690         PUSH    ECX                  // radix divisor (10 or 16 only)
2691         MOV     EAX, [EBX]           // value := value DIV radix
2692         MOV     EDX, [EBX + 4]
2693         MOV     EBX, SaveGOT
2694         CALL    System.@_lludiv
2695         POP     ECX                  // saved radix
2696         POP     EBX
2697         MOV     [EBX], EAX
2698         MOV     [EBX + 4], EDX
2699         OR      EAX,EDX              // anything left to output?
2700         JNE     @CvtI64_1            //   no jump => EDX:EAX = 0
2701 
2702         LEA     ECX,StrBuf[64]
2703         SUB     ECX,ESI
2704         SHR     ECX,1
2705         MOV     EDX,Prec
2706         CMP     EDX,16
2707         JBE     @CvtI64_3
2708         RET
2709 
2710 @CvtI64_3:
2711         SUB     EDX,ECX
2712         JBE     @CvtI64_5
2713         ADD     ECX,EDX
2714         MOV     AX,'0'
2715 
2716 @CvtI64_4:
2717         DEC     ESI
2718         DEC     ESI
2719         MOV     [ESI],AX
2720         DEC     EDX
2721         JNE     @CvtI64_4
2722 
2723 @CvtI64_5:
2724         RET
2725 ////////////////////////////////////////////////
2726 
2727 @CvtInteger:
2728         CMP     CL,'D'
2729         JE      @C1
2730         CMP     CL,'U'
2731         JE      @C2
2732         CMP     CL,'X'
2733         JNE     @CvtError
2734         MOV     ECX,16
2735         JMP     @CvtLong
2736 @C1:    OR      EAX,EAX
2737         JNS     @C2
2738         NEG     EAX
2739         CALL    @C2
2740         MOV     AX,'-'
2741         INC     ECX
2742         DEC     ESI
2743         DEC     ESI
2744         MOV     [ESI],AX
2745         RET
2746 @C2:    MOV     ECX,10
2747 
2748 @CvtLong:
2749         LEA     ESI,StrBuf[32]
2750 @D1:    XOR     EDX,EDX
2751         DIV     ECX
2752         ADD     EDX,'0'
2753         CMP     EDX,'0'+10
2754         JB      @D2
2755         ADD     EDX,('A'-'0')-10
2756 @D2:    DEC     ESI
2757         DEC     ESI
2758         MOV     [ESI],DX
2759         OR      EAX,EAX
2760         JNE     @D1
2761         LEA     ECX,StrBuf[32]
2762         SUB     ECX,ESI
2763         SHR     ECX,1
2764         MOV     EDX,Prec
2765         CMP     EDX,16
2766         JBE     @D3
2767         RET
2768 @D3:    SUB     EDX,ECX
2769         JBE     @D5
2770         ADD     ECX,EDX
2771         MOV     AX,'0'
2772 @D4:    DEC     ESI
2773         DEC     ESI
2774         MOV     [ESI],AX
2775         DEC     EDX
2776         JNE     @D4
2777 @D5:    RET
2778 
2779 @CvtChar:
2780         CMP     CL,'S'
2781         JNE     @CvtError
2782         MOV     EAX,ESI
2783         MOV     ECX,1
2784         JMP     @CvtAnsiThingLen
2785 
2786 @CvtWideChar:
2787         CMP     CL,'S'
2788         JNE     @CvtError
2789         MOV     ECX,1
2790         RET
2791 
2792 @CvtVariant:
2793         CMP     CL,'S'
2794         JNE     @CvtError
2795         CMP     [EAX].TVarData.VType,varNull
2796         JBE     @CvtEmptyStr
2797         MOV     EDX,EAX
2798         LEA     EAX,TempWideStr
2799         PUSH    EBX
2800         MOV     EBX, SaveGOT
2801         CALL    System.@VarToWStr
2802         POP     EBX
2803         MOV     ESI,TempWideStr
2804         JMP     @CvtWideStrRef
2805 
2806 @CvtEmptyStr:
2807         XOR     ECX,ECX
2808         RET
2809 
2810 @CvtShortStr:
2811         CMP     CL,'S'
2812         JNE     @CvtError
2813         MOVZX   ECX,BYTE PTR [EAX]
2814         INC     EAX
2815 
2816 @CvtAnsiThingLen:
2817         MOV     ESI,OFFSET System.@WStrFromPCharLen
2818         JMP     @CvtAnsiThing
2819 
2820 @CvtPChar:
2821         MOV    ESI,OFFSET System.@WStrFromPChar
2822         JMP    @CvtAnsiThingTest
2823 
2824 @CvtAnsiStr:
2825         MOV    ESI,OFFSET System.@WStrFromLStr
2826 
2827 @CvtAnsiThingTest:
2828         CMP    CL,'S'
2829         JNE    @CvtError
2830 
2831 @CvtAnsiThing:
2832         ADD    ESI, SaveGOT
2833         MOV    EDX,EAX
2834         LEA    EAX,TempWideStr
2835         PUSH   EBX
2836         MOV    EBX, SaveGOT
2837         CALL   ESI
2838         POP    EBX
2839         MOV    ESI,TempWideStr
2840         JMP    @CvtWideStrRef
2841 
2842 @CvtWideString:
2843         CMP     CL,'S'
2844         JNE     @CvtError
2845         MOV     ESI,EAX
2846 
2847 @CvtWideStrRef:
2848         OR      ESI,ESI
2849         JE      @CvtEmptyStr
2850         MOV     ECX,[ESI-4]
2851         SHR     ECX,1
2852 
2853 @CvtWideStrLen:
2854         CMP     ECX,Prec
2855         JA      @E1
2856         RET
2857 @E1:    MOV     ECX,Prec
2858         RET
2859 
2860 @CvtPWideChar:
2861         CMP     CL,'S'
2862         JNE     @CvtError
2863         MOV     ESI,EAX
2864         PUSH    EDI
2865         MOV     EDI,EAX
2866         XOR     EAX,EAX
2867         MOV     ECX,Prec
2868         JECXZ   @F1
2869         REPNE   SCASW
2870         JNE     @F1
2871         DEC     EDI
2872         DEC     EDI
2873 @F1:    MOV     ECX,EDI
2874         SUB     ECX,ESI
2875         SHR     ECX,1
2876         POP     EDI
2877         RET
2878 
2879 @CvtPointer:
2880         CMP     CL,'P'
2881         JNE     @CvtError
2882         MOV     Prec,8
2883         MOV     ECX,16
2884         JMP     @CvtLong
2885 
2886 @CvtCurrency:
2887         MOV     BH,fvCurrency
2888         JMP     @CvtFloat
2889 
2890 @CvtExtended:
2891         MOV     BH,fvExtended
2892 
2893 @CvtFloat:
2894         MOV     ESI,EAX
2895         MOV     BL,ffGeneral
2896         CMP     CL,'G'
2897         JE      @G2
2898         MOV     BL,ffExponent
2899         CMP     CL,'E'
2900         JE      @G2
2901         MOV     BL,ffFixed
2902         CMP     CL,'F'
2903         JE      @G1
2904         MOV     BL,ffNumber
2905         CMP     CL,'N'
2906         JE      @G1
2907         CMP     CL,'M'
2908         JNE     @CvtError
2909         MOV     BL,ffCurrency
2910 @G1:    MOV     EAX,18
2911         MOV     EDX,Prec
2912         CMP     EDX,EAX
2913         JBE     @G3
2914         MOV     EDX,2
2915         CMP     CL,'M'
2916         JNE     @G3
2917         MOVZX   EDX,CurrencyDecimals
2918         JMP     @G3
2919 @G2:    MOV     EAX,Prec
2920         MOV     EDX,3
2921         CMP     EAX,18
2922         JBE     @G3
2923         MOV     EAX,15
2924 @G3:    PUSH    EBX
2925         PUSH    EAX
2926         PUSH    EDX
2927         LEA     EAX,StrBuf
2928         MOV     EDX,ESI
2929         MOVZX   ECX,BH
2930         MOV     EBX, SaveGOT
2931         CALL    FloatToText
2932         MOV     ECX,EAX
2933         LEA     EAX,StrBuf
2934         JMP     @CvtAnsiThingLen
2935 
2936 @ClearTmpWideStr:
2937         PUSH    EBX
2938         PUSH    EAX
2939         LEA     EAX,TempWideStr
2940         MOV     EBX, SaveGOT
2941         CALL    System.@WStrClr
2942         POP     EAX
2943         POP     EBX
2944         RET
2945 
2946 @Exit:
2947         CALL    @ClearTmpWideStr
2948         POP     EDI
2949         POP     ESI
2950         POP     EBX
2951 end;
2952 
2953 {$IFDEF PACKAGE}
WideFormatBufnull2954 function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
2955   FmtLen: Cardinal; const Args: array of const): Cardinal;
2956 begin
2957   Result:=FWideFormatBuf(Buffer, BufLen, Format, FmtLen, CurrencyDecimals, Args);
2958 end;
2959 {$ENDIF}
2960 
2961 procedure WideFmtStr(var Result: WideString; const Format: WideString;
2962   const Args: array of const);
2963 var
2964   Len, BufLen: Integer;
2965   Buffer: array[0..4095] of WideChar;
2966 begin
2967   BufLen := SizeOf(Buffer);
2968   if Length(Format) < (sizeof(Buffer) - (sizeof(Buffer) div 4)) then
2969     Len := WideFormatBuf(Buffer, sizeof(Buffer) - 1, Pointer(Format)^, Length(Format), Args)
2970   else
2971   begin
2972     BufLen := Length(Format);
2973     Len := BufLen;
2974   end;
2975   if Len >= BufLen - 1 then
2976   begin
2977     while Len >= BufLen - 1 do
2978     begin
2979       Inc(BufLen, BufLen);
2980       Result := '';          // prevent copying of existing data, for speed
2981       SetLength(Result, BufLen);
2982       Len := WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(Format)^,
2983         Length(Format), Args);
2984     end;
2985     SetLength(Result, Len);
2986   end
2987   else
2988     SetString(Result, Buffer, Len);
2989 end;
2990 
WideFormatnull2991 function WideFormat(const Format: WideString; const Args: array of const): WideString;
2992 begin
2993   WideFmtStr(Result, Format, Args);
2994 end;
2995 {$ENDIF}{$ENDIF}{$ENDIF}
2996 
2997 {$IFDEF V_D4}
IntToStrSeparatednull2998 function IntToStrSeparated(Value: Int64): String;
2999 var
3000   I, C: Integer;
3001   S: String;
3002 begin
3003   S:=IntToStr(Value);
3004   Result:='';
3005   C:=0;
3006   for I:=Length(S) downto 1 do begin
3007     if C = 3 then begin
3008       Result:=ThousandSeparator + Result;
3009       C:=0;
3010     end;
3011     Result:=S[I] + Result;
3012     Inc(C);
3013   end;
3014 end;
3015 {$ENDIF}
3016 
IntToRomannull3017 function IntToRoman(N: Integer): String;
3018 const
3019   T_s: array [0..5] of String = ('','M','MM','MMM','MMMM','MMMMM');
3020   S_s: array [0..9] of String = ('','C','CC','CCC','CD','D','DC','DCC','DCCC','CM');
3021   D_s: array [0..9] of String = ('','X','XX','XXX','XL','L','LX','LXX','LXXX','XC');
3022   E_s: array [0..9] of String = ('','I','II','III','IV','V','VI','VII','VIII','IX');
3023 var
3024   T, S, D: Integer;
3025 begin
3026   if (N >= 1) and (N <= 5000) then begin
3027     T:=0;
3028     while N >= 1000 do begin
3029       Dec(N, 1000);
3030       Inc(T);
3031     end;
3032     S:=0;
3033     if N >= 500 then begin
3034       Dec(N, 500);
3035       S:=5;
3036     end;
3037     while N >= 100 do begin
3038       Dec(N, 100);
3039       Inc(S);
3040     end;
3041     D:=0;
3042     if N >= 50 then begin
3043       Dec(N, 50);
3044       D:=5;
3045     end;
3046     while N >= 10 do begin
3047       Dec(N, 10);
3048       Inc(D);
3049     end;
3050     Result:=T_s[T] + S_s[S] + D_s[D] + E_s[N];
3051   end
3052   else
3053     Result:='';
3054 end;
3055 
ValOctPCharnull3056 function ValOctPChar(P: PChar; L: Integer; var Value: Integer): Boolean;
3057 var
3058   N: Integer;
3059 begin
3060   Value:=0;
3061   if L = 0 then begin
3062     Result:=False;
3063     Exit;
3064   end;
3065   while L > 0 do begin
3066     N:=Ord(P^) - Ord('0');
3067     if (N < 0) or (N > 7) then begin
3068       Result:=False;
3069       Exit;
3070     end;
3071     Value:=Value * 8 + N;
3072     Inc(P);
3073     Dec(L);
3074   end;
3075   Result:=True;
3076 end;
3077 
ValOctStrnull3078 function ValOctStr(const S: String; var Value: Integer): Boolean;
3079 begin
3080   Result:=ValOctPChar({$IFDEF V_LONGSTRINGS}Pointer(S){$ELSE}@S[1]{$ENDIF},
3081     Length(S), Value);
3082 end;
3083 
OctToIntnull3084 function OctToInt(P: PChar; MaxLen: Integer; var Value: Integer): Boolean;
3085 var
3086   I, J: Integer;
3087 begin
3088   while (MaxLen > 0) and (P^ = ' ') do begin
3089     Dec(MaxLen);
3090     Inc(P);
3091   end; {while}
3092   if MaxLen <= 0 then begin
3093     Result:=False;
3094     Exit;
3095   end;
3096   I:=IndexOfValue8(P^, 0, MaxLen);
3097   if I < 0 then
3098     I:=MaxLen;
3099   J:=IndexOfValue8(P^, Ord(' '), MaxLen);
3100   if J < 0 then
3101     J:=MaxLen;
3102   if I > J then
3103     I:=J;
3104   Result:=ValOctPChar(P, I, Value);
3105 end;
3106 
CmpStrFnull3107 function CmpStrF(const S1, S2: String; Flags: LongInt): Integer;
3108 begin
3109 {$IFDEF V_WIN}
3110 {$IFDEF V_LONGSTRINGS}
3111   if Flags = 0 then
3112     Result:=CompareStr(S1, S2)
3113   else
3114     Result:=CompareString(Flags and LocaleMask, Flags and FlagsMask, Pointer(S1),
3115       Length(S1), Pointer(S2), Length(S2)) - 2;
3116 {$ELSE}
3117    if Flags and LocaleMask <> 0 then
3118      if Flags and iCaseInsensitive <> 0 then
3119        Result:=AnsiCompareText(S1, S2)
3120      else
3121        Result:=AnsiCompareStr(S1, S2)
3122    else
3123      if Flags and iCaseInsensitive <> 0 then
3124        Result:=CompareText(S1, S2)
3125      else
3126        Result:=CompareStr(S1, S2)
3127 {$ENDIF}
3128 {$ELSE}
3129    if Flags and LocaleMask <> 0 then
3130      if Flags and iCaseInsensitive <> 0 then
3131        Result:=AnsiCompareText(S1, S2)
3132      else
3133        Result:=AnsiCompareStr(S1, S2)
3134    else
3135      if Flags and iCaseInsensitive <> 0 then
3136        Result:=CompareText(S1, S2)
3137      else
3138        Result:=CompareStr(S1, S2)
3139 {$ENDIF}
3140 end;
3141 
3142 {$IFDEF V_WIDESTRINGS}
3143 {$IFNDEF USE_ASM}
WStrCmpnull3144 function WStrCmp(PLeft, PRight: PWideChar): Integer;
3145 begin
3146   Result:=CompareWide(WideString(PLeft), WideString(PRight));
3147 end;
3148 
CompareWidenull3149 function CompareWide(const Left, Right: WideString): Integer;
3150 begin
3151   if Left < Right then
3152     Result:=-1
3153   else if Left > Right then
3154     Result:=1
3155   else Result:=0;
3156 end;
3157 {$ELSE}
WStrCmpnull3158 function WStrCmp(PLeft, PRight: PWideChar): Integer;
3159 asm     // eax = PLeft; edx = PRight
3160         {$IFDEF V_FREEPASCAL}
3161         mov      edx, PRight
3162         {$ENDIF}
3163         push     esi
3164         xor      ecx, ecx
3165         mov      esi, PLeft
3166         xor      eax, eax
3167         cmp      esi, edx
3168         je       @@Exit
3169         or       esi, esi
3170         jz       @@str1null
3171         or       edx, edx
3172         jz       @@str2null
3173 @@Loop: // unrolled to improve efficiency
3174         lodsw
3175         mov      cx, [edx]
3176         sub      eax, ecx
3177         jnz      @@Exit
3178         add      edx, 2
3179         or       ecx, ecx
3180         jz       @@Exit
3181         lodsw
3182         mov      cx, [edx]
3183         sub      eax, ecx
3184         jnz      @@Exit
3185         add      edx, 2
3186         or       ecx, ecx
3187         jz       @@Exit
3188         lodsw
3189         mov      cx, [edx]
3190         sub      eax, ecx
3191         jnz      @@Exit
3192         add      edx, 2
3193         or       ecx, ecx
3194         jz       @@Exit
3195         lodsw
3196         mov      cx, [edx]
3197         sub      eax, ecx
3198         jnz      @@Exit
3199         add      edx, 2
3200         or       ecx, ecx
3201         jnz      @@Loop
3202 @@Exit:
3203         pop      esi
3204         ret
3205 @@str1null:
3206         cmp      word ptr [edx], 0
3207         je       @@Exit
3208         dec      eax
3209         jmp      @@Exit
3210 @@str2null:
3211         cmp      word ptr [esi], 0
3212         je       @@Exit
3213         inc      eax
3214         jmp      @@Exit
3215 end{$IFDEF V_FREEPASCAL} ['eax','ecx','edx']{$ENDIF};
3216 
CompareWidenull3217 function CompareWide(const Left, Right: WideString): Integer;
3218 begin
3219   Result:=WStrCmp(PWideChar(Left), PWideChar(Right));
3220 end;
3221 {$ENDIF} {USE_ASM}
3222 
CompareStrBufWidenull3223 function CompareStrBufWide(PW1, PW2: PWideChar; Count1, Count2: Integer): Integer;
3224 var
3225   I, L, Delta: Integer;
3226 begin
3227   L:=Count1;
3228   Delta:=Count1 - Count2;
3229   if Delta > 0 then L:=Count2;
3230   for I:=0 to L - 1 do begin
3231     Result:=Integer(PW1^) - Integer(PW2^);
3232     if Result <> 0 then Exit;
3233     Inc(PW1);
3234     Inc(PW2);
3235   end;
3236   Result:=Delta;
3237 end;
3238 
CompareStrWidenull3239 function CompareStrWide(const W1, W2: WideString): Integer;
3240 begin
3241   Result:=CompareStrBufWide(PWideChar(W1), PWideChar(W2), Length(W1), Length(W2));
3242 end;
3243 {$ENDIF} {V_WIDESTRINGS}
3244 
CompareStrBufnull3245 function CompareStrBuf(P1, P2: PChar; Count1, Count2: Integer): Integer;
3246 var
3247   I, L, Delta: Integer;
3248 begin
3249   L:=Count1;
3250   Delta:=Count1 - Count2;
3251   if Delta > 0 then
3252     L:=Count2;
3253   for I:=0 to L - 1 do begin
3254     Result:=Ord(P1^) - Ord(P2^);
3255     if Result <> 0 then
3256       Exit;
3257     Inc(P1);
3258     Inc(P2);
3259   end;
3260   Result:=Delta;
3261 end;
3262 
CompareTextBufnull3263 function CompareTextBuf(P1, P2: PChar; Count1, Count2: Integer): Integer;
3264 var
3265   I, L, C1, C2, Delta: Integer;
3266 begin
3267   L:=Count1;
3268   Delta:=Count1 - Count2;
3269   if Delta > 0 then
3270     L:=Count2;
3271   for I:=0 to L - 1 do begin
3272     C1:=Ord(P1^);
3273     C2:=Ord(P2^);
3274     if (C1 >= Ord('A')) and (C1 <= Ord('Z')) then
3275       Inc(C1, Ord('a') - Ord('A'));
3276     if (C2 >= Ord('A')) and (C2 <= Ord('Z')) then
3277       Inc(C2, Ord('a') - Ord('A'));
3278     Result:=C1 - C2;
3279     if Result <> 0 then
3280       Exit;
3281     Inc(P1);
3282     Inc(P2);
3283   end;
3284   Result:=Delta;
3285 end;
3286 
MemEqualStrnull3287 function MemEqualStr(const X; const S: String): Boolean;
3288 begin
3289   Result:=MemEqual(X, {$IFDEF V_LONGSTRINGS}Pointer(S)^{$ELSE}S[1]{$ENDIF}, Length(S));
3290 end;
3291 
CompareVersionsnull3292 function CompareVersions(Ver1, Ver2: String; pError: PBoolean): Integer;
3293 
GetPartnull3294   function GetPart(var Ver: String; var N: Integer): Boolean;
3295   var
3296     I, Code: Integer;
3297     S: String;
3298   begin
3299     N:=0;
3300     I:=CharPos('.', Ver, 1);
3301     if I > 0 then begin
3302       S:=Copy(Ver, 1, I - 1);
3303       Delete(Ver, 1, I);
3304     end
3305     else begin
3306       S:=Ver;
3307       Ver:='';
3308     end;
3309     if S <> '' then begin
3310       Val(S, N, Code);
3311       if (Code <> 0) or (N < 0) then begin
3312         Result:=False;
3313         Exit;
3314       end;
3315     end;
3316     Result:=True;
3317   end;
3318 
3319 var
3320   N1, N2: Integer;
3321   Error: Boolean;
3322 begin
3323   Result:=0;
3324   Error:=False;
3325   repeat
3326     if not (GetPart(Ver1, N1) and GetPart(Ver2, N2)) then begin
3327       Error:=True;
3328       Break;
3329     end;
3330     Result:=N1 - N2;
3331     if Result <> 0 then
3332       Break;
3333   until (Ver1 = '') and (Ver2 = '');
3334   if pError <> nil then
3335     Boolean(pError^):=Error; { Boolean(...) is for Free Pascal }
3336 end;
3337 
3338 end.
3339