/[projects]/dao/DelphiScanner/Components/tpsystools_4.04/source/StStrW.pas
ViewVC logotype

Contents of /dao/DelphiScanner/Components/tpsystools_4.04/source/StStrW.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (show annotations) (download)
Tue Aug 25 18:15:15 2015 UTC (8 years, 10 months ago) by torben
File size: 75630 byte(s)
Added tpsystools component
1 (* ***** BEGIN LICENSE BLOCK *****
2 * Version: MPL 1.1
3 *
4 * The contents of this file are subject to the Mozilla Public License Version
5 * 1.1 (the "License"); you may not use this file except in compliance with
6 * the License. You may obtain a copy of the License at
7 * http://www.mozilla.org/MPL/
8 *
9 * Software distributed under the License is distributed on an "AS IS" basis,
10 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11 * for the specific language governing rights and limitations under the
12 * License.
13 *
14 * The Original Code is TurboPower SysTools
15 *
16 * The Initial Developer of the Original Code is
17 * TurboPower Software
18 *
19 * Portions created by the Initial Developer are Copyright (C) 1996-2002
20 * the Initial Developer. All Rights Reserved.
21 *
22 * Contributor(s):
23 *
24 * ***** END LICENSE BLOCK ***** *)
25
26 {*********************************************************}
27 {* SysTools: StStrW.pas 4.04 *}
28 {*********************************************************}
29 {* SysTools: Wide (Unicode) string routines *}
30 {*********************************************************}
31
32 {$I StDefine.inc}
33
34 unit StStrW;
35
36 interface
37
38 uses
39 Windows,
40 Classes,
41 SysUtils,
42 StConst,
43 StBase;
44
45
46 {.Z+}
47 type
48 WStrRec = packed record
49 Length : Longint;
50 end;
51
52 const
53 StrOffset = SizeOf(WStrRec);
54 {.Z-}
55
56 {-------- Numeric conversion -----------}
57
58 function HexBW(B : Byte) : WideString;
59 {-Return the hex string for a byte.}
60
61 function HexWW(W : Word) : WideString;
62 {-Return the hex string for a word.}
63
64 function HexLW(L : LongInt) : WideString;
65 {-Return the hex string for a long integer.}
66
67 function HexPtrW(P : Pointer) : WideString;
68 {-Return the hex string for a pointer.}
69
70 function BinaryBW(B : Byte) : WideString;
71 {-Return a binary string for a byte.}
72
73 function BinaryWW(W : Word) : WideString;
74 {-Return the binary string for a word.}
75
76 function BinaryLW(L : LongInt) : WideString;
77 {-Return the binary string for a long integer.}
78
79 function OctalBW(B : Byte) : WideString;
80 {-Return an octal string for a byte.}
81
82 function OctalWW(W : Word) : WideString;
83 {-Return an octal string for a word.}
84
85 function OctalLW(L : LongInt) : WideString;
86 {-Return an octal string for a long integer.}
87
88 function Str2Int16W(const S : WideString; var I : SmallInt) : Boolean;
89 {-Convert a string to an SmallInt.}
90
91 function Str2WordW(const S : WideString; var I : Word) : Boolean;
92 {-Convert a string to a word.}
93
94 function Str2LongW(const S : WideString; var I : LongInt) : Boolean;
95 {-Convert a string to a long integer.}
96
97 function Str2RealW(const S : WideString; var R : Double) : Boolean;
98 {-Convert a string to a real.}
99
100 function Str2ExtW(const S : WideString; var R : Extended) : Boolean;
101 {-Convert a string to an extended.}
102
103 function Long2StrW(L : LongInt) : WideString;
104 {-Convert an integer type to a string.}
105
106 function Real2StrW(R : Double; Width : Byte; Places : ShortInt) : WideString;
107 {-Convert a real to a string.}
108
109 function Ext2StrW(R : Extended; Width : Byte; Places : ShortInt) : WideString;
110 {-Convert an extended to a string.}
111
112 function ValPrepW(const S : WideString) : WideString;
113 {-Prepares a string for calling Val.}
114
115 {-------- General purpose string manipulation --------}
116
117 function CharStrW(C : WideChar; Len : Cardinal) : WideString;
118 {-Return a string filled with the specified character.}
119
120 function PadChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
121 {-Pad a string on the right with a specified character.}
122
123 function PadW(const S : WideString; Len : Cardinal) : WideString;
124 {-Pad a string on the right with spaces.}
125
126 function LeftPadChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
127 {-Pad a string on the left with a specified character.}
128
129 function LeftPadW(const S : WideString; Len : Cardinal) : WideString;
130 {-Pad a string on the left with spaces.}
131
132 function TrimLeadW(const S : WideString) : WideString;
133 {-Return a string with leading white space removed.}
134
135 function TrimTrailW(const S : WideString) : WideString;
136 {-Return a string with trailing white space removed.}
137
138 function TrimW(const S : WideString) : WideString;
139 {-Return a string with leading and trailing white space removed.}
140
141 function TrimSpacesW(const S : WideString) : WideString;
142 {-Return a string with leading and trailing spaces removed.}
143
144 function CenterChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
145 {-Pad a string on the left and right with a specified character.}
146
147 function CenterW(const S : WideString; Len : Cardinal) : WideString;
148 {-Pad a string on the left and right with spaces.}
149
150
151 function EntabW(const S : WideString; TabSize : Byte) : WideString;
152 {-Convert blanks in a string to tabs.}
153
154 function DetabW(const S : WideString; TabSize : Byte) : WideString;
155 {-Expand tabs in a string to blanks.}
156
157
158 function ScrambleW(const S, Key : WideString) : WideString;
159 {-Encrypt / Decrypt string with enhanced XOR encryption.}
160
161 function SubstituteW(const S, FromStr, ToStr : WideString) : WideString;
162 {-Map the characters found in FromStr to the corresponding ones in ToStr.}
163
164 function FilterW(const S, Filters : WideString) : WideString;
165 {-Remove characters from a string. The characters to remove are specified in
166 ChSet.}
167
168 {--------------- Word / Char manipulation -------------------------}
169
170 function CharExistsW(const S : WideString; C : WideChar) : Boolean;
171 {-Determine whether a given character exists in a string. }
172
173 function CharCountW(const S : WideString; C : WideChar) : Cardinal;
174 {-Count the number of a given character in a string. }
175
176 function WordCountW(const S, WordDelims : WideString) : Cardinal;
177 {-Given an array of word delimiters, return the number of words in a string.}
178
179 function WordPositionW(N : Cardinal; const S, WordDelims : WideString;
180 var Pos : Cardinal) : Boolean;
181 {-Given an array of word delimiters, set Pos to the start position of the
182 N'th word in a string. Result indicates success/failure.}
183
184 function ExtractWordW(N : Cardinal; const S, WordDelims : WideString) : WideString;
185 {-Given an array of word delimiters, return the N'th word in a string.}
186
187 function AsciiCountW(const S, WordDelims : WideString; Quote : WideChar) : Cardinal;
188 {-Return the number of words in a string.}
189
190 function AsciiPositionW(N : Cardinal; const S, WordDelims : WideString;
191 Quote : WideChar; var Pos : Cardinal) : Boolean;
192 {-Return the position of the N'th word in a string.}
193
194 function ExtractAsciiW(N : Cardinal; const S, WordDelims : WideString;
195 Quote : WideChar) : WideString;
196 {-Given an array of word delimiters, return the N'th word in a string. Any
197 text within Quote characters is counted as one word.}
198
199 procedure WordWrapW(const InSt : WideString; var OutSt, Overlap : WideString;
200 Margin : Cardinal; PadToMargin : Boolean);
201 {-Wrap a text string at a specified margin.}
202
203 {--------------- String comparison and searching -----------------}
204 function CompStringW(const S1, S2 : WideString) : Integer;
205 {-Compare two strings.}
206
207 function CompUCStringW(const S1, S2 : WideString) : Integer;
208 {-Compare two strings. This compare is not case sensitive.}
209
210 {--------------- DOS pathname parsing -----------------}
211
212 function DefaultExtensionW(const Name, Ext : WideString) : WideString;
213 {-Return a file name with a default extension attached.}
214
215 function ForceExtensionW(const Name, Ext : WideString) : WideString;
216 {-Force the specified extension onto the file name.}
217
218 function JustFilenameW(const PathName : WideString) : WideString;
219 {-Return just the filename and extension of a pathname.}
220
221 function JustNameW(const PathName : WideString) : WideString;
222 {-Return just the filename (no extension, path, or drive) of a pathname.}
223
224 function JustExtensionW(const Name : WideString) : WideString;
225 {-Return just the extension of a pathname.}
226
227 function JustPathnameW(const PathName : WideString) : WideString;
228 {-Return just the drive and directory portion of a pathname.}
229
230 function AddBackSlashW(const DirName : WideString) : WideString;
231 {-Add a default backslash to a directory name.}
232
233 function CleanPathNameW(const PathName : WideString) : WideString;
234 {-Return a pathname cleaned up as DOS does it.}
235
236 function HasExtensionW(const Name : WideString; var DotPos : Cardinal) : Boolean;
237 {-Determine if a pathname contains an extension and, if so, return the
238 position of the dot in front of the extension.}
239
240 {------------------ Formatting routines --------------------}
241
242 function CommaizeW(L : LongInt) : WideString;
243 {-Convert a long integer to a string with commas.}
244
245 function CommaizeChW(L : Longint; Ch : WideChar) : WideString;
246 {-Convert a long integer to a string with Ch in comma positions.}
247
248 function FloatFormW(const Mask : WideString ; R : TstFloat ; const LtCurr,
249 RtCurr : WideString ; Sep, DecPt : WideChar) : WideString;
250 {-Return a formatted string with digits from R merged into mask.}
251
252 function LongIntFormW(const Mask : WideString ; L : LongInt ; const LtCurr,
253 RtCurr : WideString ; Sep : WideChar) : WideString;
254 {-Return a formatted string with digits from L merged into mask.}
255
256 function StrChPosW(const P : WideString; C : WideChar; var Pos : Cardinal) : Boolean;
257 {-Return the position of a specified character within a string.}
258
259 function StrStPosW(const P, S : WideString; var Pos : Cardinal) : Boolean;
260 {-Return the position of a specified substring within a string.}
261
262 function StrStCopyW(const S : WideString; Pos, Count : Cardinal) : WideString;
263 {-Copy characters at a specified position in a string.}
264
265 function StrChInsertW(const S : WideString; C : WideChar; Pos : Cardinal) : WideString;
266 {-Insert a character into a string at a specified position.}
267
268 function StrStInsertW(const S1, S2 : WideString; Pos : Cardinal) : WideString;
269 {-Insert a string into another string at a specified position.}
270
271 function StrChDeleteW(const S : WideString; Pos : Cardinal) : WideString;
272 {-Delete the character at a specified position in a string.}
273
274 function StrStDeleteW(const S : WideString; Pos, Count : Cardinal) : WideString;
275 {-Delete characters at a specified position in a string.}
276
277 {-------------------------- New Functions -----------------------------------}
278
279 function ContainsOnlyW(const S, Chars : WideString;
280 var BadPos : Cardinal) : Boolean;
281
282 function ContainsOtherThanW(const S, Chars : WideString;
283 var BadPos : Cardinal) : Boolean;
284
285 function CopyFromNthWordW(const S, WordDelims : WideString;
286 AWord : WideString; N : Cardinal;
287 var SubString : WideString) : Boolean;
288
289 function CopyFromToWordW(const S, WordDelims, Word1, Word2 : WideString;
290 N1, N2 : Cardinal;
291 var SubString : WideString) : Boolean;
292
293 function CopyLeftW(const S : WideString; Len : Cardinal) : WideString;
294 {-Return the left Len characters of a string}
295
296 function CopyMidW(const S : WideString; First, Len : Cardinal) : WideString;
297 {-Return the mid part of a string}
298
299 function CopyRightW(const S : WideString; First : Cardinal) : WideString;
300 {-Return the right Len characters of a string}
301
302 function CopyRightAbsW(const S : WideString; NumChars : Cardinal) : WideString;
303 {-Return NumChar characters starting from end}
304
305 function CopyWithinW(const S, Delimiter : WideString;
306 Strip : Boolean) : WideString;
307
308 function DeleteFromNthWordW(const S, WordDelims : WideString;
309 AWord : WideString; N : Cardinal;
310 var SubString : WideString) : Boolean;
311
312
313 function DeleteFromToWordW(const S, WordDelims, Word1, Word2 : WideString;
314 N1, N2 : Cardinal;
315 var SubString : WideString) : Boolean;
316
317 function DeleteWithinW(const S, Delimiter : WideString) : WideString;
318
319 function ExtractTokensW(const S, Delims : WideString;
320 QuoteChar : WideChar;
321 AllowNulls : Boolean;
322 Tokens : TStrings) : Cardinal;
323
324 function IsChAlphaW(C : WideChar) : Boolean;
325 {-Returns true if Ch is an alpha}
326
327 function IsChNumericW(C : WideChar; Numbers : WideString) : Boolean;
328 {-Returns true if Ch in numeric set}
329
330 function IsChAlphaNumericW(C : WideChar; Numbers : WideString) : Boolean;
331 {-Returns true if Ch is an alpha or numeric}
332
333 function IsStrAlphaW(const S : WideString) : Boolean;
334 {-Returns true if all characters in string are an alpha}
335
336 function IsStrNumericW(const S, Numbers : WideString) : Boolean;
337 {-Returns true if all characters in string are in numeric set}
338
339 function IsStrAlphaNumericW(const S, Numbers : WideString) : Boolean;
340 {-Returns true if all characters in string are alpha or numeric}
341
342 function KeepCharsW(const S, Chars : WideString) : WideString;
343
344 function LastStringW(const S, AString : WideString;
345 var Position : Cardinal) : Boolean;
346
347 function LastWordW(const S, WordDelims, AWord : WideString;
348 var Position : Cardinal) : Boolean;
349
350 function LastWordAbsW(const S, WordDelims : WideString;
351 var Position : Cardinal) : Boolean;
352
353 function LeftTrimCharsW(const S, Chars : WideString) : WideString;
354
355 function ReplaceWordW(const S, WordDelims, OldWord, NewWord : WideString;
356 N : Cardinal;
357 var Replacements : Cardinal) : WideString;
358
359 function ReplaceWordAllW(const S, WordDelims, OldWord, NewWord : WideString;
360 var Replacements : Cardinal) : WideString;
361
362 function ReplaceStringW(const S, OldString, NewString : WideString;
363 N : Cardinal;
364 var Replacements : Cardinal) : WideString;
365
366 function ReplaceStringAllW(const S, OldString, NewString : WideString;
367 var Replacements : Cardinal) : WideString;
368
369
370 function RepeatStringW(const RepeatString : WideString;
371 var Repetitions : Cardinal;
372 MaxLen : Cardinal) : WideString;
373
374 function RightTrimCharsW(const S, Chars : WideString) : WideString;
375
376 function StrWithinW(const S, SearchStr : WideString;
377 Start : Cardinal;
378 var Position : Cardinal) : boolean;
379 {-finds the position of a substring within a string starting at a given point}
380
381 function TrimCharsW(const S, Chars : WideString) : WideString;
382
383 function WordPosW(const S, WordDelims, AWord : WideString;
384 N : Cardinal; var Position : Cardinal) : Boolean;
385 {-returns the Occurrence instance of a word within a string}
386
387
388 implementation
389
390 uses
391 StUtils;
392
393 {-------- Numeric conversion -----------}
394
395 function HexBW(B : Byte) : WideString;
396 {-Return the hex string for a byte.}
397 begin
398 SetLength(Result, 2);
399 Result[1] := WideChar(StHexDigits[B shr 4]);
400 Result[2] := WideChar(StHexDigits[B and $F]);
401 end;
402
403 function HexWW(W : Word) : WideString;
404 {-Return the hex string for a word.}
405 begin
406 SetLength(Result, 4);
407 Result[1] := WideChar(StHexDigits[hi(W) shr 4]);
408 Result[2] := WideChar(StHexDigits[hi(W) and $F]);
409 Result[3] := WideChar(StHexDigits[lo(W) shr 4]);
410 Result[4] := WideChar(StHexDigits[lo(W) and $F]);
411 end;
412
413 function HexLW(L : LongInt) : WideString;
414 {-Return the hex string for a long integer.}
415 begin
416 SetLength(Result, 8);
417 Result := HexWW(HiWord(DWORD(L))) + HexWW(LoWord(DWORD(L))); {!!.02}
418 end;
419
420 function HexPtrW(P : Pointer) : WideString;
421 {-Return the hex string for a pointer.}
422 begin
423 SetLength(Result, 9);
424 Result := ':' + HexLW(LongInt(P));
425 end;
426
427 function BinaryBW(B : Byte) : WideString;
428 {-Return a binary string for a byte.}
429 var
430 I, N : Word;
431 begin
432 N := 1;
433 SetLength(Result, 8);
434 for I := 7 downto 0 do begin
435 Result[N] := WideChar(StHexDigits[Ord(B and (1 shl I) <> 0)]); {0 or 1}
436 Inc(N);
437 end;
438 end;
439
440 function BinaryWW(W : Word) : WideString;
441 {-Return the binary string for a word.}
442 var
443 I, N : Word;
444 begin
445 N := 1;
446 SetLength(Result, 16);
447 for I := 15 downto 0 do begin
448 Result[N] := WideChar(StHexDigits[Ord(W and (1 shl I) <> 0)]); {0 or 1}
449 Inc(N);
450 end;
451 end;
452
453 function BinaryLW(L : LongInt) : WideString;
454 {-Return the binary string for a long integer.}
455 var
456 I : Longint;
457 N : Byte;
458 begin
459 N := 1;
460 SetLength(Result, 32);
461 for I := 31 downto 0 do begin
462 Result[N] := WideChar(StHexDigits[Ord(L and LongInt(1 shl I) <> 0)]); {0 or 1}
463 Inc(N);
464 end;
465 end;
466
467 function OctalBW(B : Byte) : WideString;
468 {-Return an octal string for a byte.}
469 var
470 I : Word;
471 begin
472 SetLength(Result, 3);
473 for I := 0 to 2 do begin
474 Result[3-I] := WideChar(StHexDigits[B and 7]);
475 B := B shr 3;
476 end;
477 end;
478
479 function OctalWW(W : Word) : WideString;
480 {-Return an octal string for a word.}
481 var
482 I : Word;
483 begin
484 SetLength(Result, 6);
485 for I := 0 to 5 do begin
486 Result[6-I] := WideChar(StHexDigits[W and 7]);
487 W := W shr 3;
488 end;
489 end;
490
491 function OctalLW(L : LongInt) : WideString;
492 {-Return an octal string for a long integer.}
493 var
494 I : Word;
495 begin
496 SetLength(Result, 12);
497 for I := 0 to 11 do begin
498 Result[12-I] := WideChar(StHexDigits[L and 7]);
499 L := L shr 3;
500 end;
501 end;
502
503 function Str2Int16W(const S : WideString; var I : SmallInt) : Boolean;
504 {-Convert a string to an SmallInt.}
505
506 var
507 ec : Integer;
508 begin
509 if (length(S) > 255) then begin
510 Result := false;
511 I := 256;
512 end
513 else begin
514 {note the automatic string conversion}
515 ValSmallint(S, I, ec);
516 if (ec = 0) then
517 Result := true
518 else begin
519 Result := false;
520 if (ec < 0) then
521 I := succ(length(S))
522 else
523 I := ec;
524 end;
525 end;
526 end;
527
528 function Str2WordW(const S : WideString; var I : Word) : Boolean;
529 {-Convert a string to a word.}
530
531 var
532 ec : Integer;
533 begin
534 if (length(S) > 255) then begin
535 Result := false;
536 I := 256;
537 end
538 else begin
539 {note the automatic string conversion}
540 ValWord(S, I, ec);
541 if (ec = 0) then
542 Result := true
543 else begin
544 Result := false;
545 if (ec < 0) then
546 I := succ(length(S))
547 else
548 I := ec;
549 end;
550 end;
551 end;
552
553 function Str2LongW(const S : WideString; var I : LongInt) : Boolean;
554 {-Convert a string to a long integer.}
555
556 var
557 ec : Integer;
558 begin
559 if (length(S) > 255) then begin
560 Result := false;
561 I := 256;
562 end
563 else begin
564 {note the automatic string conversion}
565 ValLongint(S, I, ec);
566 if (ec = 0) then
567 Result := true
568 else begin
569 Result := false;
570 if (ec < 0) then
571 I := succ(length(S))
572 else
573 I := ec;
574 end;
575 end;
576 end;
577
578 function Str2RealW(const S : WideString; var R : Double) : Boolean;
579 {-Convert a string to a real.}
580 var
581 Code : Integer;
582 St : AnsiString;
583 begin
584 Result := False;
585 if S = '' then Exit;
586 St := TrimTrailW(S);
587 if St = '' then Exit;
588 Val(ValPrepW(St), R, Code);
589 if Code <> 0 then begin
590 R := Code;
591 end else
592 Result := True;
593 end;
594
595 function Str2ExtW(const S : WideString; var R : Extended) : Boolean;
596 {-Convert a string to an extended.}
597 var
598 Code : Integer;
599 P : WideString;
600 begin
601 Result := False;
602 if S = '' then Exit;
603 P := TrimTrailW(S);
604 if P = '' then Exit;
605 Val(ValPrepW(P), R, Code);
606 if Code <> 0 then begin
607 R := Code - 1;
608 end else
609 Result := True;
610 end;
611
612 function Long2StrW(L : LongInt) : WideString;
613 {-Convert an integer type to a string.}
614 begin
615 Str(L, Result);
616 end;
617
618 function Real2StrW(R : Double; Width : Byte; Places : ShortInt) : WideString;
619 {-Convert a real to a string.}
620 begin
621 Str(R:Width:Places, Result);
622 end;
623
624 function Ext2StrW(R : Extended; Width : Byte; Places : ShortInt) : WideString;
625 {-Convert an extended to a string.}
626 begin
627 Str(R:Width:Places, Result);
628 end;
629
630 function ValPrepW(const S : WideString) : WideString;
631 {-Prepares a string for calling Val.}
632 var
633 P : Cardinal;
634 C : Longint;
635 begin
636 Result := TrimSpacesW(S);
637 if Result <> '' then begin
638 if StrChPosW(Result, WideChar({$IFDEF DELPHIXE2}FormatSettings.{$ENDIF}DecimalSeparator), P) then begin
639 C := P;
640 Result[C] := '.';
641 if C = Length(Result) then
642 SetLength(Result, Pred(C));
643 end;
644 end else
645 Result := '0';
646 end;
647
648 {-------- General purpose string manipulation --------}
649
650 function CharStrW(C : WideChar; Len : Cardinal) : WideString;
651 {-Return a string filled with the specified character.}
652 var
653 I : Longint;
654 begin
655 SetLength(Result, Len);
656 if Len <> 0 then begin
657 {FillChar does not work for widestring}
658 for I := 1 to Len do
659 Result[I] := C;
660 end;
661 end;
662
663 function PadChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
664 {-Pad a string on the right with a specified character.}
665 var
666 J,
667 R : Longint;
668 begin
669 if Length(S) >= LongInt(Len) then
670 Result := S
671 else begin
672 SetLength(Result, Len);
673
674 { copy current contents (if any) of S to Result }
675 if (Length(S) > 0) and (Length(Result) > 0) then {!!.01}
676 Move(S[1], Result[1], Length(S)*SizeOf(WideChar)); {!!.01}
677
678 R := longint(Len) - Length(S);
679 J := Succ(Length(S));
680 while (R > 0) do begin
681 Result[J] := C;
682 Inc(J);
683 Dec(R);
684 end;
685 end;
686 end;
687
688 function PadW(const S : WideString; Len : Cardinal) : WideString;
689 {-Pad a string on the right with spaces.}
690 begin
691 Result := PadChW(S, ' ', Len);
692 end;
693
694 function LeftPadChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
695 {-Pad a string on the left with a specified character.}
696 var
697 J,
698 R : Longint;
699 begin
700 if Length(S) >= LongInt(Len) then
701 Result := S
702 else if Length(S) < MaxLongInt then begin
703 SetLength(Result, Len);
704 if (Length(S) > 0) and (Length(Result) > 0) then {!!.01}
705 Move(S[1], Result[Succ(Word(Len))-Length(S)], {!!.01}
706 Length(S)*SizeOf(WideChar)); {!!.01}
707 R := longint(Len) - Length(S);
708 J := 1;
709 while (R > 0) do begin
710 Result[J] := C;
711 Inc(J);
712 Dec(R);
713 end;
714 end;
715 end;
716
717 function LeftPadW(const S : WideString; Len : Cardinal) : WideString;
718 {-Pad a string on the left with spaces.}
719 begin
720 Result := LeftPadChW(S, ' ', Len);
721 end;
722
723 function TrimLeadW(const S : WideString) : WideString;
724 {-Return a string with leading white space removed}
725 var
726 I : Longint;
727 begin
728 I := 1;
729 while (I <= Length(S)) and (S[I] <= ' ') do
730 Inc(I);
731 SetLength(Result, Length(S)-Pred(I));
732 if Length(Result) > 0 then {!!.01}
733 Move(S[I], Result[1], Length(S)-Pred(I)*SizeOf(WideChar)); {!!.01}
734 end;
735
736 function TrimTrailW(const S : WideString) : WideString;
737 {-Return a string with trailing white space removed.}
738 var
739 L : Longint;
740 begin
741 Result := S;
742 L := Length(Result);
743 while (L > 0) and (Result[L] <= ' ') do
744 Dec(L);
745 SetLength(Result, L);
746 end;
747
748 function TrimW(const S : WideString) : WideString;
749 {-Return a string with leading and trailing white space removed.}
750 var
751 I : Longint;
752 begin
753 Result := S;
754 I := Length(Result);
755 while (I > 0) and (Result[I] <= ' ') do
756 Dec(I);
757 SetLength(Result, I);
758
759 I := 1;
760 while (I <= Length(Result)) and (Result[I] <= ' ') do
761 Inc(I);
762 Dec(I);
763 if (I > 0) then
764 System.Delete(Result, 1, I);
765 end;
766
767 function TrimSpacesW(const S : WideString) : WideString;
768 {-Return a string with leading and trailing spaces removed.}
769 var
770 I : Longint;
771 begin
772 Result := S;
773 I := Length(Result);
774 while (I > 0) and (Result[I] = ' ') do
775 Dec(I);
776 SetLength(Result, I);
777
778 I := 1;
779 while (I <= Length(Result)) and (S[I] = ' ') do
780 Inc(I);
781 Dec(I);
782 if (I > 0) then
783 System.Delete(Result, 1, I);
784 end;
785
786 function CenterChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
787 {-Pad a string on the left and right with a specified character.}
788 begin
789 if Length(S) >= LongInt(Len) then
790 Result := S
791 else if Length(S) < MaxLongInt then begin
792 SetLength(Result, Len);
793 Result := CharStrW(C, Len);
794 if Length(S) > 0 then {!!.01}
795 Move(S[1], Result[Succ((LongInt(Len)-Length(S)) shr 1)], Length(S));
796 end;
797 end;
798
799 function CenterW(const S : WideString; Len : Cardinal) : WideString;
800 {-Pad a string on the left and right with spaces.}
801 begin
802 Result := CenterChW(S, ' ', Len);
803 end;
804
805
806 function EntabW(const S : WideString; TabSize : Byte) : WideString;
807 {-Convert blanks in a string to tabs.}
808 const
809 WSpace = WideChar(#32);
810 {$IFNDEF VERSION4}
811 WTab = string(WideChar(#9));
812 {$ELSE}
813 WTab = WideChar(#9);
814 {$ENDIF}
815 var
816 Col,
817 CP,
818 OP,
819 Spaces : Longint;
820 begin
821 if (pos(' ', S) = 0) then begin
822 Result := S;
823 Exit;
824 end;
825 Result := '';
826 Col := 1;
827 repeat
828 CP := Col;
829 while ((S[CP] <> WSpace) and (CP <= Length(S))) do
830 Inc(CP);
831 if (CP <> Col) then begin
832 OP := Length(Result) + 1;
833 SetLength(Result, Length(Result) + (CP-Col));
834 Move(S[Col], Result[OP], ((CP-Col) * SizeOf(WideChar)));
835 Col := CP;
836 end;
837
838 while (S[CP] = WSpace) do begin
839 Inc(CP);
840 if ((CP mod TabSize) = 1) then begin
841 Result := Result + WTab;
842 Col := CP;
843 end;
844 end;
845 Spaces := 0;
846 while (Col < CP) do begin
847 Inc(Spaces);
848 Inc(Col);
849 end;
850 if (Spaces > 0) then
851 Result := Result + PadW(WSpace, Spaces);
852 until (Col > Length(S));
853 end;
854
855
856 function DetabW(const S : WideString; TabSize : Byte) : WideString;
857 {-Expand tabs in a string to blanks.}
858 var
859 Col,
860 CP,
861 OP,
862 Spaces : Longint;
863 begin
864 if S = '' then begin
865 Result := '';
866 Exit;
867 end else if (TabSize = 0) then begin
868 Result := S;
869 Exit;
870 end;
871 if (CharCountW(S, WideChar(#9)) = 0) then begin
872 Result := S;
873 Exit;
874 end;
875 Result := '';
876
877 Col := 1;
878 while (Col <= Length(S)) do begin
879 if (S[Col] = WideChar(#9)) then begin
880 Spaces := 0;
881 repeat
882 Inc(Spaces);
883 until (((Col + Spaces) mod TabSize) = 1);
884 Inc(Col);
885 Result := PadW(Result, Length(Result) + Spaces);
886 end else begin
887 CP := Col;
888 repeat
889 Inc(Col);
890 until (Col > Length(S)) or (S[Col] = WideChar(#9));
891 OP := Length(Result) + 1;
892 SetLength(Result, Length(Result) + (Col - CP));
893 Move(S[CP], Result[OP], (Col-CP)*SizeOf(WideChar));
894 end;
895 end;
896 end;
897
898
899 function ScrambleW(const S, Key : WideString) : WideString;
900 {-Encrypt / Decrypt string with enhanced XOR encryption.}
901 var
902 I, J, LKey, LStr : Cardinal;
903 begin
904 Result := S;
905 if Key = '' then Exit;
906 if S = '' then Exit;
907 LKey := Length(Key);
908 LStr := Length(S);
909 I := 1;
910 J := LKey;
911 while I <= LStr do begin
912 if J = 0 then
913 J := LKey;
914 if (S[I] <> Key[J]) then
915 Result[I] := WideChar(Word(S[I]) xor Word(Key[J]));
916 Inc(I);
917 Dec(J);
918 end;
919 end;
920
921 function SubstituteW(const S, FromStr, ToStr : WideString) : WideString;
922 {-Map the characters found in FromStr to the corresponding ones in ToStr.}
923 var
924 I : Cardinal;
925 P : Cardinal;
926 begin
927 Result := S;
928 if Length(FromStr) = Length(ToStr) then
929 for I := 1 to Length(Result) do begin
930 if StrChPosW(FromStr, S[I], P) then
931 Result[I] := ToStr[P];
932 end;
933 end;
934
935 function FilterW(const S, Filters : WideString) : WideString;
936 {-Remove characters from a string. The characters to remove are specified in
937 ChSet.}
938 var
939 I : Cardinal;
940 Len : Cardinal;
941 begin
942 Len := 0;
943 SetLength(Result, Length(S));
944 for I := 1 to Length(S) do
945 if not CharExistsW(Filters, S[I]) then begin
946 Inc(Len);
947 Result[Len] := S[I];
948 end;
949 SetLength(Result, Len);
950 end;
951
952 {--------------- Word / Char manipulation -------------------------}
953
954 function CharExistsW(const S : WideString; C : WideChar) : Boolean;
955 {-see if character exists at least once in a string}
956 var
957 i : integer;
958 begin
959 Result := true;
960 for i := 1 to length(S) do
961 if (S[i] = C) then
962 Exit;
963 Result := false;
964 end;
965
966 function CharCountW(const S : WideString; C : WideChar) : Cardinal;
967 {-Count the number of a given character in a string. }
968 var
969 i : integer;
970 begin
971 Result := 0;
972 for i := 1 to length(S) do
973 if (S[i] = C) then
974 inc(Result);
975 end;
976
977 function WordCountW(const S, WordDelims : WideString) : Cardinal;
978 {-Given an array of word delimiters, return the number of words in a string.}
979 var
980 I : Cardinal;
981 SLen : Cardinal;
982 begin
983 Result := 0;
984 I := 1;
985 SLen := Length(S);
986
987 while I <= SLen do begin
988 {skip over delimiters}
989 while (I <= SLen) and CharExistsW(WordDelims, S[I]) do
990 Inc(I);
991
992 {if we're not beyond end of S, we're at the start of a word}
993 if I <= SLen then
994 Inc(Result);
995
996 {find the end of the current word}
997 while (I <= SLen) and not CharExistsW(WordDelims, S[I]) do
998 Inc(I);
999 end;
1000 end;
1001
1002 function WordPositionW(N : Cardinal; const S, WordDelims : WideString;
1003 var Pos : Cardinal) : Boolean;
1004 {-Given an array of word delimiters, set Pos to the start position of the
1005 N'th word in a string. Result indicates success/failure.}
1006 var
1007 Count : Longint;
1008 I : Longint;
1009 begin
1010 Count := 0;
1011 I := 1;
1012 Result := False;
1013
1014 while (I <= Length(S)) and (Count <> LongInt(N)) do begin
1015 {skip over delimiters}
1016 while (I <= Length(S)) and CharExistsW(WordDelims, S[I]) do
1017 Inc(I);
1018
1019 {if we're not beyond end of S, we're at the start of a word}
1020 if I <= Length(S) then
1021 Inc(Count);
1022
1023 {if not finished, find the end of the current word}
1024 if Count <> LongInt(N) then
1025 while (I <= Length(S)) and not CharExistsW(WordDelims, S[I]) do
1026 Inc(I)
1027 else begin
1028 Pos := I;
1029 Result := True;
1030 end;
1031 end;
1032 end;
1033
1034 function ExtractWordW(N : Cardinal; const S, WordDelims : WideString) : WideString;
1035 {-Given an array of word delimiters, return the N'th word in a string.}
1036 var
1037 C : Cardinal;
1038 I,
1039 J : Longint;
1040 begin
1041 Result := '';
1042 if WordPositionW(N, S, WordDelims, C) then begin
1043 I := C;
1044 {find the end of the current word}
1045 J := I;
1046 while (I <= Length(S)) and not
1047 CharExistsW(WordDelims, S[I]) do
1048 Inc(I);
1049 SetLength(Result, I-J);
1050 Move(S[J], Result[1], (I-J) * SizeOf(WideChar));
1051 end;
1052 end;
1053
1054 function AsciiCountW(const S, WordDelims : WideString; Quote : WideChar) : Cardinal;
1055 {-Return the number of words in a string.}
1056 var
1057 I : Longint;
1058 InQuote : Boolean;
1059 begin
1060 Result := 0;
1061 I := 1;
1062 InQuote := False;
1063 while I <= Length(S) do begin
1064 {skip over delimiters}
1065 while (I <= Length(S)) and (S[I] <> Quote)
1066 and CharExistsW(WordDelims, S[I]) do
1067 Inc(I);
1068 {if we're not beyond end of S, we're at the start of a word}
1069 if I <= Length(S) then
1070 Inc(Result);
1071 {find the end of the current word}
1072 while (I <= Length(S)) and
1073 (InQuote or not CharExistsW(WordDelims, S[I])) do begin
1074 if S[I] = Quote then
1075 InQuote := not InQuote;
1076 Inc(I);
1077 end;
1078 end;
1079 end;
1080
1081 function AsciiPositionW(N : Cardinal; const S, WordDelims : WideString;
1082 Quote : WideChar; var Pos : Cardinal) : Boolean;
1083 {-Return the position of the N'th word in a string.}
1084 var
1085 I,
1086 Count : Longint;
1087 InQuote : Boolean;
1088 begin
1089 Count := 0;
1090 InQuote := False;
1091 Result := False;
1092 I := 1;
1093 while (I <= Length(S)) and (Count <> LongInt(N)) do begin
1094 {skip over delimiters}
1095 while (I <= Length(S)) and (S[I] <> Quote) and
1096 CharExistsW(WordDelims, S[I]) do
1097 Inc(I);
1098 {if we're not beyond end of S, we're at the start of a word}
1099 if I <= Length(S) then
1100 Inc(Count);
1101 {if not finished, find the end of the current word}
1102 if Count <> LongInt(N) then
1103 while (I <= Length(S)) and
1104 (InQuote or not CharExistsW(WordDelims, S[I])) do begin
1105 if S[I] = Quote then
1106 InQuote := not InQuote;
1107 Inc(I);
1108 end
1109 else begin
1110 Pos := I;
1111 Result := True;
1112 end;
1113 end;
1114 end;
1115
1116 function ExtractAsciiW(N : Cardinal; const S, WordDelims : WideString;
1117 Quote : WideChar) : WideString;
1118 {-Given an array of word delimiters, return the N'th word in a string. Any
1119 text within Quote characters is counted as one word.}
1120 var
1121 C : Cardinal;
1122 I, J : Longint;
1123 InQuote : Boolean;
1124 begin
1125 InQuote := False;
1126 if AsciiPositionW(N, S, WordDelims, Quote, C) then begin
1127 I := C;
1128 J := I;
1129 {find the end of the current word}
1130 while (I <= Length(S)) and ((InQuote)
1131 or not CharExistsW(WordDelims, S[I])) do begin
1132 if S[I] = Quote then
1133 InQuote := not(InQuote);
1134 Inc(I);
1135 end;
1136 SetLength(Result, I-J);
1137 Move(S[J], Result[1], (I-J) * SizeOf(WideChar));
1138 end;
1139 end;
1140
1141 procedure WordWrapW(const InSt : WideString; var OutSt, Overlap : WideString;
1142 Margin : Cardinal; PadToMargin : Boolean);
1143 {-Wrap a text string at a specified margin.}
1144 var
1145 InStLen : Cardinal;
1146 EOS,
1147 BOS : Cardinal;
1148 ASpace : WideChar;
1149 begin
1150 InStLen := Length(InSt);
1151
1152 {!!.02 - Added }
1153 { handle empty string on input }
1154 if InStLen = 0 then begin
1155 OutSt := '';
1156 Overlap := '';
1157 Exit;
1158 end;
1159 {!!.02 - Added }
1160
1161 {find the end of the output string}
1162 if InStLen > Margin then begin
1163 {find the end of the word at the margin, if any}
1164 EOS := Margin;
1165 while (EOS <= InStLen) and (InSt[EOS] <> ' ') do
1166 Inc(EOS);
1167 if EOS > InStLen then
1168 EOS := InStLen;
1169
1170 {trim trailing blanks}
1171 while (InSt[EOS] = ' ') and (EOS > 0) do
1172 Dec(EOS);
1173
1174 if EOS > Margin then begin
1175 {look for the space before the current word}
1176 while (EOS > 0) and (InSt[EOS] <> ' ') do
1177 Dec(EOS);
1178
1179 {if EOS = 0 then we can't wrap it}
1180 if EOS = 0 then
1181 EOS := Margin
1182 else
1183 {trim trailing blanks}
1184 while (InSt[EOS] = ' ') and (EOS > 0) do
1185 Dec(EOS);
1186 end;
1187 end else
1188 EOS := InStLen;
1189
1190 {copy the unwrapped portion of the line}
1191 SetLength(OutSt, EOS);
1192 Move(InSt[1], OutSt[1], Length(OutSt) * SizeOf(WideChar));
1193
1194 {find the start of the next word in the line}
1195 BOS := Succ(EOS);
1196 while (BOS <= InStLen) and (InSt[BOS] = ' ') do
1197 Inc(BOS);
1198
1199 if BOS > InStLen then
1200 SetLength(OverLap, 0)
1201 else begin
1202 {copy from the start of the next word to the end of the line}
1203
1204 SetLength(OverLap, InStLen);
1205 Move(InSt[BOS], Overlap[1], Succ(InStLen-BOS) * SizeOf(WideChar));
1206 SetLength(OverLap, Succ(InStLen-BOS));
1207 end;
1208
1209 {pad the end of the output string if requested}
1210 if PadToMargin and (Length(OutSt) < LongInt(Margin)) then begin
1211 SetLength(OutSt, Margin);
1212 ASpace := ' ';
1213 StUtils.FillWord(OutSt[Succ(Length(OutSt))],
1214 LongInt(Margin)-Length(OutSt), Word(ASpace));
1215 end;
1216 end;
1217
1218 {--------------- String comparison and searching -----------------}
1219
1220 function CompStringW(const S1, S2 : WideString) : Integer;
1221 {-Compare two strings.}
1222 begin
1223 Result := CompareStr(S1, S2);
1224 end;
1225
1226 function CompUCStringW(const S1, S2 : WideString) : Integer;
1227 {-Compare two strings. This compare is not case sensitive.}
1228 begin
1229 Result := CompareText(S1, S2);
1230 end;
1231
1232 {--------------- DOS pathname parsing -----------------}
1233
1234 function DefaultExtensionW(const Name, Ext : WideString) : WideString;
1235 {-Return a file name with a default extension attached.}
1236 var
1237 DotPos : Cardinal;
1238 begin
1239 if HasExtensionW(Name, DotPos) then
1240 Result := Name
1241 else if Name = '' then
1242 Result := ''
1243 else
1244 Result := Name + '.' + Ext;
1245 end;
1246
1247 function ForceExtensionW(const Name, Ext : WideString) : WideString;
1248 {-Force the specified extension onto the file name.}
1249 var
1250 DotPos : Cardinal;
1251 begin
1252 if HasExtensionW(Name, DotPos) then
1253 Result := System.Copy(Name, 1, DotPos) + Ext
1254 else if Name = '' then
1255 Result := ''
1256 else
1257 Result := Name + '.' + Ext;
1258 end;
1259
1260 function JustFilenameW(const PathName : WideString) : WideString;
1261 {-Return just the filename and extension of a pathname.}
1262 var
1263 I : Cardinal;
1264 begin
1265 Result := '';
1266 if PathName = '' then Exit;
1267 I := Succ(Word(Length(PathName)));
1268 repeat
1269 Dec(I);
1270 until (I = 0) or (pos(PathName[I], DosDelimSetW) > 0) {!!.01}
1271 or (PathName[I] = #0); {!!.01}
1272 Result := System.Copy(PathName, Succ(I), StMaxFileLen);
1273 end;
1274
1275 function JustNameW(const PathName : WideString) : WideString;
1276 {-Return just the filename (no extension, path, or drive) of a pathname.}
1277 var
1278 DotPos : Cardinal;
1279 S : WideString;
1280 begin
1281 S := JustFileNameW(PathName);
1282 if HasExtensionW(S, DotPos) then
1283 S := System.Copy(S, 1, DotPos-1);
1284 Result := S;
1285 end;
1286
1287 function JustExtensionW(const Name : WideString) : WideString;
1288 {-Return just the extension of a pathname.}
1289 var
1290 DotPos : Cardinal;
1291 begin
1292 if HasExtensionW(Name, DotPos) then
1293 Result := System.Copy(Name, Succ(DotPos), StMaxFileLen)
1294 else
1295 Result := '';
1296 end;
1297
1298 function JustPathnameW(const PathName : WideString) : WideString;
1299 {-Return just the drive and directory portion of a pathname.}
1300 var
1301 I : Cardinal;
1302 begin
1303 if PathName = '' then Exit;
1304
1305 I := Succ(Word(Length(PathName)));
1306 repeat
1307 Dec(I);
1308 until (I = 0) or (pos(PathName[I], DosDelimSetW) > 0) {!!.01}
1309 or (PathName[I] = #0); {!!.01}
1310
1311 if I = 0 then
1312 {Had no drive or directory name}
1313 SetLength(Result, 0)
1314 else if I = 1 then
1315 {Either the root directory of default drive or invalid pathname}
1316 Result := PathName[1]
1317 else if (PathName[I] = '\') then begin
1318 if PathName[Pred(I)] = ':' then
1319 {Root directory of a drive, leave trailing backslash}
1320 Result := System.Copy(PathName, 1, I)
1321 else
1322 {Subdirectory, remove the trailing backslash}
1323 Result := System.Copy(PathName, 1, Pred(I));
1324 end else
1325 {Either the default directory of a drive or invalid pathname}
1326 Result := System.Copy(PathName, 1, I);
1327 end;
1328
1329
1330 function AddBackSlashW(const DirName : WideString) : WideString;
1331 {-Add a default backslash to a directory name}
1332 begin
1333 Result := DirName;
1334 if (Length(Result) = 0) then
1335 Exit;
1336 if ((Length(Result) = 2) and (Result[2] = ':')) or
1337 ((Length(Result) > 2) and (Result[Length(Result)] <> '\')) then
1338 Result := Result + '\';
1339 end;
1340
1341 function CleanFileNameW(const FileName : WideString) : WideString;
1342 {-Return filename with at most 8 chars of name and 3 of extension}
1343 var
1344 DotPos : Cardinal;
1345 NameLen : Word;
1346 begin
1347 if HasExtensionW(FileName, DotPos) then begin
1348 {Take the first 8 chars of name and first 3 chars of extension}
1349 NameLen := Pred(DotPos);
1350 if NameLen > 8 then
1351 NameLen := 8;
1352 Result := System.Copy(FileName, 1, NameLen)+System.Copy(FileName, DotPos, 4);
1353 end else
1354 {Take the first 8 chars of name}
1355 Result := System.Copy(FileName, 1, 8);
1356 end;
1357
1358 function CleanPathNameW(const PathName : WideString) : WideString;
1359 {-Return a pathname cleaned up as DOS does it.}
1360 var
1361 I : Cardinal;
1362 S : WideString;
1363 begin
1364 SetLength(Result, 0);
1365 S := PathName;
1366
1367 I := Succ(Word(Length(S)));
1368 repeat
1369 dec(I);
1370 if I > 2 then
1371 if (S[I] = '\') and (S[I-1] = '\') then
1372 if (S[I-2] <> ':') then
1373 System.Delete(S, I, 1);
1374 until I <= 0;
1375
1376 I := Succ(Word(Length(S)));
1377 repeat
1378 {Get the next directory or drive portion of pathname}
1379 repeat
1380 Dec(I);
1381 until (I = 0) or (S[I] in DosDelimSet); {!!.02}
1382
1383 {Clean it up and prepend it to output string}
1384 Result := CleanFileNameW(System.Copy(S, Succ(I), StMaxFileLen)) + Result;
1385 if I > 0 then begin
1386 Result := S[I] + Result;
1387 System.Delete(S, I, 255);
1388 end;
1389 until I <= 0;
1390
1391 end;
1392
1393 function HasExtensionW(const Name : WideString; var DotPos : Cardinal) : Boolean;
1394 {-Determine if a pathname contains an extension and, if so, return the
1395 position of the dot in front of the extension.}
1396 var
1397 I : Cardinal;
1398 begin
1399 DotPos := 0;
1400 for I := Length(Name) downto 1 do
1401 if (Name[I] = '.') and (DotPos = 0) then
1402 DotPos := I;
1403 Result := (DotPos > 0)
1404 and not CharExistsW(System.Copy(Name, Succ(DotPos), StMaxFileLen), '\');
1405 end;
1406
1407 {------------------ Formatting routines --------------------}
1408
1409
1410 function CommaizeChW(L : Longint; Ch : WideChar) : WideString;
1411 {-Convert a long integer to a string with Ch in comma positions}
1412 var
1413 Temp : WideString;
1414 I,
1415 Len,
1416 NumCommas : Cardinal;
1417 Neg : Boolean;
1418 begin
1419 SetLength(Temp, 1);
1420 Temp[1] := Ch;
1421 if (L < 0) then begin
1422 Neg := True;
1423 L := Abs(L);
1424 end else
1425 Neg := False;
1426 Result := Long2StrW(L);
1427 Len := Length(Result);
1428 NumCommas := (Pred(Len)) div 3;
1429 for I := 1 to NumCommas do
1430 System.Insert(Temp, Result, Succ(Len-(I * 3)));
1431 if Neg then
1432 System.Insert('-', Result, 1);
1433 end;
1434
1435 function CommaizeW(L : LongInt) : WideString;
1436 {-Convert a long integer to a string with commas}
1437 begin
1438 Result := CommaizeChW(L, ',');
1439 end;
1440
1441 function FormPrimW(const Mask : WideString;
1442 R : TstFloat;
1443 const LtCurr,
1444 RtCurr : WideString;
1445 Sep,
1446 DecPt : WideChar;
1447 AssumeDP : Boolean) : WideString;
1448 {-Returns a formatted string with digits from R merged into the Mask}
1449 const
1450 Blank = 0;
1451 Asterisk = 1;
1452 Zero = 2;
1453 const
1454 {$IFOPT N+}
1455 MaxPlaces = 18;
1456 {$ELSE}
1457 MaxPlaces = 11;
1458 {$ENDIF}
1459 FormChars : string[8] = '#@*$-+,.';
1460 PlusArray : array[Boolean] of WideChar = ('+', '-');
1461 MinusArray : array[Boolean] of WideChar = (' ', '-');
1462 FillArray : array[Blank..Zero] of WideChar = (' ', '*', '0');
1463 var
1464 S : WideString; {temporary string}
1465 Filler : Integer; {char for unused digit slots: ' ', '*', '0'}
1466 WontFit, {true if number won't fit in the mask}
1467 AddMinus, {true if minus sign needs to be added}
1468 Dollar, {true if floating dollar sign is desired}
1469 Negative : Boolean; {true if B is negative}
1470 StartF, {starting point of the numeric field}
1471 EndF : Longint; {end of numeric field}
1472 RtChars, {# of chars to add to right}
1473 LtChars, {# of chars to add to left}
1474 DotPos, {position of '.' in Mask}
1475 Digits, {total # of digits}
1476 Blanks, {# of blanks returned by Str}
1477 Places, {# of digits after the '.'}
1478 FirstDigit, {pos. of first digit returned by Str}
1479 Extras, {# of extra digits needed for special cases}
1480 DigitPtr : Byte; {pointer into temporary string of digits}
1481 I : Cardinal;
1482 label
1483 EndFound,
1484 RedoCase,
1485 Done;
1486 begin
1487 {assume decimal point at end?}
1488 Result := Mask;
1489 if (not AssumeDP) and (not CharExistsW(Result, '.')) then
1490 AssumeDP := true;
1491 if AssumeDP and (Result <> '') then begin
1492 SetLength(Result, Succ(Length(Result)));
1493 Result[Length(Result)] := '.';
1494 end;
1495
1496 RtChars := 0;
1497 LtChars := 0;
1498
1499 {check for empty string}
1500 if Length(Result) = 0 then
1501 goto Done;
1502
1503 {initialize variables}
1504 Filler := Blank;
1505 DotPos := 0;
1506 Places := 0;
1507 Digits := 0;
1508 Dollar := False;
1509 AddMinus := True;
1510 StartF := 1;
1511
1512 {store the sign of the real and make it positive}
1513 Negative := (R < 0);
1514 R := Abs(R);
1515
1516 {strip and count c's}
1517 for I := Length(Result) downto 1 do begin
1518 if Result[I] = 'C' then begin
1519 Inc(RtChars);
1520 System.Delete(Result, I, 1);
1521 end else if Result[I] = 'c' then begin
1522 Inc(LtChars);
1523 System.Delete(Result, I, 1);
1524 end;
1525 end;
1526
1527 {find the starting point for the field}
1528 while (StartF <= Length(Result))
1529 {and (System.Pos(Result[StartF], FormChars) = 0) do}
1530 and not CharExistsW(FormChars, Result[StartF]) do
1531 Inc(StartF);
1532 if StartF > Length(Result) then
1533 goto Done;
1534
1535 {find the end point for the field}
1536 EndF := StartF;
1537 for I := StartF to Length(Result) do begin
1538 EndF := I;
1539 case Result[EndF] of
1540 '*' : Filler := Asterisk;
1541 '@' : Filler := Zero;
1542 '$' : Dollar := True;
1543 '-',
1544 '+' : AddMinus := False;
1545 '#' : {ignore} ;
1546 ',',
1547 '.' : DotPos := EndF;
1548 else
1549 goto EndFound;
1550 end;
1551 {Inc(EndF);}
1552 end;
1553
1554 {if we get here at all, the last char was part of the field}
1555 Inc(EndF);
1556
1557 EndFound:
1558 {if we jumped to here instead, it wasn't}
1559 Dec(EndF);
1560
1561 {disallow Dollar if Filler is Zero}
1562 if Filler = Zero then
1563 Dollar := False;
1564
1565 {we need an extra slot if Dollar is True}
1566 Extras := Ord(Dollar);
1567
1568 {get total # of digits and # after the decimal point}
1569 for I := StartF to EndF do
1570 case Result[I] of
1571 '#', '@',
1572 '*', '$' :
1573 begin
1574 Inc(Digits);
1575 if (I > DotPos) and (DotPos <> 0) then
1576 Inc(Places);
1577 end;
1578 end;
1579
1580 {need one more 'digit' if Places > 0}
1581 Inc(Digits, Ord(Places > 0));
1582
1583 {also need an extra blank if (1) Negative is true, and (2) Filler is Blank,
1584 and (3) AddMinus is true}
1585 if Negative and AddMinus and (Filler = Blank) then
1586 Inc(Extras)
1587 else
1588 AddMinus := False;
1589
1590 {translate the real to a string}
1591 Str(R:Digits:Places, S);
1592
1593 {add zeros that Str may have left out}
1594 if Places > MaxPlaces then begin
1595 I := Length(S);
1596 SetLength(S, LongInt(I) + (Places-MaxPlaces));
1597 StUtils.FillWord(S[Succ(I)], Places-MaxPlaces, Word(WideChar('0')));
1598 while (Length(S) > Digits) and (S[1] = ' ') do
1599 System.Delete(S, 1, 1);
1600 end;
1601
1602 {count number of initial blanks}
1603 Blanks := 1;
1604 while S[Blanks] = ' ' do
1605 Inc(Blanks);
1606 FirstDigit := Blanks;
1607 Dec(Blanks);
1608
1609 {the number won't fit if (a) S is longer than Digits or (b) the number of
1610 initial blanks is less than Extras}
1611 WontFit := (Length(S) > Digits) or (Blanks < Extras);
1612
1613 {if it won't fit, fill decimal slots with '*'}
1614 if WontFit then begin
1615 for I := StartF to EndF do
1616 case Result[I] of
1617 '#', '@', '*', '$' : Result[I] := '*';
1618 '+' : Result[I] := PlusArray[Negative];
1619 '-' : Result[I] := MinusArray[Negative];
1620 end;
1621 goto Done;
1622 end;
1623
1624 {fill initial blanks in S with Filler; insert floating dollar sign}
1625 if Blanks > 0 then begin
1626 FillWord(S[1], Blanks, Word(FillArray[Filler]));
1627
1628 {put floating dollar sign in last blank slot if necessary}
1629 if Dollar then begin
1630 S[Blanks] := LtCurr[1];
1631 Dec(Blanks);
1632 end;
1633
1634 {insert a minus sign if necessary}
1635 if AddMinus then
1636 S[Blanks] := '-';
1637 end;
1638
1639 {put in the digits / signs}
1640 DigitPtr := Length(S);
1641 for I := EndF downto StartF do begin
1642 RedoCase:
1643 case Result[I] of
1644 '#', '@', '*', '$' :
1645 if DigitPtr <> 0 then begin
1646 Result[I] := S[DigitPtr];
1647 Dec(DigitPtr);
1648 if (DigitPtr <> 0) and (S[DigitPtr] = '.') then {!!.01}
1649 Dec(DigitPtr);
1650 end
1651 else
1652 Result[I] := FillArray[Filler];
1653 ',' :
1654 begin
1655 Result[I] := Sep;
1656 if (I < DotPos) and (DigitPtr < FirstDigit) then begin
1657 Result[I] := '#';
1658 goto RedoCase;
1659 end;
1660 end;
1661 '.' :
1662 begin
1663 Result[I] := DecPt;
1664 if (I < DotPos) and (DigitPtr < FirstDigit) then begin
1665 Result[I] := '#';
1666 goto RedoCase;
1667 end;
1668 end;
1669 '+' : Result[I] := PlusArray[Negative];
1670 '-' : Result[I] := MinusArray[Negative];
1671 end;
1672 end;
1673
1674 Done:
1675 if AssumeDP then
1676 SetLength(Result, Pred(Length(Result)));
1677 if RtChars > 0 then begin
1678 S := RtCurr;
1679 if Length(S) > RtChars then
1680 SetLength(S, RtChars)
1681 else
1682 S := LeftPadW(S, RtChars);
1683 Result := Result + S;
1684 end;
1685 if LtChars > 0 then begin
1686 S := LtCurr;
1687 if Length(S) > LtChars then
1688 SetLength(S, LtChars)
1689 else
1690 S := PadW(S, LtChars);
1691 Result := S + Result;
1692 end;
1693 end;
1694
1695 function FloatFormW(const Mask : WideString;
1696 R : TstFloat ;
1697 const LtCurr,
1698 RtCurr : WideString;
1699 Sep,
1700 DecPt : WideChar) : WideString;
1701 {-Return a formatted string with digits from R merged into mask.}
1702 begin
1703 Result := FormPrimW(Mask, R, LtCurr, RtCurr, Sep, DecPt, False);
1704 end;
1705
1706 function LongIntFormW(const Mask : WideString;
1707 L : Longint;
1708 const LtCurr,
1709 RtCurr : WideString;
1710 Sep : WideChar) : WideString;
1711 {-Return a formatted string with digits from L merged into mask.}
1712 begin
1713 Result := FormPrimW(Mask, L, LtCurr, RtCurr, Sep, '.', True);
1714 end;
1715
1716 function StrChPosW(const P : WideString; C : WideChar; var Pos : Cardinal) : Boolean;
1717 {-Return the position of a specified character within a string.}
1718 var
1719 i : integer;
1720 begin
1721 Result := true;
1722 for i := 1 to length(P) do
1723 if (P[i] = C) then begin
1724 Pos := i;
1725 Exit;
1726 end;
1727 Result := false;
1728 Pos := 0;
1729 end;
1730
1731 function StrStPosW(const P, S : WideString; var Pos : Cardinal) : Boolean;
1732 {-Return the position of a specified substring within a string.}
1733 begin
1734 Pos := System.Pos(S, P);
1735 Result := Pos <> 0;
1736 end;
1737
1738 function StrStCopyW(const S : WideString; Pos, Count : Cardinal) : WideString;
1739 {-Copy characters at a specified position in a string.}
1740 begin
1741 Result := System.Copy(S, Pos, Count);
1742 end;
1743
1744 function StrChInsertW(const S : WideString; C : WideChar; Pos : Cardinal) : WideString;
1745 {-Insert a character into a string at a specified position.}
1746 var
1747 Temp : WideString;
1748 begin
1749 SetLength(Temp, 1);
1750 Temp[1] := C;
1751 Result := S;
1752 System.Insert(Temp, Result, Pos);
1753 end;
1754
1755 function StrStInsertW(const S1, S2 : WideString; Pos : Cardinal) : WideString;
1756 {-Insert a string into another string at a specified position.}
1757 begin
1758 Result := S1;
1759 System.Insert(S2, Result, Pos);
1760 end;
1761
1762 function StrChDeleteW(const S : WideString; Pos : Cardinal) : WideString;
1763 {-Delete the character at a specified position in a string.}
1764 begin
1765 Result := S;
1766 System.Delete(Result, Pos, 1);
1767 end;
1768
1769 function StrStDeleteW(const S : WideString; Pos, Count : Cardinal) : WideString;
1770 {-Delete characters at a specified position in a string.}
1771 begin
1772 Result := S;
1773 System.Delete(Result, Pos, Count);
1774 end;
1775
1776
1777
1778
1779 function CopyLeftW(const S : WideString; Len : Cardinal) : WideString;
1780 {-Return the left Len characters of a string}
1781 begin
1782 if (Len < 1) or (S = '') then
1783 Result := ''
1784 else
1785 Result := Copy(S, 1, Len);
1786 end;
1787
1788
1789
1790 function CopyMidW(const S : WideString; First, Len : Cardinal) : WideString;
1791 {-Return the mid part of a string}
1792 begin
1793 if (LongInt(First) > Length(S)) or (Len < 1) or (S = '') then
1794 Result := ''
1795 else
1796 Result := Copy(S, First, Len);
1797 end;
1798
1799
1800
1801 function CopyRightW(const S : WideString; First : Cardinal) : WideString;
1802 {-Return the right Len characters of a string}
1803 begin
1804 if (LongInt(First) > Length(S)) or (First < 1) or (S = '') then
1805 Result := ''
1806 else
1807 Result := Copy(S, First, Length(S));
1808 end;
1809
1810
1811 function CopyRightAbsW(const S : WideString; NumChars : Cardinal) : WideString;
1812 {-Return NumChar characters starting from end}
1813 begin
1814 if (Cardinal(Length(S)) > NumChars) then
1815 Result := Copy(S, (Cardinal(Length(S)) - NumChars)+1, NumChars)
1816 else
1817 Result := S;
1818 end;
1819
1820
1821 function WordPosW(const S, WordDelims, AWord : WideString;
1822 N : Cardinal; var Position : Cardinal) : Boolean;
1823 {-returns the Nth instance of a given word within a string}
1824 var
1825 TmpStr : WideString;
1826 Len,
1827 I,
1828 P1,
1829 P2 : Cardinal;
1830 begin
1831 if (S = '') or (AWord = '') or (pos(AWord, S) = 0) then begin
1832 Result := False;
1833 Position := 0;
1834 Exit;
1835 end;
1836
1837 Result := False;
1838 Position := 0;
1839
1840 TmpStr := S;
1841 I := 0;
1842 Len := Length(AWord);
1843 P1 := pos(AWord, TmpStr);
1844
1845 while (P1 > 0) and (Length(TmpStr) > 0) do begin
1846 P2 := P1 + pred(Len);
1847 if (P1 = 1) then begin
1848 if (pos(TmpStr[P2+1], WordDelims) > 0) then begin
1849 Inc(I);
1850 end else
1851 System.Delete(TmpStr, 1, P2);
1852 end else if (pos(TmpStr[P1-1], WordDelims) > 0) and
1853 ((pos(TmpStr[P2+1], WordDelims) > 0) or
1854 (LongInt(P2+1) = Length(TmpStr))) then begin
1855 Inc(I);
1856 end else if ((LongInt(P1) + LongInt(pred(Len))) = Length(TmpStr)) then begin
1857 if (P1 > 1) and (pos(TmpStr[P1-1], WordDelims) > 0) then
1858 Inc(I);
1859 end;
1860
1861 if (I = N) then begin
1862 Result := True;
1863 Position := Position + P1;
1864 Exit;
1865 end;
1866 System.Delete(TmpStr, 1, P2);
1867 Position := Position + P2;
1868 P1 := pos(AWord, TmpStr);
1869 end;
1870 end;
1871
1872
1873
1874
1875 function CopyFromNthWordW(const S, WordDelims : WideString;
1876 AWord : WideString; N : Cardinal;
1877 var SubString : WideString) : Boolean;
1878 var
1879 P : Cardinal;
1880 begin
1881 if (WordPosW(S, WordDelims, AWord, N, P)) then begin
1882 SubString := Copy(S, P, Length(S));
1883 Result := True;
1884 end else begin
1885 SubString := '';
1886 Result := False;
1887 end;
1888 end;
1889
1890
1891
1892 function DeleteFromNthWordW(const S, WordDelims : WideString;
1893 AWord : WideString; N : Cardinal;
1894 var SubString : WideString) : Boolean;
1895 var
1896 P : Cardinal;
1897 begin
1898 SubString := S;
1899 if (WordPosW(S, WordDelims, AWord, N, P)) then begin
1900 Result := True;
1901 SubString := Copy(S, 1, P-1);
1902 end else begin
1903 Result := False;
1904 SubString := '';
1905 end;
1906 end;
1907
1908
1909
1910 function CopyFromToWordW(const S, WordDelims, Word1, Word2 : WideString;
1911 N1, N2 : Cardinal;
1912 var SubString : WideString) : Boolean;
1913 var
1914 P1,
1915 P2 : Cardinal;
1916 begin
1917 if (WordPosW(S, WordDelims, Word1, N1, P1)) then begin
1918 if (WordPosW(S, WordDelims, Word2, N2, P2)) then begin
1919 Dec(P2);
1920 if (P2 > P1) then begin
1921 Result := True;
1922 SubString := Copy(S, P1, P2-P1);
1923 end else begin
1924 Result := False;
1925 SubString := '';
1926 end;
1927 end else begin
1928 Result := False;
1929 SubString := '';
1930 end;
1931 end else begin
1932 Result := False;
1933 SubString := '';
1934 end;
1935 end;
1936
1937
1938
1939 function DeleteFromToWordW(const S, WordDelims, Word1, Word2 : WideString;
1940 N1, N2 : Cardinal;
1941 var SubString : WideString) : Boolean;
1942 var
1943 P1,
1944 P2 : Cardinal;
1945 begin
1946 SubString := S;
1947 if (WordPosW(S, WordDelims, Word1, N1, P1)) then begin
1948 if (WordPosW(S, WordDelims, Word2, N2, P2)) then begin
1949 Dec(P2);
1950 if (P2 > P1) then begin
1951 Result := True;
1952 System.Delete(SubString, P1, P2-P1+1);
1953 end else begin
1954 Result := False;
1955 SubString := '';
1956 end;
1957 end else begin
1958 Result := False;
1959 SubString := '';
1960 end;
1961 end else begin
1962 Result := False;
1963 SubString := '';
1964 end;
1965 end;
1966
1967
1968
1969 function CopyWithinW(const S, Delimiter : WideString;
1970 Strip : Boolean) : WideString;
1971 var
1972 P1,
1973 P2 : Cardinal;
1974 TmpStr : WideString;
1975 begin
1976 if (S = '') or (Delimiter = '') or (pos(Delimiter, S) = 0) then
1977 Result := ''
1978 else begin
1979 if (StrStPosW(S, Delimiter, P1)) then begin
1980 TmpStr := Copy(S, LongInt(P1) + Length(Delimiter), Length(S));
1981 if StrStPosW(TmpStr, Delimiter, P2) then begin
1982 Result := Copy(TmpStr, 1, P2-1);
1983 if (not Strip) then
1984 Result := Delimiter + Result + Delimiter;
1985 end else begin
1986 Result := TmpStr;
1987 if (not Strip) then
1988 Result := Delimiter + Result;
1989 end;
1990 end;
1991 end;
1992 end;
1993
1994
1995
1996 function DeleteWithinW(const S, Delimiter : WideString) : WideString;
1997 var
1998 P1,
1999 P2 : Cardinal;
2000 TmpStr : WideString;
2001 begin
2002 if (S = '') or (Delimiter = '') or (pos(Delimiter, S) = 0) then
2003 Result := ''
2004 else begin
2005 if (StrStPosW(S, Delimiter, P1)) then begin
2006 TmpStr := Copy(S, LongInt(P1) + Length(Delimiter), Length(S));
2007 if (pos(Delimiter, TmpStr) = 0) then
2008 Result := Copy(S, 1, P1-1)
2009 else begin
2010 if (StrStPosW(TmpStr, Delimiter, P2)) then begin
2011 P2 := LongInt(P2) + (2*Length(Delimiter));
2012 Result := S;
2013 System.Delete(Result, P1, P2);
2014 end;
2015 end;
2016 end;
2017 end;
2018 end;
2019
2020
2021
2022 function ReplaceWordW(const S, WordDelims, OldWord, NewWord : WideString;
2023 N : Cardinal;
2024 var Replacements : Cardinal) : WideString;
2025 var
2026 I,
2027 C,
2028 P1 : Cardinal;
2029 begin
2030 if (S = '') or (WordDelims = '') or (OldWord = '') or
2031 (pos(OldWord, S) = 0) then begin
2032 Result := '';
2033 Replacements := 0;
2034 Exit;
2035 end;
2036
2037 if (WordPosW(S, WordDelims, OldWord, N, P1)) then begin
2038 Result := S;
2039 System.Delete(Result, P1, Length(OldWord));
2040
2041 C := 0;
2042 for I := 1 to Replacements do begin
2043 if (((Length(NewWord)) + Length(Result)) < MaxLongInt) then begin
2044 Inc(C);
2045 System.Insert(NewWord, Result, P1);
2046 Inc(P1, Length(NewWord) + 1);
2047 end else begin
2048 Replacements := C;
2049 Exit;
2050 end;
2051 end;
2052 end else begin
2053 Result := S;
2054 Replacements := 0;
2055 end;
2056 end;
2057
2058
2059 function ReplaceWordAllW(const S, WordDelims, OldWord, NewWord : WideString;
2060 var Replacements : Cardinal) : WideString;
2061 var
2062 I,
2063 C,
2064 P1 : Cardinal;
2065 begin
2066 if (S = '') or (WordDelims = '') or (OldWord = '') or
2067 (Pos(OldWord, S) = 0) then begin
2068 Result := S;
2069 Replacements := 0;
2070 end else begin
2071 Result := S;
2072 C := 0;
2073 while (WordPosW(Result, WordDelims, OldWord, 1, P1)) do begin
2074 System.Delete(Result, P1, Length(OldWord));
2075 for I := 1 to Replacements do begin
2076 if ((Length(NewWord) + Length(Result)) <= 255) then begin
2077 Inc(C);
2078 System.Insert(NewWord, Result, P1);
2079 end else begin
2080 Replacements := C;
2081 Exit;
2082 end;
2083 end;
2084 end;
2085 Replacements := C;
2086 end;
2087 end;
2088
2089
2090 function ReplaceStringW(const S, OldString, NewString : WideString;
2091 N : Cardinal;
2092 var Replacements : Cardinal) : WideString;
2093 var
2094 I,
2095 C,
2096 P1 : Cardinal;
2097 TmpStr : WideString;
2098 begin
2099 if (S = '') or (OldString = '') or (pos(OldString, S) = 0) then begin
2100 Result := S;
2101 Replacements := 0;
2102 Exit;
2103 end;
2104 TmpStr := S;
2105
2106 I := 1;
2107 P1 := pos(OldString, TmpStr);
2108 C := P1;
2109 while (I < N) and (LongInt(C) < Length(TmpStr)) do begin
2110 Inc(I);
2111 System.Delete(TmpStr, 1, LongInt(P1) + Length(OldString));
2112 Inc(C, LongInt(P1) + Length(OldString));
2113 end;
2114 Result := S;
2115 System.Delete(Result, C, Length(OldString));
2116
2117 C := 0;
2118 for I := 1 to Replacements do begin
2119 if (((Length(NewString)) + Length(Result)) < MaxLongInt) then begin
2120 Inc(C);
2121 System.Insert(NewString, Result, P1);
2122 Inc(P1, Length(NewString) + 1);
2123 end else begin
2124 Replacements := C;
2125 Exit;
2126 end;
2127 end;
2128 end;
2129
2130
2131 function ReplaceStringAllW(const S, OldString, NewString : WideString;
2132 var Replacements : Cardinal) : WideString;
2133 var
2134 I,
2135 C : Cardinal;
2136 P1 : longint;
2137 Tmp: WideString;
2138 begin
2139 Result := S;
2140 if (S = '') or (OldString = '') or (Pos(OldString, S) = 0) then
2141 Replacements := 0
2142 else begin
2143 Tmp := S;
2144 P1 := AnsiPos(OldString, S);
2145 if (P1 > 0) then begin
2146 Result := Copy(Tmp, 1, P1-1);
2147 C := 0;
2148 while (P1 > 0) do begin
2149 for I := 1 to Replacements do begin
2150 Inc(C);
2151 Result := Result + NewString;
2152 end;
2153 Tmp := Copy(Tmp, P1+Length(OldString), MaxLongInt);
2154 P1 := AnsiPos(OldString, Tmp);
2155 if (P1 > 0) then begin
2156 Result := Result + Copy(Tmp, 1, P1-1);
2157 end else
2158 Result := Result + Tmp;
2159 end;
2160 Replacements := C;
2161 end else begin
2162 Result := S;
2163 Replacements := 0;
2164 end;
2165 end;
2166 end;
2167
2168
2169 function LastWordW(const S, WordDelims, AWord : WideString;
2170 var Position : Cardinal) : Boolean;
2171 var
2172 TmpStr : WideString;
2173 I : Cardinal;
2174 begin
2175 if (S = '') or (WordDelims = '') or
2176 (AWord = '') or (pos(AWord, S) = 0) then begin
2177 Result := False;
2178 Position := 0;
2179 Exit;
2180 end;
2181
2182 TmpStr := S;
2183 I := Length(TmpStr);
2184 while (pos(TmpStr[I], WordDelims) > 0) do begin
2185 System.Delete(TmpStr, I, 1);
2186 I := Length(TmpStr);
2187 end;
2188
2189 Position := Length(TmpStr);
2190 repeat
2191 while (pos(TmpStr[Position], WordDelims) = 0) and (Position > 1) do
2192 Dec(Position);
2193 if (Copy(TmpStr, Position + 1, Length(AWord)) = AWord) then begin
2194 Inc(Position);
2195 Result := True;
2196 Exit;
2197 end;
2198 System.Delete(TmpStr, Position, Length(TmpStr));
2199 Position := Length(TmpStr);
2200 until (Length(TmpStr) = 0);
2201 Result := False;
2202 Position := 0;
2203 end;
2204
2205
2206
2207 function LastWordAbsW(const S, WordDelims : WideString;
2208 var Position : Cardinal) : Boolean;
2209 begin
2210 if (S = '') or (WordDelims = '') then begin
2211 Result := False;
2212 Position := 0;
2213 Exit;
2214 end;
2215
2216 {find first non-delimiter character, if any. If not a "one-word wonder"}
2217 Position := Length(S);
2218 while (Position > 0) and (pos(S[Position], WordDelims) > 0) do
2219 Dec(Position);
2220
2221 if (Position = 0) then begin
2222 Result := True;
2223 Position := 1;
2224 Exit;
2225 end;
2226
2227 {find next delimiter character}
2228 while (Position > 0) and (pos(S[Position], WordDelims) = 0) do
2229 Dec(Position);
2230 Inc(Position);
2231 Result := True;
2232 end;
2233
2234
2235
2236 function LastStringW(const S, AString : WideString;
2237 var Position : Cardinal) : Boolean;
2238 var
2239 TmpStr : WideString;
2240 I, C : Cardinal;
2241 begin
2242 if (S = '') or (AString = '') or (pos(AString, S) = 0) then begin
2243 Result := False;
2244 Position := 0;
2245 Exit;
2246 end;
2247
2248 TmpStr := S;
2249 C := 0;
2250 I := pos(AString, TmpStr);
2251 while (I > 0) do begin
2252 Inc(C, LongInt(I) + Length(AString));
2253 System.Delete(TmpStr, 1, LongInt(I) + Length(AString));
2254 I := pos(AString, TmpStr);
2255 end;
2256 {Go back the length of AString since the while loop deletes the last instance}
2257 Dec(C, Length(AString));
2258 Position := C;
2259 Result := True;
2260 end;
2261
2262
2263
2264 function KeepCharsW(const S, Chars : WideString) : WideString;
2265 var
2266 P1,
2267 P2 : Cardinal;
2268 begin
2269 if (S = '') or (Chars = '') then begin
2270 Result := '';
2271 Exit;
2272 end;
2273
2274 Result := '';
2275 P1 := 1;
2276 P2 := 1;
2277 repeat
2278 while (pos(S[P2], Chars) > 0) and (LongInt(P2) <= Length(S)) do
2279 Inc(P2);
2280 Result := Result + Copy(S, P1, P2-P1);
2281 P1 := P2+1;
2282 P2 := P1;
2283 while (pos(S[P2], Chars) = 0) and (LongInt(P2) <= Length(S)) do
2284 Inc(P2);
2285 P1 := P2;
2286 until (LongInt(P1) > Length(S));
2287 end;
2288
2289
2290
2291 function RepeatStringW(const RepeatString : WideString;
2292 var Repetitions : Cardinal;
2293 MaxLen : Cardinal) : WideString;
2294 var
2295 J,
2296 Len : Cardinal;
2297 begin
2298 Len := Length(RepeatString);
2299 Repetitions := MaxLen div Len;
2300 SetLength(Result, Repetitions * Len);
2301 for J := 0 to pred(Repetitions) do
2302 Move(RepeatString[1], Result[J * Len + 1], Len*SizeOf(WideChar));
2303 end;
2304
2305
2306
2307 function TrimCharsW(const S, Chars : WideString) : WideString;
2308 begin
2309 Result := RightTrimCharsW(S, Chars);
2310 Result := LeftTrimCharsW(Result, Chars);
2311 end;
2312
2313
2314
2315 function RightTrimCharsW(const S, Chars : WideString) : WideString;
2316 begin
2317 Result := S;
2318 while (pos(Result[Length(Result)], Chars) > 0) do
2319 System.Delete(Result, Length(Result), 1);
2320 end;
2321
2322
2323
2324 function LeftTrimCharsW(const S, Chars : WideString) : WideString;
2325 begin
2326 Result := S;
2327 while (pos(Result[1], Chars) > 0) do
2328 System.Delete(Result, 1, 1);
2329 end;
2330
2331
2332
2333 function ExtractTokensW(const S, Delims : WideString;
2334 QuoteChar : WideChar;
2335 AllowNulls : Boolean;
2336 Tokens : TStrings) : Cardinal;
2337 var
2338 State : (ScanStart,
2339 ScanQuotedToken,
2340 ScanQuotedTokenEnd,
2341 ScanNormalToken,
2342 ScanNormalTokenWithQuote);
2343 CurChar : WideChar;
2344 TokenStart : integer;
2345 Inx : integer;
2346 begin
2347 {Notes: this routine implements the following state machine
2348 start ----> ScanStart
2349 ScanStart-----quote----->ScanQuotedToken
2350 ScanStart-----delim----->ScanStart (1)
2351 ScanStart-----other----->ScanNormalToken
2352 ScanQuotedToken-----quote----->ScanQuotedTokenEnd
2353 ScanQuotedToken-----other----->ScanQuotedToken
2354 ScanQuotedTokenEnd-----quote----->ScanNormalTokenWithQuote
2355 ScanQuotedTokenEnd-----delim----->ScanStart (2)
2356 ScanQuotedTokenEnd-----other----->ScanNormalToken
2357 ScanNormalToken-----quote----->ScanNormalTokenWithQuote
2358 ScanNormalToken-----delim----->ScanStart (3)
2359 ScanNormalToken-----other----->ScanNormalToken
2360 ScanNormalTokenWithQuote-----quote----->ScanNormalTokenWithQuote
2361 ScanNormalTokenWithQuote-----other----->ScanNormalToken
2362
2363 (1) output a null token if allowed
2364 (2) output a token, stripping quotes (if the dequoted token is
2365 empty, output a null token if allowed)
2366 (3) output a token; no quote stripping
2367
2368 If the quote character is #0, it's taken to mean that the routine
2369 should not check for quoted substrings.}
2370
2371 {clear the tokens string list, set the return value to zero}
2372 Tokens.Clear;
2373 Result := 0;
2374
2375 {if the input string is empty or the delimiter list is empty or
2376 the quote character is found in the delimiter list, return zero
2377 tokens found}
2378 if (S = '') or
2379 (Delims = '') or
2380 CharExistsW(Delims, QuoteChar) then
2381 Exit;
2382
2383 {start off in the normal scanning state}
2384 State := ScanStart;
2385
2386 {the first token starts at position 1}
2387 TokenStart := 1;
2388
2389 {read through the entire string}
2390 for Inx := 1 to length(S) do begin
2391
2392 {get the current character}
2393 CurChar := S[Inx];
2394
2395 {process the character according to the current state}
2396 case State of
2397 ScanStart :
2398 begin
2399 {if the current char is the quote character, switch states}
2400 if (QuoteChar <> #0) and (CurChar = QuoteChar) then
2401 State := ScanQuotedToken
2402
2403 {if the current char is a delimiter, output a null token}
2404 else if CharExistsW(Delims, CurChar) then begin
2405
2406 {if allowed to, output a null token}
2407 if AllowNulls then begin
2408 Tokens.Add('');
2409 inc(Result);
2410 end;
2411
2412 {set the start of the next token to be one character after
2413 this delimiter}
2414 TokenStart := succ(Inx);
2415 end
2416
2417 {otherwise, the current char is starting a normal token, so
2418 switch states}
2419 else
2420 State := ScanNormalToken
2421 end;
2422
2423 ScanQuotedToken :
2424 begin
2425 {if the current char is the quote character, switch states}
2426 if (CurChar = QuoteChar) then
2427 State := ScanQuotedTokenEnd
2428 end;
2429
2430 ScanQuotedTokenEnd :
2431 begin
2432 {if the current char is the quote character, we have a token
2433 consisting of two (or more) quoted substrings, so switch
2434 states}
2435 if (CurChar = QuoteChar) then
2436 State := ScanNormalTokenWithQuote
2437
2438 {if the current char is a delimiter, output the token
2439 without the quotes}
2440 else if CharExistsW(Delims, CurChar) then begin
2441
2442 {if the token is empty without the quotes, output a null
2443 token only if allowed to}
2444 if ((Inx - TokenStart) = 2) then begin
2445 if AllowNulls then begin
2446 Tokens.Add('');
2447 inc(Result);
2448 end
2449 end
2450
2451 {else output the token without the quotes}
2452 else begin
2453 Tokens.Add(Copy(S, succ(TokenStart), Inx - TokenStart - 2));
2454 inc(Result);
2455 end;
2456
2457 {set the start of the next token to be one character after
2458 this delimiter}
2459 TokenStart := succ(Inx);
2460
2461 {switch states back to the start state}
2462 State := ScanStart;
2463 end
2464
2465 {otherwise it's a (complex) normal token, so switch states}
2466 else
2467 State := ScanNormalToken
2468 end;
2469
2470 ScanNormalToken :
2471 begin
2472 {if the current char is the quote character, we have a
2473 complex token with at least one quoted substring, so switch
2474 states}
2475 if (QuoteChar <> #0) and (CurChar = QuoteChar) then
2476 State := ScanNormalTokenWithQuote
2477
2478 {if the current char is a delimiter, output the token}
2479 else if CharExistsW(Delims, CurChar) then begin
2480 Tokens.Add(Copy(S, TokenStart, Inx - TokenStart));
2481 inc(Result);
2482
2483 {set the start of the next token to be one character after
2484 this delimiter}
2485 TokenStart := succ(Inx);
2486
2487 {switch states back to the start state}
2488 State := ScanStart;
2489 end;
2490 end;
2491
2492 ScanNormalTokenWithQuote :
2493 begin
2494 {if the current char is the quote character, switch states
2495 back to scanning a normal token}
2496 if (CurChar = QuoteChar) then
2497 State := ScanNormalToken;
2498 end;
2499
2500 end;
2501 end;
2502
2503 {we need to process the (possible) final token: first assume that
2504 the current character index is just beyond the end of the string}
2505 Inx := succ(length(S));
2506
2507 {if we are in the scanning quoted token state, we've read an opening
2508 quote, but no closing one; increment the token start value}
2509 if (State = ScanQuotedToken) then
2510 inc(TokenStart)
2511
2512 {if we've finished scanning a quoted token, we've read both quotes;
2513 increment the token start value, and decrement the current index}
2514 else if (State = ScanQuotedTokenEnd) then begin
2515 inc(TokenStart);
2516 dec(Inx);
2517 end;
2518
2519 {if the final token is not empty, output the token}
2520 if (TokenStart < Inx) then begin
2521 Tokens.Add(Copy(S, TokenStart, Inx - TokenStart));
2522 inc(Result);
2523 end
2524 {otherwise the final token is empty, so output a null token if
2525 allowed to}
2526 else if AllowNulls then begin
2527 Tokens.Add('');
2528 inc(Result);
2529 end;
2530 end;
2531
2532
2533
2534 function ContainsOnlyW(const S, Chars : WideString;
2535 var BadPos : Cardinal) : Boolean;
2536 var
2537 I : Cardinal;
2538 begin
2539 if (S = '') then begin
2540 Result := False;
2541 BadPos := 0;
2542 end else begin
2543 for I := 1 to Length(S) do begin
2544 if (not CharExistsW(Chars, S[I])) then begin
2545 BadPos := I;
2546 Result := False;
2547 Exit;
2548 end;
2549 end;
2550 Result := True;
2551 BadPos := 0;
2552 end;
2553 end;
2554
2555
2556
2557 function ContainsOtherThanW(const S, Chars : WideString;
2558 var BadPos : Cardinal) : Boolean;
2559 var
2560 I : Cardinal;
2561 begin
2562 if (S = '') then begin
2563 Result := False;
2564 BadPos := 0;
2565 end else begin
2566 for I := 1 to Length(S) do begin
2567 if (CharExistsW(Chars, S[I])) then begin
2568 BadPos := I;
2569 Result := True;
2570 Exit;
2571 end;
2572 end;
2573 Result := False;
2574 BadPos := 0;
2575 end;
2576 end;
2577
2578
2579
2580 function IsChAlphaW(C : WideChar) : Boolean;
2581 {-Returns true if Ch is an alpha}
2582 begin
2583 Result := Windows.IsCharAlphaW(C);
2584 end;
2585
2586
2587
2588 function IsChNumericW(C : WideChar; Numbers : WideString) : Boolean;
2589 {-Returns true if Ch in numeric set}
2590 begin
2591 Result := pos(C, Numbers) > 0;
2592 end;
2593
2594
2595
2596 function IsChAlphaNumericW(C : WideChar; Numbers : WideString) : Boolean;
2597 {-Returns true if Ch is an alpha or numeric}
2598 begin
2599 Result := (Windows.IsCharAlphaW(C)) or (pos(C, Numbers) > 0);
2600 end;
2601
2602
2603
2604 function IsStrAlphaW(const S : WideString) : Boolean;
2605 {-Returns true if all characters in string are an alpha}
2606 var
2607 I : Cardinal;
2608 begin
2609 if (S = '') then
2610 Result := False
2611 else begin
2612 for I := 1 to Length(S) do begin
2613 Result := Windows.IsCharAlphaW(S[I]);
2614 if not Result then
2615 Exit;
2616 end;
2617 Result := True;
2618 end;
2619 end;
2620
2621
2622
2623 function IsStrNumericW(const S, Numbers : WideString) : Boolean;
2624 {-Returns true if all characters in string are in numeric set}
2625 var
2626 I : Cardinal;
2627 begin
2628 if (S = '') then
2629 Result := False
2630 else begin
2631 for I := 1 to Length(S) do begin
2632 Result := pos(S[I], Numbers) > 0;
2633 if not Result then
2634 Exit;
2635 end;
2636 Result := True;
2637 end;
2638 end;
2639
2640
2641 function IsStrAlphaNumericW(const S, Numbers : WideString) : Boolean;
2642 {-Returns true if all characters in string are alpha or numeric}
2643 var
2644 I : Cardinal;
2645 begin
2646 if (S = '') then
2647 Result := False
2648 else begin
2649 for I := 1 to Length(S) do begin
2650 Result := (Windows.IsCharAlphaW(S[I])) or (pos(S[I], Numbers) > 0);
2651 if not Result then
2652 Exit;
2653 end;
2654 Result := True;
2655 end;
2656 end;
2657
2658 function StrWithinW(const S, SearchStr : WideString;
2659 Start : Cardinal;
2660 var Position : Cardinal) : boolean;
2661 var
2662 TmpStr : WideString;
2663 begin
2664 TmpStr := S;
2665 if (Start > 1) then
2666 System.Delete(TmpStr, 1, Start-1);
2667 Position := pos(SearchStr, TmpStr);
2668 if (Position > 0) then begin
2669 Position := Position + Start - 1;
2670 Result := True;
2671 end else
2672 Result := False;
2673 end;
2674
2675 end.

  ViewVC Help
Powered by ViewVC 1.1.20