source: trunk/Library/StringUtilsUnit.pas@ 198

Last change on this file since 198 was 198, checked in by RBRi, 18 years ago

another update

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