source: branches/2.20_branch/Library/StringUtilsUnit.pas

Last change on this file was 357, checked in by RBRi, 16 years ago

copyright fix

  • Property svn:eol-style set to native
File size: 28.1 KB
Line 
1Unit StringUtilsUnit;
2
3// NewView - a new OS/2 Help Viewer
4// Copyright 2003-2006 Aaron Lawrence
5// Copyright 2006-2009 Ronald Brill (rbri at rbri dot de)
6// This software is released under the GNU Public License - see readme.txt
7
8// Helper functions to work with String and AnsiString
9
10Interface
11
12uses
13 Classes,
14 CharUtilsUnit;
15
16const
17 StrTAB = CharTAB;
18 StrCR = CharCR;
19 StrLF = CharLF;
20 StrCRLF = StrCR + StrLF;
21 StrSingleQuote = CharSingleQuote;
22 StrDoubleQuote = CharDoubleQuote;
23
24
25 TYPE
26 TSerializableStringList = class
27 private
28 stringList : TStringList;
29
30 public
31 CONSTRUCTOR Create;
32 DESTRUCTOR Destroy; override;
33 FUNCTION getCount : LongInt;
34 PROCEDURE add(const aString : String);
35 FUNCTION get(const anIndex : LongInt) : String;
36 FUNCTION getSerializedString : String;
37 PROCEDURE readValuesFromSerializedString(const aSerializedString : String);
38 end;
39
40 // prefixes all occurences of one of the chars in aStringWithChars with anEscape char
41 // if the escapeChar itself is found, then it is doubled
42 Function StrEscapeAllCharsBy(const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String;
43
44 // Extract all fields in a String given a set of delimiter characters and
45 // an optional escape character usable to escape field delimits.
46 // Example:
47 // StrExtractStrings('1x2x3\x4', 'x', '\') ->
48 // returns 4 strings: '1', '', '2' and '3x4'
49 Procedure StrExtractStrings(var aResult : TStrings; const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
50
51 // same as StrExtractStrings but ignores empty strings
52 Procedure StrExtractStringsIgnoreEmpty(var aResult : TStrings; const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
53
54 // removes all occurences of char from aSetOfChars from the beginning
55 // of a String.
56 Function StrTrimLeftChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
57
58 // removes all occurences of char from aSetOfChars from the end
59 // of a String.
60 Function StrTrimRightChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
61
62 // removes all occurences of char from aSetOfChars from the beginning
63 // end the end of a String.
64 Function StrTrimChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
65
66 // removes all blanks from beginning and end
67 Function StrTrim(const aReceiver: String): String;
68
69 // Returns the aCount leftmost chars of aString
70 Function StrLeft(const aString : String; const aCount : Integer) : String;
71
72 // Returns a copy of the string without aCount chars from right
73 Function StrLeftWithout(const aString : String; const aCount : Integer) : String;
74
75 // Returns a copy of the string including all characters until one from aSetOfChars found
76 Function StrLeftUntil(const aReceiver: String; const aSetOfChars: TSetOfChars) : String;
77
78 // Returns a copy of the string starting at aPos
79 Function StrSubstringFrom(const aReceiver: String; const aPos : Integer) : String;
80
81 // returns true if the String starts with the provided one
82 // this is case SENSITIVE
83 Function StrStartsWith(const aReceiver: String; const aStartString: String): Boolean;
84
85 // returns true if the String starts with the provided one
86 // this is case INsensitive
87 Function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String): Boolean;
88
89 // returns true if the String ends with the provides one
90 // this is case SENSITIVE
91 Function StrEndsWith(const aReceiver: String; const anEndString: String): Boolean;
92
93 // returns true if the String ends with the provided one
94 // this is case INsensitive
95 Function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean;
96
97 // Returns true if aReceiver is only spaces (or empty)
98 Function StrIsEmptyOrSpaces(const aReceiver: String) : Boolean;
99
100 // returns true if the Strings are the same
101 // this is case INsensitive
102 Function StrEqualIgnoringCase(const aReceiver: String; const aSecondString: String): Boolean;
103
104 // the IntToStr generates wrong results
105 // in normal cases IntToStr returns a negative value
106 // and somtimes completly wrong values
107 Function LongWordToStr(const aLongWord: LongWord) : String;
108
109 Function BoolToStr(const aBoolean : Boolean ): String;
110
111 // Converts a hex string to a longint
112 // May be upper or lower case
113 // Does not allow a sign
114 // Is not forgiving as StrToInt: all characters
115 // must be valid hex chars.
116 Function HexStrToLongInt(const aString : String ): longint;
117
118 // Returns aString enclosed in single quotes
119 Function StrInSingleQuotes(const aString : String) : String;
120
121 // Returns aString enclosed in double quotes
122 Function StrInDoubleQuotes(const aString : String) : String;
123
124 // Extract all fields in a String delimited by whitespace (blank or tab).
125 // use double quotes if you need blanks in the strings
126 Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String);
127
128 // returns the position of aPart in aString
129 // case insensitive
130 Function CaseInsensitivePos(const aPart: String; const aString: String) : longint;
131
132 // Finds the last position of aChar within aString. Returns zero if no match
133 Function LastPosOfChar(const aChar: char; const aString: String) : longint;
134
135
136 // Substitutes all occurences of given character with the replace char
137 Procedure SubstituteAllOccurencesOfChar(var aReceiver: String; const aSearchChar: Char; const aReplaceChar: Char);
138
139
140 // --------------------
141 // ---- AnsiString ----
142 // --------------------
143
144
145 // removes all occurences of char from aSetOfChars from the beginning
146 // of a String.
147 Function AnsiStrTrimLeftChars(const aReceiver: AnsiString; const aSetOfChars: TSetOfChars): AnsiString;
148
149 // removes all occurences of char from aSetOfChars from the end
150 // of a String.
151 Function AnsiStrTrimRightChars(const aReceiver: AnsiString; const aSetOfChars: TSetOfChars): AnsiString;
152
153 // removes all occurences of char from aSetOfChars from the beginning
154 // end the end of a String.
155 Function AnsiStrTrimChars(const aReceiver: AnsiString; const aSetOfChars: TSetOfChars): AnsiString;
156
157 // removes all blanks from beginning and end
158 Function AnsiStrTrim(const aReceiver: AnsiString): AnsiString;
159
160
161 // --------------------
162 // ---- Misc TODO ----
163 // --------------------
164
165 Procedure GetMemString(const aPointer : pointer; var aString: string; const aSize: byte);
166
167 Procedure FreePString(var aPString: PString );
168
169 Function NewPString(const aString : String) : PString;
170
171
172Implementation
173
174 uses
175 SysUtils,
176 DebugUnit,
177 ACLUtility; // TODO
178
179 constructor TSerializableStringList.Create;
180 begin
181 LogEvent(LogObjConstDest, 'TSerializableStringList createdestroy');
182
183 inherited Create;
184 stringList := TStringList.Create;
185 end;
186
187
188 destructor TSerializableStringList.Destroy;
189 begin
190 LogEvent(LogObjConstDest, 'TSerializableStringList destroy');
191 if Nil <> stringList then stringList.Destroy;
192
193 inherited Destroy;
194 end;
195
196
197 FUNCTION TSerializableStringList.getCount : LongInt;
198 begin
199 result := stringList.count;
200 end;
201
202
203 PROCEDURE TSerializableStringList.add(const aString : String);
204 begin
205 stringList.add(aString);
206 end;
207
208 FUNCTION TSerializableStringList.get(const anIndex : LongInt) : String;
209 begin
210 result := stringList[anIndex];
211 end;
212
213 FUNCTION TSerializableStringList.getSerializedString : String;
214 Var
215 i : Integer;
216 begin
217 result := '';
218 for i := 0 to stringList.count-1 do
219 begin
220 if (i > 0) then result := result + '&';
221 result := result + StrEscapeAllCharsBy(stringList[i], ['&'], '\');
222 end;
223 end;
224
225
226 PROCEDURE TSerializableStringList.readValuesFromSerializedString(const aSerializedString : String);
227 Begin
228 if (length(aSerializedString) < 1) then exit;
229
230 LogEvent(LogObjConstDest, 'readValuesFromSerializedString');
231 stringList.Destroy;
232 LogEvent(LogObjConstDest, 'readValuesFromSerializedString destroy done');
233 stringList := TStringList.Create;
234 StrExtractStrings(stringList, aSerializedString, ['&'], '\');
235 end;
236
237
238 // ----------------------------------------------------------
239
240
241 Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String;
242 Var
243 i : Integer;
244 tmpChar : Char;
245 Begin
246 Result := '';
247
248 for i := 1 To length(aReceiver) do
249 begin
250 tmpChar := aReceiver[i];
251
252 if (tmpChar = anEscapeChar) or (tmpChar IN aSetOfChars) then
253 result := result + anEscapeChar + tmpChar
254 else
255 result := result + tmpChar;
256 end;
257 end;
258
259
260 Procedure PrivateStrExtractStrings( Var aResult: TStrings;
261 const aReceiver: String;
262 const aSetOfChars: TSetOfChars;
263 const anEscapeChar: char;
264 const anIgnoreEmptyFlag : boolean);
265 Var
266 i : Integer;
267 tmpChar,tmpNextChar : Char;
268 tmpPart: String;
269 Begin
270 if (length(aReceiver) < 1) then exit;
271
272 tmpPart := '';
273
274 i := 1;
275 while i <= length(aReceiver) do
276 begin
277 tmpChar := aReceiver[i];
278 if i < length(aReceiver) then
279 tmpNextChar := aReceiver[i+1]
280 else
281 tmpNextChar := #0;
282
283 if (tmpChar = anEscapeChar) and (tmpNextChar = anEscapeChar) then
284 begin
285 tmpPart := tmpPart + anEscapeChar;
286 i := i + 2;
287 end
288 else
289 if (tmpChar = anEscapeChar) and (tmpNextChar IN aSetOfChars) then
290 begin
291 tmpPart := tmpPart + tmpNextChar;
292 i := i + 2;
293 end
294 else
295 if (tmpChar IN aSetOfChars) then
296 begin
297 if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
298 begin
299 aResult.add(tmpPart);
300 end;
301 tmpPart := '';
302 i := i + 1;
303 end
304 else
305 begin
306 tmpPart := tmpPart + tmpChar;
307 i := i + 1;
308 end;
309 end;
310
311 if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
312 begin
313 aResult.add(tmpPart);
314 end;
315 end;
316
317
318 Procedure StrExtractStrings(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
319 Begin
320 PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, false);
321 end;
322
323
324 Procedure StrExtractStringsIgnoreEmpty(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
325 Begin
326 PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, true);
327 end;
328
329
330 Function StrTrimLeftChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
331 Var
332 tmpLength : integer;
333 i : integer;
334 Begin
335 tmpLength := Length(aReceiver);
336
337 if 1 > tmpLength then
338 begin
339 result := aReceiver;
340 exit;
341 end;
342
343 i := 1;
344 // mem optimization
345 if aReceiver[i] in aSetOfChars then
346 begin
347 while i <= tmpLength do
348 begin
349 if aReceiver[i] in aSetOfChars then
350 inc(i)
351 else
352 break;
353 end;
354 result := Copy(aReceiver, i, Length(aReceiver)-i+1);
355 end
356 else
357 begin
358 result := aReceiver;
359 end;
360 end;
361
362
363 Function StrTrimRightChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
364 Var
365 i : integer;
366 Begin
367 i := Length(aReceiver);
368
369 if 1 > i then
370 begin
371 result := aReceiver;
372 exit;
373 end;
374
375 // mem optimization
376 if aReceiver[i] in aSetOfChars then
377 begin
378 while i > 0 do
379 begin
380 if aReceiver[i] in aSetOfChars then
381 dec(i)
382 else
383 break;
384 end;
385 result := Copy(aReceiver, 1, i);
386 end
387 else
388 begin
389 result := aReceiver;
390 end;
391 end;
392
393
394 Function StrTrimChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
395 Var
396 i,j : integer;
397 tmpNeedCopy : boolean;
398 Begin
399 j := Length(aReceiver);
400
401 if 1 > j then
402 begin
403 result := aReceiver;
404 exit;
405 end;
406
407 tmpNeedCopy := false;
408 i := 1;
409 while i < j do
410 begin
411 if aReceiver[i] in aSetOfChars then
412 begin
413 inc(i);
414 tmpNeedCopy := true;
415 end
416 else
417 begin
418 break;
419 end;
420 end;
421
422 while j >= i do
423 begin
424 if aReceiver[j] in aSetOfChars then
425 begin
426 dec(j);
427 tmpNeedCopy := true;
428 end
429 else
430 begin
431 break;
432 end;
433 end;
434
435 if tmpNeedCopy then
436 begin
437 result := Copy(aReceiver, i, j-i+1);
438 end
439 else
440 begin
441 result := aReceiver;
442 end;
443 end;
444
445
446 Function StrTrim(const aReceiver: String): String;
447 Begin
448 result := StrTrimChars(aReceiver, [' ']);
449 end;
450
451
452 Function StrLeft(const aString : String; const aCount : Integer) : String;
453 Begin
454 if aCount >= Length(aString) then
455 Result := aString
456 else
457 Result := copy(aString, 1, aCount);
458 end;
459
460
461 Function StrLeftWithout(const aString : String; const aCount : Integer) : String;
462 Begin
463 Result:= copy(aString, 1, length(aString) - aCount );
464 End;
465
466
467 Function StrLeftUntil(const aReceiver: String; const aSetOfChars: TSetOfChars) : String;
468 Var
469 i : integer;
470 Begin
471 Result := aReceiver;
472
473 for i := 1 To Length(aReceiver) do
474 begin
475 if aReceiver[i] in aSetOfChars then
476 begin
477 Result := Copy(aReceiver, 1, i-1 );
478 break;
479 end;
480 end;
481 end;
482
483
484 Function StrSubstringFrom(const aReceiver: String; const aPos : Integer) : String;
485 Begin
486 Result := copy(aReceiver, aPos, length(aReceiver) - aPos + 1);
487 end;
488
489
490 Function StrStartsWith(const aReceiver: String; const aStartString: String) : Boolean;
491 Var
492 tmpStringPos : integer;
493 tmpStartStringLength : integer;
494 Begin
495 tmpStartStringLength := Length(aStartString);
496
497 if Length(aReceiver) < tmpStartStringLength then
498 begin
499 result := false;
500 exit;
501 end;
502
503 for tmpStringPos := 1 to tmpStartStringLength do
504 begin
505 if aReceiver[tmpStringPos] <> aStartString[tmpStringPos] then
506 begin
507 result := false;
508 exit;
509 end;
510 end;
511
512 result := true;
513 end;
514
515
516 Function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String) : Boolean;
517 Var
518 tmpStringPos : integer;
519 tmpStartStringLength : integer;
520 Begin
521 tmpStartStringLength := Length(aStartString);
522
523 if Length(aReceiver) < tmpStartStringLength then
524 begin
525 result := false;
526 exit;
527 end;
528
529 for tmpStringPos := 1 to tmpStartStringLength do
530 begin
531 if UpCase(aReceiver[tmpStringPos]) <> UpCase(aStartString[tmpStringPos]) then
532 begin
533 result := false;
534 exit;
535 end;
536 end;
537
538 result := true;
539 end;
540
541
542 Function StrEndsWith(const aReceiver: String; const anEndString: String): Boolean;
543 Var
544 tmpStringPos : Longint;
545 tmpMatchPos : Longint;
546 Begin
547 tmpStringPos := length(aReceiver);
548 tmpMatchPos := length(anEndString);
549
550 if tmpMatchPos > tmpStringPos then
551 begin
552 result := false;
553 exit;
554 end;
555
556 while tmpMatchPos > 0 do
557 begin
558 if aReceiver[tmpStringPos] <> anEndString[tmpMatchPos] then
559 begin
560 result := false;
561 exit;
562 end;
563 dec(tmpMatchPos);
564 dec(tmpStringPos);
565 end;
566
567 result := true;
568 end;
569
570
571 Function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean;
572 Var
573 tmpStringPos : Longint;
574 tmpMatchPos : Longint;
575 Begin
576 tmpStringPos := length(aReceiver);
577 tmpMatchPos := length(anEndString);
578
579 if tmpMatchPos > tmpStringPos then
580 begin
581 result := false;
582 exit;
583 end;
584
585 while tmpMatchPos > 0 do
586 begin
587 if upcase(aReceiver[tmpStringPos]) <> upcase(anEndString[tmpMatchPos]) then
588 begin
589 result := false;
590 exit;
591 end;
592 dec(tmpMatchPos);
593 dec(tmpStringPos);
594 end;
595
596 result := true;
597 end;
598
599
600 Function StrIsEmptyOrSpaces(const aReceiver: String) : Boolean;
601 Begin
602 Asm
603 MOV ESI, aReceiver // get address of aReceiver into ESI
604 MOV CL,[ESI] // get length of s
605 MOVZX ECX, CL // widen CL
606 INC ECX
607
608 !IsSpacesLoop:
609 INC ESI // move to next char
610 DEC ECX
611 JE !IsSpacesTrue
612
613 MOV AL,[ESI] // load character
614 CMP AL,32 // is it a space?
615 JE !IsSpacesLoop // yes, go to next
616
617 // no, return false
618 MOV EAX, 0
619 JMP !IsSpacesDone
620
621 !IsSpacesTrue:
622 MOV EAX, 1
623
624 !IsSpacesDone:
625 LEAVE
626 RETN32 4
627 End;
628 End;
629
630
631 Function StrEqualIgnoringCase(const aReceiver: String; const aSecondString: String): Boolean;
632 begin
633 Result := CompareText(aReceiver, aSecondString) = 0;
634 end;
635
636
637 Function LongWordToStr(const aLongWord: LongWord) : String;
638 Var
639 l : LongWord;
640 i : Integer;
641 Begin
642 Result := '';
643 l := aLongWord;
644
645 if l = 0 then
646 begin
647 result := '0';
648 exit;
649 end;
650
651 while l > 0 do
652 begin
653 i := l mod 10;
654 l := l div 10;
655 Case i of
656 0 : result := '0' + result;
657 1 : result := '1' + result;
658 2 : result := '2' + result;
659 3 : result := '3' + result;
660 4 : result := '4' + result;
661 5 : result := '5' + result;
662 6 : result := '6' + result;
663 7 : result := '7' + result;
664 8 : result := '8' + result;
665 9 : result := '9' + result;
666 end;
667 end;
668
669 end;
670
671
672 Function BoolToStr(const aBoolean : boolean ): string;
673 begin
674 if aBoolean then
675 Result := 'True'
676 else
677 Result := 'False';
678 end;
679
680
681// Hex conversion: sheer extravagance. Conversion from
682// a hex digit char to int is done by creating a lookup table
683// in advance.
684var
685 MapHexDigitToInt: array[Chr(0) .. Chr(255)] of longint;
686
687 procedure InitHexDigitMap;
688 var
689 tmpChar : char;
690 tmpIntValue : longint;
691 begin
692 for tmpChar := Chr(0) to Chr(255) do
693 begin
694 tmpIntValue := -1;
695 if ( tmpChar >= '0') and (tmpChar <= '9') then
696 begin
697 tmpIntValue := Ord(tmpChar) - Ord('0');
698 end;
699
700 if ( Upcase(tmpChar) >= 'A') and (Upcase(tmpChar) <= 'F') then
701 begin
702 tmpIntValue := 10 + Ord(Upcase(tmpChar)) - Ord('A');
703 end;
704
705 MapHexDigitToInt[tmpChar] := tmpIntValue;
706 end;
707 end;
708
709
710 Function HexDigitToInt(const aString : String; const aPosition : integer) : longint;
711 begin
712 Result := MapHexDigitToInt[aString[aPosition]];
713 if Result = -1 then
714 begin
715 raise EConvertError.Create('Invalid hex char: ''' + aString[aPosition] + ''' in hex string ''' + aString +'''.' );
716 end
717 end;
718
719
720 Function HexStrToLongInt(const aString : String) : longint;
721 var
722 i: integer;
723 begin
724 if Length(aString) = 0 then
725 begin
726 raise EConvertError.Create('No chars in hex string');
727 end;
728
729 Result := 0;
730 for i:= 1 to Length(aString) do
731 begin
732 Result := Result shl 4;
733 inc(Result, HexDigitToInt(aString, i));
734 end;
735 end;
736
737 Function StrInSingleQuotes(const aString : String) : String;
738 begin
739 Result := StrSingleQuote + aString + StrSingleQuote;
740 end;
741
742
743 Function StrInDoubleQuotes(const aString : String) : String;
744 begin
745 Result := StrDoubleQuote + aString + StrDoubleQuote;
746 end;
747
748
749 Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String);
750 Var
751 tmpState : (WHITESPACE, INSIDE, START_QUOTE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE);
752 tmpCurrentParsePosition : Integer;
753 tmpCurrentChar : Char;
754 tmpPart : String;
755
756 Begin
757 if (length(aReceiver) < 1) then exit;
758
759 tmpState := WHITESPACE;
760 tmpPart := '';
761
762 tmpCurrentParsePosition := 1;
763
764 for tmpCurrentParsePosition:=1 to length(aReceiver) do
765 begin
766 tmpCurrentChar := aReceiver[tmpCurrentParsePosition];
767
768 Case tmpCurrentChar of
769 ' ', StrTAB :
770 begin
771
772 Case tmpState of
773
774 WHITESPACE :
775 begin
776 // nothing
777 end;
778
779 INSIDE :
780 begin
781 aResult.add(tmpPart);
782 tmpPart := '';
783 tmpState := WHITESPACE;
784 end;
785
786 INSIDE_QUOTED :
787 begin
788 tmpPart := tmpPart + tmpCurrentChar;
789 end;
790
791 START_QUOTE :
792 begin
793 tmpPart := tmpPart + tmpCurrentChar;
794 tmpState := INSIDE_QUOTED;
795 end;
796
797 INSIDE_QUOTED_START_QUOTE :
798 begin
799 aResult.add(tmpPart);
800 tmpPart := '';
801 tmpState := WHITESPACE;
802 end;
803 end;
804 end;
805
806 StrDoubleQuote :
807 begin
808
809 Case tmpState of
810
811 WHITESPACE :
812 begin
813 tmpState := START_QUOTE;
814 end;
815
816 INSIDE :
817 begin
818 aResult.add(tmpPart);
819 tmpPart := '';
820 tmpState := START_QUOTE;
821 end;
822
823 INSIDE_QUOTED :
824 begin
825 tmpState := INSIDE_QUOTED_START_QUOTE;
826 end;
827
828 START_QUOTE :
829 begin
830 tmpState := INSIDE_QUOTED_START_QUOTE;
831 end;
832
833 INSIDE_QUOTED_START_QUOTE :
834 begin
835 tmpPart := tmpPart + tmpCurrentChar;
836 tmpState := INSIDE_QUOTED;
837 end;
838 end;
839 end;
840
841 else
842 begin
843 Case tmpState of
844
845 WHITESPACE :
846 begin
847 tmpPart := tmpPart + tmpCurrentChar;
848 tmpState := INSIDE;
849 end;
850
851 INSIDE, INSIDE_QUOTED :
852 begin
853 tmpPart := tmpPart + tmpCurrentChar;
854 end;
855
856 START_QUOTE :
857 begin
858 tmpPart := tmpPart + tmpCurrentChar;
859 tmpState := INSIDE_QUOTED;
860 end;
861
862 INSIDE_QUOTED_START_QUOTE :
863 begin
864 aResult.add(tmpPart);
865 tmpPart := tmpCurrentChar;
866 tmpState := INSIDE;
867 end;
868 end;
869 end;
870
871 end;
872 end;
873
874 Case tmpState of
875 WHITESPACE, START_QUOTE : {nothing to do};
876
877 INSIDE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE :
878 begin
879 aResult.add(tmpPart);
880 end;
881 end;
882 end;
883
884
885 Function CaseInsensitivePos(const aPart: String; const aString: String) : longint;
886 Var
887 EndOfPart: longword;
888 Begin
889 // Result := Pos(UpperCase(aPart), Uppercase(aString));
890
891 // Aarons assembler version :-)
892 Asm
893 //Locals:
894 //a at [EBP+12]
895 //b at [EBP+8]
896
897 // First get and check lengths
898 MOV ESI, aPart // get address of aPart into ESI
899 MOV CL, [ESI] // get length of aPart
900 CMP CL, 0 // if aPart is empty then return null to simulate the behavior of POS
901 JE !CIP_NoMatch
902
903 MOV EDI, aString // get address of aString into EDI
904 MOV DL, [EDI] // get length of aString
905 CMP CL, DL
906 JBE !CIP_PartFitsInString
907
908 // aParta longer than aString so aPart can't be in aString
909
910 !CIP_NoMatch:
911 MOV EAX, 0
912 LEAVE
913 RETN32 8
914
915 !CIP_PartFitsInString:
916 INC ESI // skip length byte in aPart
917 INC EDI // skip length byte of aString
918
919 // get ending address of b into EDX
920 MOVZX EDX, DL // widen DL
921 ADD EDX, EDI // add start of aString
922
923 // get ending address of a into EndOfA
924 MOVZX ECX, CL // widen CL
925 ADD ECX, ESI // add start of aPart
926 MOV EndOfPart, ECX // store to EndOfPart
927
928 MOV ECX, EDI // set start of current match to start of b
929
930 // ESI: current search point in a
931 // EDI: current search point in b
932 // EDX: end of b
933 // ECX: start of current match
934 // available: eax, ebx
935
936 JMP !CIP_Loop
937
938 !CIP_LoopStart:
939 CMP EDI, EDX
940 JE !CIP_NoMatch // run out of b
941
942 MOV AL, [ESI] // get next char of a
943 INC ESI // next in a
944
945 MOV BL, [EDI] // get next char of b
946 INC EDI // next in b
947
948 // Convert chars to uppercase
949 CMP AL, 97
950 JB !CIP_Upcase1
951 CMP AL, 122
952 JA !CIP_Upcase1
953 SUB AL, 32 // convert lower to upper
954 !CIP_Upcase1:
955
956 CMP BL,97
957 JB !CIP_Upcase2
958 CMP BL,122
959 JA !CIP_Upcase2
960 SUB BL,32 // convert lower to upper
961 !CIP_Upcase2:
962
963 // Compare uppercased chars
964 CMP AL,BL
965 JE !CIP_Loop
966
967 // different.
968
969 // Back to start of match + 1
970 INC ECX // inc start of match
971 MOV EDI, ECX // back to start of match in b
972 MOV ESI, aPart // back to start of aPart
973 INC ESI // skip length
974 JMP !CIP_LoopStart
975
976 !CIP_Loop:
977
978 // same
979 CMP ESI, EndOfPart // have we reached the end of a
980 JB !CIP_LoopStart
981
982 // Match, return position
983 SUB ECX, [EBP+8] // position = ( start of match ) - ( start of b ) + 1
984 MOV EAX, ECX
985 LEAVE
986 RETN32 8
987 end;
988 end;
989
990
991 Function LastPosOfChar(const aChar: char; const aString: String): longint;
992 Var
993 tmpPos : longint;
994 begin
995 tmpPos := Length(aString);
996 while tmpPos > 0 do
997 begin
998 if aString[tmpPos] = aChar then
999 begin
1000 Result := tmpPos;
1001 exit;
1002 end;
1003 dec(tmpPos);
1004 end;
1005 Result := 0;
1006 end;
1007
1008
1009 Procedure SubstituteAllOccurencesOfChar(var aReceiver: String; const aSearchChar: Char; const aReplaceChar: Char );
1010 var
1011 i : longint;
1012 begin
1013 for i :=1 to length(aReceiver) do
1014 begin
1015 if aReceiver[i] = aSearchChar then
1016 begin
1017 aReceiver[i] := aReplaceChar;
1018 end
1019 end
1020 end;
1021
1022
1023 // --------------------
1024 // ---- AnsiString ----
1025 // --------------------
1026
1027
1028 Function AnsiStrTrimLeftChars(const aReceiver: AnsiString; const aSetOfChars: TSetOfChars): AnsiString;
1029 Var
1030 tmpLength : integer;
1031 i : integer;
1032 Begin
1033 tmpLength := Length(aReceiver);
1034
1035 if 1 > tmpLength then
1036 begin
1037 result := aReceiver;
1038 exit;
1039 end;
1040
1041 i := 1;
1042 // mem optimization
1043 if aReceiver[i] in aSetOfChars then
1044 begin
1045 while i <= tmpLength do
1046 begin
1047 if aReceiver[i] in aSetOfChars then
1048 inc(i)
1049 else
1050 break;
1051 end;
1052 result := AnsiCopy(aReceiver, i, Length(aReceiver)-i+1);
1053 end
1054 else
1055 begin
1056 result := aReceiver;
1057 end;
1058 end;
1059
1060
1061 Function AnsiStrTrimRightChars(const aReceiver: AnsiString; const aSetOfChars: TSetOfChars): AnsiString;
1062 Var
1063 i : integer;
1064 Begin
1065 i := Length(aReceiver);
1066
1067 if 1 > i then
1068 begin
1069 result := aReceiver;
1070 exit;
1071 end;
1072
1073 // mem optimization
1074 if aReceiver[i] in aSetOfChars then
1075 begin
1076 while i > 0 do
1077 begin
1078 if aReceiver[i] in aSetOfChars then
1079 dec(i)
1080 else
1081 break;
1082 end;
1083 result := AnsiCopy(aReceiver, 1, i);
1084 end
1085 else
1086 begin
1087 result := aReceiver;
1088 end;
1089 end;
1090
1091
1092 Function AnsiStrTrimChars(const aReceiver: AnsiString; const aSetOfChars: TSetOfChars): AnsiString;
1093 Var
1094 i,j : integer;
1095 tmpNeedCopy : boolean;
1096 Begin
1097 tmpNeedCopy := false;
1098
1099 j := Length(aReceiver);
1100
1101 if 1 > j then
1102 begin
1103 result := aReceiver;
1104 exit;
1105 end;
1106
1107 i := 1;
1108 while i < j do
1109 begin
1110 if aReceiver[i] in aSetOfChars then
1111 begin
1112 inc(i);
1113 tmpNeedCopy := true;
1114 end
1115 else
1116 begin
1117 break;
1118 end;
1119 end;
1120
1121 while j >= i do
1122 begin
1123 if aReceiver[j] in aSetOfChars then
1124 begin
1125 dec(j);
1126 tmpNeedCopy := true;
1127 end
1128 else
1129 begin
1130 break;
1131 end;
1132 end;
1133
1134 if tmpNeedCopy then
1135 begin
1136 result := AnsiCopy(aReceiver, i, j-i+1);
1137 end
1138 else
1139 begin
1140 result := aReceiver;
1141 end;
1142 end;
1143
1144
1145 Function AnsiStrTrim(const aReceiver: AnsiString): AnsiString;
1146 Begin
1147 result := AnsiStrTrimChars(aReceiver, [' ']);
1148 end;
1149
1150
1151 // --------------------
1152 // ---- Misc TODO ----
1153 // --------------------
1154
1155 Procedure GetMemString(const aPointer : pointer; var aString: string; const aSize: byte);
1156 begin
1157 aString[0] := char(aSize);
1158 MemCopy(aPointer, Addr(aString[1]), aSize);
1159 end;
1160
1161
1162 Procedure FreePString(var aPString : PString );
1163 begin
1164 if aPString = nil then
1165 begin
1166 exit;
1167 end;
1168
1169 FreeMem(aPString, Length(aPString^) + 1);
1170 aPString := nil;
1171 end;
1172
1173
1174 Function NewPString(const aString : String) : PString;
1175 begin
1176 GetMem(Result, Length(aString) + 1);
1177 Result^ := aString;
1178 end;
1179
1180
1181Initialization
1182 InitHexDigitMap;
1183End.
Note: See TracBrowser for help on using the repository browser.