source: trunk/NewView/StringUtilsUnit.pas@ 106

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

more methods
  • Property svn:eol-style set to native
File size: 17.2 KB
RevLine 
[35]1Unit StringUtilsUnit;
2
3// NewView - a new OS/2 Help Viewer
[75]4// Copyright 2006-2007 Ronald Brill (rbri at rbri dot de)
5// This software is released under the GNU Public License - see readme.txt
[35]6
7// Helper functions to work with strings
8
9Interface
10
11uses
12 Classes;
13
[43]14const
[105]15 StrTAB = chr(9);
[43]16 StrCR = chr(13);
17 StrLF = chr(10);
18 StrCRLF = StrCR + StrLF;
[106]19 StrSingleQuote = '''';
20 StrDoubleQuote = '"';
[43]21
22
23 TYPE
[35]24 TSerializableStringList = class
25 private
26 stringList : TStringList;
27
28 public
29 CONSTRUCTOR Create;
30 DESTRUCTOR Destroy; override;
31 FUNCTION getCount : LongInt;
32 PROCEDURE add(const aString : String);
33 FUNCTION get(const anIndex : LongInt) : String;
34 FUNCTION getSerializedString : String;
35 PROCEDURE readValuesFromSerializedString(const aSerializedString : String);
36 end;
37
[43]38 TYPE
39 TSetOfChars = set of char;
40
[35]41 // prefices all occurences of one of the chars in aStringWithChars with anEscape char
42 // if the escapeChar itself is found, then it is doubled
[43]43 Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String;
[35]44
[43]45 // Extract all fields in a String given a set of delimiter characters and
46 // an optional escape character usable to escape field delimits.
47 // Example:
[102]48 // StrExtractStrings('1x2x3\x4', 'x', '\') ->
49 // returns 4 strings: '1', '', '2' and '3x4'
[82]50 Procedure StrExtractStrings(Var aResult : TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
[43]51
[82]52 // same as StrExtractStrings but ignores empty strings
53 Procedure StrExtractStringsIgnoreEmpty(Var aResult : TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
54
[43]55 // removes all occurences of char from aSetOfChars from the beginning
[82]56 // of a String.
57 Function StrTrimLeftChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
58
59 // removes all occurences of char from aSetOfChars from the end
60 // of a String.
61 Function StrTrimRightChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
62
63 // removes all occurences of char from aSetOfChars from the beginning
[43]64 // end the end of a String.
65 Function StrTrimChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
66
67 // removes all blanks from beginning and end
68 Function StrTrim(const aReceiver: String): String;
69
[82]70 // Returns the aCount leftmost chars of aString
71 Function StrLeft(const aString : String; const aCount : Integer) : String;
72
[102]73 // Returns a copy of the string without aCount chars from right
74 Function StrLeftWithout(const aString : String; const aCount : Integer) : String;
75
76 // Returns a copy of the string including all characters until one from aSetOfChars found
77 Function StrLeftUntil(const aReceiver: String; const aSetOfChars: TSetOfChars) : String;
78
[105]79 // returns true if the String starts with the provided one
[102]80 // this is case SENSITIVE
81 Function StrStartsWith(const aReceiver: String; const aStartString: String): Boolean;
82
[105]83 // returns true if the String starts with the provided one
[102]84 // this is case INsensitive
85 Function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String): Boolean;
86
[43]87 // returns true if the String ends with the provides one
88 // this is case SENSITIVE
89 Function StrEndsWith(const aReceiver: String; const anEndString: String): Boolean;
90
[105]91 // returns true if the String ends with the provided one
[43]92 // this is case INsensitive
[102]93 Function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean;
[43]94
[105]95 // returns true if the Strings are the same
96 // this is case INsensitive
97 Function StrEqualIgnoringCase(const aReceiver: String; const aSecondString: String): Boolean;
98
[68]99 // the IntToStr generates wrong results
100 // in normal cases IntToStr returns a negative value
101 // and somtimes completly wrong values
102 Function LongWordToStr(const aLongWord: LongWord) : String;
103
[65]104 Function BoolToStr(const aBoolean : boolean ): string;
[43]105
[102]106 // Returns aString enclosed in double quotes
107 Function StrInDoubleQuotes(const aString : String) : String;
[65]108
[106]109 // Extract all fields in a String delimited by whitespace (blank or tab).
110 // use double quotes if you need blanks in the strings
111 Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String );
[102]112
[35]113Implementation
114
[65]115 uses
[105]116 SysUtils,
[65]117 DebugUnit;
118
[35]119 constructor TSerializableStringList.Create;
120 begin
[65]121 LogEvent(LogObjConstDest, 'TSerializableStringList createdestroy');
122
[35]123 inherited Create;
124 stringList := TStringList.Create;
125 end;
126
127
128 destructor TSerializableStringList.Destroy;
129 begin
[65]130 LogEvent(LogObjConstDest, 'TSerializableStringList destroy');
131 if Nil <> stringList then stringList.Destroy;
132
[35]133 inherited Destroy;
134 end;
135
136
137 FUNCTION TSerializableStringList.getCount : LongInt;
138 begin
139 result := stringList.count;
140 end;
141
142
143 PROCEDURE TSerializableStringList.add(const aString : String);
144 begin
145 stringList.add(aString);
146 end;
147
148 FUNCTION TSerializableStringList.get(const anIndex : LongInt) : String;
149 begin
150 result := stringList[anIndex];
151 end;
152
153 FUNCTION TSerializableStringList.getSerializedString : String;
154 Var
155 i : Integer;
156 begin
157 result := '';
[82]158 for i := 0 to stringList.count-1 do
[35]159 begin
160 if (i > 0) then result := result + '&';
[43]161 result := result + StrEscapeAllCharsBy(stringList[i], ['&'], '\');
[35]162 end;
163 end;
164
165
166 PROCEDURE TSerializableStringList.readValuesFromSerializedString(const aSerializedString : String);
[43]167 Begin
168 if (length(aSerializedString) < 1) then exit;
169
[65]170 LogEvent(LogObjConstDest, 'readValuesFromSerializedString');
171 stringList.Destroy;
172 LogEvent(LogObjConstDest, 'readValuesFromSerializedString destroy done');
[43]173 stringList := TStringList.Create;
174 StrExtractStrings(stringList, aSerializedString, ['&'], '\');
175 end;
176
177
178 // ----------------------------------------------------------
179
180
181 Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String;
[35]182 Var
183 i : Integer;
[43]184 tmpChar : Char;
185 Begin
186 Result := '';
187
188 for i := 1 To length(aReceiver) do
189 begin
190 tmpChar := aReceiver[i];
191
192 if (tmpChar = anEscapeChar) or (tmpChar IN aSetOfChars) then
193 result := result + anEscapeChar + tmpChar
194 else
195 result := result + tmpChar;
196 end;
197 end;
198
199
[82]200 Procedure PrivateStrExtractStrings( Var aResult: TStrings;
201 const aReceiver: String;
202 const aSetOfChars: TSetOfChars;
203 const anEscapeChar: char;
204 const anIgnoreEmptyFlag : boolean);
[43]205 Var
206 i : Integer;
[35]207 tmpChar,tmpNextChar : Char;
208 tmpPart: String;
[43]209 Begin
210 if (length(aReceiver) < 1) then exit;
[35]211
212 tmpPart := '';
213
214 i := 1;
[43]215 while i <= length(aReceiver) do
[35]216 begin
[43]217 tmpChar := aReceiver[i];
218 if i < length(aReceiver) then
219 tmpNextChar := aReceiver[i+1]
[35]220 else
221 tmpNextChar := #0;
222
[43]223 if (tmpChar = anEscapeChar) and (tmpNextChar = anEscapeChar) then
[35]224 begin
[43]225 tmpPart := tmpPart + anEscapeChar;
[35]226 i := i + 2;
227 end
228 else
[43]229 if (tmpChar = anEscapeChar) and (tmpNextChar IN aSetOfChars) then
[35]230 begin
[43]231 tmpPart := tmpPart + tmpNextChar;
[35]232 i := i + 2;
233 end
234 else
[43]235 if (tmpChar IN aSetOfChars) then
[35]236 begin
[82]237 if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
238 begin
239 aResult.add(tmpPart);
240 end;
[35]241 tmpPart := '';
242 i := i + 1;
243 end
244 else
245 begin
246 tmpPart := tmpPart + tmpChar;
247 i := i + 1;
248 end;
249 end;
[82]250
251 if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then
252 begin
253 aResult.add(tmpPart);
254 end;
[35]255 end;
256
257
[82]258 Procedure StrExtractStrings(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
259 Begin
260 PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, false);
261 end;
262
263
264 Procedure StrExtractStringsIgnoreEmpty(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char);
265 Begin
266 PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, true);
267 end;
268
269
270 Function StrTrimLeftChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
271 Var
272 i : Longint;
273 Begin
274 i := 1;
275 // mem optimization
276 if aReceiver[i] in aSetOfChars then
277 begin
278 while i <= Length(aReceiver) do
279 begin
280 if aReceiver[i] in aSetOfChars then
281 inc(i)
282 else
283 break;
284 end;
285 result := Copy(aReceiver, i, Length(aReceiver)-i+1);
286 end
287 else
288 begin
289 result := aReceiver;
290 end;
291 end;
292
293
294 Function StrTrimRightChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
295 Var
296 i : Longint;
297 Begin
298 i := Length(aReceiver);
299
300 // mem optimization
301 if aReceiver[i] in aSetOfChars then
302 begin
303 while i > 0 do
304 begin
305 if aReceiver[i] in aSetOfChars then
306 dec(i)
307 else
308 break;
309 end;
310 result := Copy(aReceiver, 1, i);
311 end
312 else
313 begin
314 result := aReceiver;
315 end;
316 end;
317
318
[43]319 Function StrTrimChars(const aReceiver: String; const aSetOfChars: TSetOfChars): String;
[35]320 Var
[43]321 i : Longint;
322 j : Longint;
[82]323 tmpNeedCopy : boolean;
[35]324 Begin
[82]325 tmpNeedCopy := false;
[43]326 i := 1;
327 while i < Length(aReceiver) do
328 begin
329 if aReceiver[i] in aSetOfChars then
[82]330 begin
331 inc(i);
332 tmpNeedCopy := true;
333 end
334 else
335 begin
336 break;
337 end;
[43]338 end;
[35]339
[43]340 j := Length(aReceiver);
341 while j >= i do
[35]342 begin
[43]343 if aReceiver[j] in aSetOfChars then
[82]344 begin
345 dec(j);
346 tmpNeedCopy := true;
347 end
[43]348 else
[82]349 begin
[43]350 break;
[82]351 end;
[43]352 end;
353
[82]354 if tmpNeedCopy then
355 begin
356 result := Copy(aReceiver, i, j-i+1);
357 end
358 else
359 begin
360 result := aReceiver;
361 end;
[43]362 end;
363
364
365 Function StrTrim(const aReceiver: String): String;
366 Begin
367 result := StrTrimChars(aReceiver, [' ']);
368 end;
369
370
[82]371 Function StrLeft(const aString : String; const aCount : Integer) : String;
372 Begin
373 if aCount >= Length(aString) then
374 Result := aString
375 else
376 Result := copy(aString, 1, aCount);
377 end;
378
379
[102]380 Function StrLeftWithout(const aString : String; const aCount : Integer) : String;
381 Begin
382 Result:= copy(aString, 1, length(aString) - aCount );
383 End;
384
385
386 Function StrLeftUntil(const aReceiver: String; const aSetOfChars: TSetOfChars) : String;
387 Var
388 i : integer;
389 Begin
390 Result := aReceiver;
391
392 for i := 1 To Length(aReceiver) do
393 begin
394 if aReceiver[i] in aSetOfChars then
395 begin
396 Result := Copy(aReceiver, 1, i-1 );
397 break;
398 end;
399 end;
400 end;
401
402
403 Function StrStartsWith(const aReceiver: String; const aStartString: String) : Boolean;
404 Var
405 tmpStringPos : integer;
406 tmpStartStringLength : integer;
407 Begin
408 tmpStartStringLength := Length(aStartString);
409
410 if Length(aReceiver) < tmpStartStringLength then
411 begin
412 result := false;
413 exit;
414 end;
415
416 for tmpStringPos := 1 to tmpStartStringLength do
417 begin
418 if aReceiver[tmpStringPos] <> aStartString[tmpStringPos] then
419 begin
420 result := false;
421 exit;
422 end;
423 end;
424
425 result := true;
426 end;
427
428
429 Function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String) : Boolean;
430 Var
431 tmpStringPos : integer;
432 tmpStartStringLength : integer;
433 Begin
434 tmpStartStringLength := Length(aStartString);
435
436 if Length(aReceiver) < tmpStartStringLength then
437 begin
438 result := false;
439 exit;
440 end;
441
442 for tmpStringPos := 1 to tmpStartStringLength do
443 begin
444 if UpCase(aReceiver[tmpStringPos]) <> UpCase(aStartString[tmpStringPos]) then
445 begin
446 result := false;
447 exit;
448 end;
449 end;
450
451 result := true;
452 end;
453
454
[43]455 Function StrEndsWith(const aReceiver: String; const anEndString: String): Boolean;
456 Var
457 tmpStringPos : Longint;
458 tmpMatchPos : Longint;
459 Begin
460 tmpStringPos := length(aReceiver);
461 tmpMatchPos := length(anEndString);
462
463 if tmpMatchPos > tmpStringPos then
464 begin
465 result := false;
466 exit;
467 end;
468
469 while tmpMatchPos > 0 do
470 begin
471 if aReceiver[tmpStringPos] <> anEndString[tmpMatchPos] then
[35]472 begin
[43]473 result := false;
474 exit;
475 end;
476 dec(tmpMatchPos);
477 dec(tmpStringPos);
478 end;
[35]479
[43]480 result := true;
481 end;
482
483
484 Function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean;
485 Var
486 tmpStringPos : Longint;
487 tmpMatchPos : Longint;
488 Begin
[102]489 tmpStringPos := length(aReceiver);
[43]490 tmpMatchPos := length(anEndString);
491
492 if tmpMatchPos > tmpStringPos then
493 begin
494 result := false;
495 exit;
496 end;
497
498 while tmpMatchPos > 0 do
499 begin
[102]500 if upcase(aReceiver[tmpStringPos]) <> upcase(anEndString[tmpMatchPos]) then
[43]501 begin
502 result := false;
503 exit;
[35]504 end;
[43]505 dec(tmpMatchPos);
506 dec(tmpStringPos);
[35]507 end;
[43]508
509 result := true;
[35]510 end;
511
[102]512
[105]513 Function StrEqualIgnoringCase(const aReceiver: String; const aSecondString: String): Boolean;
514 begin
515 Result := CompareText(aReceiver, aSecondString) = 0;
516 end;
517
518
[68]519 Function LongWordToStr(const aLongWord: LongWord) : String;
520 Var
521 l : LongWord;
522 i : Integer;
523 Begin
524 Result := '';
525 l := aLongWord;
526
527 if l = 0 then
528 begin
529 result := '0';
530 exit;
531 end;
532
533 while l > 0 do
534 begin
535 i := l mod 10;
536 l := l div 10;
537 Case i of
538 0 : result := '0' + result;
539 1 : result := '1' + result;
540 2 : result := '2' + result;
541 3 : result := '3' + result;
542 4 : result := '4' + result;
543 5 : result := '5' + result;
544 6 : result := '6' + result;
545 7 : result := '7' + result;
546 8 : result := '8' + result;
547 9 : result := '9' + result;
548 end;
549 end;
550
551 end;
552
553
[65]554 Function BoolToStr(const aBoolean : boolean ): string;
555 begin
556 if aBoolean then
557 Result := 'True'
558 else
559 Result := 'False';
560 end;
561
[106]562
[102]563 Function StrInDoubleQuotes(const aString : String) : String;
564 begin
[106]565 Result := StrDoubleQuote + aString + StrDoubleQuote;
[102]566 end;
567
568
[106]569 Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String );
570 Var
571 tmpState : (WHITESPACE, INSIDE, START_QUOTE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE);
572 tmpCurrentParsePosition : Integer;
573 tmpCurrentChar : Char;
574 tmpPart : String;
575
576 Begin
577 if (length(aReceiver) < 1) then exit;
578
579 tmpState := WHITESPACE;
580 tmpPart := '';
581
582 tmpCurrentParsePosition := 1;
583
584 for tmpCurrentParsePosition:=1 to length(aReceiver) do
585 begin
586 tmpCurrentChar := aReceiver[tmpCurrentParsePosition];
587
588 Case tmpCurrentChar of
589 ' ', StrTAB :
590 begin
591
592 Case tmpState of
593
594 WHITESPACE :
595 begin
596 // nothing
597 end;
598
599 INSIDE :
600 begin
601 aResult.add(tmpPart);
602 tmpPart := '';
603 tmpState := WHITESPACE;
604 end;
605
606 INSIDE_QUOTED :
607 begin
608 tmpPart := tmpPart + tmpCurrentChar;
609 end;
610
611 START_QUOTE :
612 begin
613 tmpPart := tmpPart + tmpCurrentChar;
614 tmpState := INSIDE_QUOTED;
615 end;
616
617 INSIDE_QUOTED_START_QUOTE :
618 begin
619 aResult.add(tmpPart);
620 tmpPart := '';
621 tmpState := WHITESPACE;
622 end;
623 end;
624 end;
625
626 StrDoubleQuote :
627 begin
628
629 Case tmpState of
630
631 WHITESPACE :
632 begin
633 tmpState := START_QUOTE;
634 end;
635
636 INSIDE :
637 begin
638 aResult.add(tmpPart);
639 tmpPart := '';
640 tmpState := START_QUOTE;
641 end;
642
643 INSIDE_QUOTED :
644 begin
645 tmpState := INSIDE_QUOTED_START_QUOTE;
646 end;
647
648 START_QUOTE :
649 begin
650 tmpState := INSIDE_QUOTED_START_QUOTE;
651 end;
652
653 INSIDE_QUOTED_START_QUOTE :
654 begin
655 tmpPart := tmpPart + tmpCurrentChar;
656 tmpState := INSIDE_QUOTED;
657 end;
658 end;
659 end;
660
661 else
662 begin
663 Case tmpState of
664
665 WHITESPACE :
666 begin
667 tmpPart := tmpPart + tmpCurrentChar;
668 tmpState := INSIDE;
669 end;
670
671 INSIDE, INSIDE_QUOTED :
672 begin
673 tmpPart := tmpPart + tmpCurrentChar;
674 end;
675
676 START_QUOTE :
677 begin
678 tmpPart := tmpPart + tmpCurrentChar;
679 tmpState := INSIDE_QUOTED;
680 end;
681
682 INSIDE_QUOTED_START_QUOTE :
683 begin
684 aResult.add(tmpPart);
685 tmpPart := tmpCurrentChar;
686 tmpState := INSIDE;
687 end;
688 end;
689 end;
690
691 end;
692 end;
693
694 Case tmpState of
695 WHITESPACE, START_QUOTE : {nothing to do};
696
697 INSIDE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE :
698 begin
699 aResult.add(tmpPart);
700 end;
701 end;
702 end;
[35]703END.
Note: See TracBrowser for help on using the repository browser.