source: trunk/Library/ACLStringUtility.pas@ 204

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

small format fix

  • Property svn:eol-style set to native
File size: 33.2 KB
Line 
1Unit ACLStringUtility;
2
3Interface
4
5Uses
6 Classes;
7
8const
9 EndLine= chr(13)+chr(10);
10 TwoEndLines= chr(13)+chr(10)+chr(13)+chr(10);
11 Quote = '''';
12 DoubleQuote = '"';
13
14// ----------- Character testing functions -----------------------
15
16type
17 TCharMatchFunction = function( const a: char ): boolean;
18
19// Returns true if c is a digit 0..9
20Function IsDigit( const c: char ): boolean;
21
22// Returns true if c is not a digit
23Function IsNonDigit( const c: char ): boolean;
24
25// Returns true if c is an alphabetic character a..z A..Z
26Function IsAlpha( const c: char ): boolean;
27
28// Returns true if s is only spaces (or empty)
29Function IsSpaces( const s: string ): boolean;
30
31// ---------------------- Numeric conversions ---------------------------------------
32
33// Converts a hex string to a longint
34// May be upper or lower case
35// Does not allow a sign
36// Is not forgiving as StrToInt: all characters
37// must be valid hex chars.
38function HexToInt( s: string ): longint;
39
40// Given a string with a number on the end, increments that
41// number by one.
42// If there is no number it adds a one.
43// If the number is left zero padded then the result is similarly
44// padded
45Function IncrementNumberedString( StartString: string ): string;
46
47// ---------------------- Pascal String Utilities ---------------------------------------
48
49{$ifdef os2}
50Function CaseInsensitivePos( const a: string;
51 const b: string ): longint;
52{$else}
53Function CaseInsensitivePos( const a: string;
54 const b: string ): longint;
55{$endif}
56
57// Looks for occurrences of QuoteChar and inserts a duplicate
58Function InsertDuplicateChars( const S: string;
59 const QuoteChar: char ): string;
60
61// Returns index of SubString in S, case-insensitve
62Function FindSubstring( const SubString: string;
63 const S: string ): integer;
64
65// Returns characters at the front of S that match according
66// to a given function... for example, IsDigit, IsNonDigit, IsAlpha
67Function MatchLeadingChars(
68 const S: string;
69 MatchFunction: TCharMatchFunction ): string;
70
71// Same as MatchLeadingChars, but removes the matching chars from S
72Function ExtractLeadingChars(
73 Var S: string;
74 MatchFunction: TCharMatchFunction ): string;
75
76// Case insensitive compare
77Function StringsSame( const a, b: string ): boolean;
78
79// Quoting
80
81// Note: these functions do not check for existing quotes within
82// the string, they only add or delete characters at the end.
83
84// Returns S in single quotes
85Function StrQuote( const s: string ): string;
86
87// Returns S without single quotes
88Function StrUnQuote( const s: string ): string;
89
90// Returns S in double quotes
91Function StrDoubleQuote( const s: string ): string;
92
93// Returns S in double quotes,
94// with any double quotes in S duplicated
95Function StrFullDoubleQuote( const s: string ): string;
96
97// Returns S without double quotes
98Function StrUnDoubleQuote( const s: string ): string;
99
100//
101
102// Substitutes given character
103Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
104
105// Returns the count rightmost chars of S
106Function StrRight( const S:string; const count:integer ):string;
107
108// Returns the remainder of S starting at start
109Function StrRightFrom( const S:string; const start:integer ):string;
110
111// Returns the count leftmost chars of S
112Function StrLeft( const S:string; const count:integer ):string;
113
114// Returns S minus count characters from the right
115Function StrLeftWithout( const S:string; const count:integer ):string;
116
117// Returns S with leftCount chars removed from the left and
118// rightCount chars removed from the right.
119Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
120
121// Produces a string from n padded on the left with 0's
122// to width chars
123Function StrLeft0Pad( const n: integer; const width: integer ): string;
124
125// Returns true if s starts with start (case insensitive)
126Function StrStarts( const start: string; const s: string ): boolean;
127
128// Returns true if s ends with endstr (case insensitive)
129Function StrEnds( const endStr: string; const s: string ): boolean;
130
131// Returns first word from S
132Function StrFirstWord( const S: String ): string;
133
134// Finds the last position of C within s. Returns zero if no match
135function FindCharFromEnd( const s: string;
136 const c: char ): longint;
137
138// ------------ PString (pointer to Pascal string) utilities ------
139
140{$ifdef os2}
141procedure GetMemString( p: pointer;
142 Var s: string;
143 Size: byte );
144
145function NewPStringLen( const Length: longint ): PString;
146
147function NewPString( const s: string ): PString;
148
149procedure FreePString( Var ps: PString );
150{$endif}
151
152// ------------ Seperated value utilities ---------------------
153
154// Returns the next item starting at Index. Spaces are the separator,
155// unless the item is quoted with QuoteChar, in which case it looks for
156// a closing quote. Occurrences of the QuoteChar in the item itself,
157// can be escaped with a duplicate, e.g. "He said ""bok"""
158Procedure GetNextQuotedValue(
159 const S: string;
160 var Index: longint;
161 var Value: string;
162 const QuoteChar: char );
163
164procedure GetNextValue(
165 const S: String;
166 var Index: longint;
167 var Value: string;
168 const Seperator: char );
169
170// Removes and returns the first value in a separated
171// value list (removes quotes if found)
172Function ExtractNextValue(
173 var S: string;
174 const Separator: string ): string;
175
176Function ExtractNextValueNoTrim(
177 var S: string;
178 const Separator: string ): string;
179
180
181// Parses a line of the form
182// key = value into it's components
183Procedure ParseConfigLine( const S: string;
184 var KeyName: string;
185 var KeyValue: string );
186
187// Removes spaces around the separator in the given string
188Procedure RemoveSeparatorSpaces( var S: string;
189 const Separator:string );
190
191{$ifdef os2}
192// ------------ Ansi String utilities ------------------------
193
194// Right & left trim that works with AnsiStrings.
195Function AnsiTrim( const S: AnsiString ): AnsiString;
196
197Procedure AnsiParseConfigLine( const S: Ansistring;
198 var keyName: Ansistring;
199 var keyValue: Ansistring );
200
201Function AnsiExtractNextValue( var CSVString: AnsiString;
202 const Separator: AnsiString ): AnsiString;
203
204{$endif}
205
206// ------------- Lists of strings, and strings as lists -----------
207
208// Adds NewValue to S as a separated list
209Procedure AddToListString( Var S: string;
210 const NewValue: string;
211 const Separator: string );
212
213Function ListToString( List: TStrings;
214 const Separator: string ): string;
215
216procedure StringToList( S: String;
217 List: TStrings;
218 const Separator: string );
219
220// Reverse the given list. It must be set to not sorted
221Procedure ReverseList( TheList: TStrings );
222
223// Sort the given list into reverse alphabetical order
224//Procedure ReverseSortList( TheList: TStringList );
225
226// Find the given string in the given list, using
227// case insensitive searching (and trimming)
228// returns -1 if not found
229Function FindStringInList( const TheString: string;
230 TheList:TStrings ):longint;
231
232Procedure MergeStringLists( Dest: TStringList;
233 AdditionalList: TStringList );
234
235// ---------------------- PCHAR Utilities ---------------------------------------
236
237function StrNPas( const ps: PChar; const Length: integer ): String;
238
239// Returns a - b
240Function PCharDiff( const a: PChar; const b: Pchar ): longword;
241
242// trims spaces and carriage returns of the end of Text
243procedure TrimWhitespace( Text: PChar );
244
245type
246 TSetOfChars = set of char;
247
248function TrimChars( const s: string;
249 chars: TSetOfChars ): string;
250
251// Concatenates a pascal string onto a PCHar string
252// Resizes if needed
253procedure StrPCat( Var Dest: PChar;
254 const StringToAdd: string );
255
256// Trim endlines (#10 or #13) off the end of
257// the given string.
258Procedure TrimEndLines( const S: PChar );
259
260// Allocates enough memory for a copy of s as a PChar
261// and copies s to it.
262Function StrDupPas( const s: string ): PChar;
263
264// Returns a copy of the first n chars of s
265Function StrNDup( const s: PChar; const n: integer ): PChar;
266
267// Returns a copy of the first line starting at lineStart
268Function CopyFirstLine( const lineStart: PChar ): PChar;
269
270// Returns next line p points to
271Function NextLine( const p: PChar): PChar;
272
273// Concatentate AddText to Text. Reallocate and expand
274// Text if necessary. This is a size-safe StrCat
275Procedure AddAndResize( Var Text: PChar;
276 const AddText: PChar );
277
278// Copy Source to Dest. Reallocate and expand
279// Dest if necessary. This is a size-safe StrCopy
280Procedure StrCopyAndResize( Var Dest: PChar;
281 const Source: PChar );
282
283// Return "True" or "False"
284Function BoolToStr( const b: boolean ): string;
285
286
287Implementation
288
289Uses
290 SysUtils,
291 ACLUtility;
292
293// ---------------------- Pascal String Utilities ---------------------------------------
294
295Procedure SkipChar( const S: string;
296 Var index: longint;
297 const C: Char );
298begin
299 while Index <= Length( S ) do
300 begin
301 if S[ Index ] <> C then
302 break;
303 inc( Index );
304 end;
305end;
306
307
308Procedure GetNextQuotedValue(
309 const S: string;
310 var Index: longint;
311 var Value: string;
312 const QuoteChar: char );
313begin
314 Value := '';
315 SkipChar( S, Index, ' ' );
316 if Index > Length( S ) then
317 exit;
318
319 if S[ Index ] <> QuoteChar then
320 begin
321 // not quoted, go to next space
322 while Index <= Length( S ) do
323 begin
324 if S[ Index ] = ' ' then
325 break;
326 Value := Value + S[ Index ];
327 inc( Index );
328 end;
329 // skip following spaces
330 SkipChar( S, Index, ' ' );
331 exit;
332 end;
333
334 // quoted string
335 inc( Index ); // skip opening quote
336
337 while Index <= Length( S ) do
338 begin
339 if S[ Index ] = QuoteChar then
340 begin
341 inc( index ); // skip closing quote
342 if Index > Length( S ) then
343 break; // done
344 if S[ Index ] <> QuoteChar then
345 break; // done
346
347 // escaped quote e.g "" so we do want it.
348 end;
349 Value := Value + S[ Index ];
350 inc( Index );
351 end;
352
353 SkipChar( S, Index, ' ' );
354
355end;
356
357Function InsertDuplicateChars( const S: string;
358 const QuoteChar: char ): string;
359var
360 i: integer;
361begin
362 Result := '';
363 for i := 1 to Length( S ) do
364 begin
365 Result := Result + S[ i ];
366 if S[ i ] = QuoteChar then
367 Result := Result + QuoteChar; // insert duplicate
368 end;
369end;
370
371Function FindSubstring( const SubString: string;
372 const S: string ): integer;
373begin
374 Result := Pos( Uppercase( SubString ),
375 Uppercase( S ) );
376end;
377
378Function MatchLeadingChars(
379 const S: string;
380 MatchFunction: TCharMatchFunction ): string;
381var
382 i: integer;
383 TheChar: char;
384begin
385 Result:= '';
386 i := 1;
387 while i <= Length( S ) do
388 begin
389 TheChar:= S[ i ];
390 if not MatchFunction( TheChar ) then
391 // found a non matching char. Stop looking
392 break;
393 Result:= Result + TheChar;
394 inc( i );
395 end;
396end;
397
398Function ExtractLeadingChars(
399 Var S: string;
400 MatchFunction: TCharMatchFunction ): string;
401begin
402 Result := MatchLeadingChars( s, MatchFunction );
403 if Length( Result ) > 0 then
404 // remove matching section from string
405 Delete( S, 1, Length( Result ) );
406end;
407
408// Hex conversion: sheer extravagance. Conversion from
409// a hex digit char to int is done by creating a lookup table
410// in advance.
411var
412 MapHexDigitToInt: array[ Chr( 0 ) .. Chr( 255 ) ] of longint;
413
414procedure InitHexDigitMap;
415var
416 c: char;
417 IntValue: longint;
418begin
419 for c := Chr( 0 ) to Chr( 255 ) do
420 begin
421 IntValue := -1;
422 if ( c >= '0' )
423 and ( c <= '9' ) then
424 IntValue := Ord( c ) - Ord( '0' );
425
426 if ( Upcase( c ) >= 'A' )
427 and ( Upcase( c ) <= 'F' ) then
428 IntValue := 10 + Ord( Upcase( c ) ) - Ord( 'A' );
429
430 MapHexDigitToInt[ c ] := IntValue;
431 end;
432end;
433
434function HexDigitToInt( c: char ): longint;
435begin
436 Result := MapHexDigitToInt[ c ];
437 if Result = -1 then
438 raise EConvertError.Create( 'Invalid hex char: ' + c );
439end;
440
441function HexToInt( s: string ): longint;
442var
443 i: integer;
444begin
445 if Length( s ) = 0 then
446 raise EConvertError.Create( 'No chars in hex string' );
447 Result := 0;
448 for i:= 1 to Length( s ) do
449 begin
450 Result := Result shl 4;
451 inc( Result, HexDigitToInt( s[ i ] ) );
452 end;
453end;
454
455{$ifdef os2}
456procedure GetMemString( p: pointer;
457 Var s: string;
458 Size: byte );
459begin
460 S[ 0 ]:= char( size );
461 MemCopy( p, Addr( S[ 1 ] ), Size );
462end;
463
464procedure FreePString( Var ps: PString );
465begin
466 if ps = nil then
467 exit;
468
469 FreeMem( ps, Length( ps^ ) + 1 );
470 ps:= nil;
471end;
472
473function NewPStringLen( const Length: longint ): PString;
474begin
475 GetMem( Result, Length + 1 );
476end;
477
478function NewPString( const s: string ): PString;
479begin
480 GetMem( Result, Length( S ) + 1 );
481 Result^:= S;
482end;
483{$endif}
484
485Function StringsSame( const a, b: string ): boolean;
486begin
487 Result:= CompareText( a, b ) = 0;
488end;
489
490// Returns S in single quotes
491Function StrQuote( const s: string ): string;
492begin
493 Result := Quote + s + Quote;
494end;
495
496// Returns S without double quotes
497Function StrUnQuote( const s: string ): string;
498begin
499 Result := S;
500 if S = '' then
501 exit;
502
503 if Result[ 1 ] = Quote then
504 Delete( Result, 1, 1 );
505
506 if Result = '' then
507 exit;
508
509 if Result[ Length( Result ) ] = Quote then
510 Delete( Result, Length( Result ), 1 );
511end;
512
513Function StrDoubleQuote( const s: string ): string;
514begin
515 Result := DoubleQuote + s + DoubleQuote;
516end;
517
518Function StrFullDoubleQuote( const s: string ): string;
519begin
520 Result := DoubleQuote
521 + InsertDuplicateChars( s, '"' )
522 + DoubleQuote;
523end;
524
525// Returns S without double quotes
526Function StrUnDoubleQuote( const s: string ): string;
527begin
528 Result := S;
529 if S = '' then
530 exit;
531
532 if Result[ 1 ] = DoubleQuote then
533 Delete( Result, 1, 1 );
534
535 if Result = '' then
536 exit;
537
538 if Result[ Length( Result ) ] = DoubleQuote then
539 Delete( Result, Length( Result ), 1 );
540end;
541
542Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
543Var
544 i: longint;
545Begin
546 Result:= S;
547 for i:=1 to length( S ) do
548 if Result[ i ] = Find then
549 Result[ i ]:= Replace;
550End;
551
552Function StrRight( const S:string; const count:integer ):string;
553Begin
554 if count>=length(s) then
555 begin
556 Result:=S;
557 end
558 else
559 begin
560 Result:=copy( S, length( s )-count+1, count );
561 end;
562end;
563
564Function StrLeft( const S:string; const count:integer ):string;
565Begin
566 if count>=length(s) then
567 Result:=S
568 else
569 Result:=copy( S, 1, count );
570end;
571
572// Returns S minus count characters from the right
573Function StrLeftWithout( const S:string; const count:integer ):string;
574Begin
575 Result:= copy( S, 1, length( S )-count );
576End;
577
578Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
579Begin
580 Result:= S;
581 Delete( Result, 1, leftCount );
582 Delete( Result, length( S )-rightCount, rightCount );
583End;
584
585Function StrRightFrom( const S:string; const start:integer ):string;
586Begin
587 Result:= copy( S, start, length( S )-start+1 );
588end;
589
590Procedure ParseConfigLine( const S: string;
591 var keyName: string;
592 var keyValue: string );
593Var
594 line: String;
595 EqualsPos: longint;
596Begin
597 KeyName:= '';
598 KeyValue:= '';
599
600 line:= trim( S );
601 EqualsPos:= Pos( '=', line );
602
603 if ( EqualsPos>0 ) then
604 begin
605 KeyName:= line;
606 Delete( KeyName, EqualsPos, length( KeyName )-EqualsPos+1 );
607 KeyName:= Trim( KeyName );
608
609 KeyValue:= line;
610 Delete( KeyValue, 1, EqualsPos );
611 KeyValue:= Trim( KeyValue );
612 end;
613end;
614
615Function ExtractNextValueNoTrim( var S: string;
616 const Separator: string ): string;
617Var
618 SeparatorPos: integer;
619Begin
620 SeparatorPos := Pos( Separator, S );
621 if SeparatorPos > 0 then
622 begin
623 Result := Copy( S, 1, SeparatorPos-1 );
624 Delete( S, 1, SeparatorPos + length( Separator ) - 1 );
625 end
626 else
627 begin
628 Result := S;
629 S := '';
630 end;
631end;
632
633Function ExtractNextValue( var S: string;
634 const Separator: string ): string;
635begin
636 Result := ExtractNextValueNoTrim( S, Separator );
637 Result := trim( Result );
638
639 // Remove quotes if present
640 if Result <> '' then
641 if Result[ 1 ] = DoubleQuote then
642 Delete( Result, 1, 1 );
643
644 if Result <> '' then
645 if Result[ length( Result ) ] = DoubleQuote then
646 Delete( Result, length( Result ), 1 );
647end;
648
649procedure GetNextValue( const S: String;
650 Var Index: longint;
651 Var Value: String;
652 const Seperator: Char );
653var
654 NextSeperatorPosition: longint;
655 StringLen: longint;
656begin
657 Value := '';
658 StringLen := Length( S );
659 if Index > StringLen then
660 exit;
661 NextSeperatorPosition := Index;
662 while NextSeperatorPosition < StringLen do
663 begin
664 if S[ NextSeperatorPosition ] = Seperator then
665 break;
666 inc( NextSeperatorPosition );
667 end;
668
669 if NextSeperatorPosition < StringLen then
670 begin
671 Value := Copy( S,
672 Index,
673 NextSeperatorPosition - Index );
674 Index := NextSeperatorPosition + 1;
675 end
676 else
677 begin
678 Value := Copy( S,
679 Index,
680 StringLen - Index + 1 );
681 Index := StringLen + 1;
682 end;
683 TrimRight( Value );
684end;
685
686Function IsDigit( const c: char ): boolean;
687Begin
688 Result:=( c>='0' ) and ( c<='9' );
689End;
690
691Function IsNonDigit( const c: char ): boolean;
692Begin
693 Result:=( c<'0' ) or ( c>'9' );
694End;
695
696Function IsAlpha( const c: char ): boolean;
697var
698 UppercaseC: char;
699Begin
700 UppercaseC := UpCase( c );
701 Result := ( UppercaseC >= 'A' ) and ( UppercaseC <= 'Z' );
702end;
703
704{$ifdef os2}
705// Returns true if s is only spaces (or empty)
706Function IsSpaces( const s: string ): boolean;
707Begin
708 Asm
709 MOV ESI,s // get address of s into ESI
710 MOV CL,[ESI] // get length of s
711 MOVZX ECX, CL // widen CL
712 INC ECX
713
714!IsSpacesLoop:
715 INC ESI // move to next char
716 DEC ECX
717 JE !IsSpacesTrue
718
719 MOV AL,[ESI] // load character
720 CMP AL,32 // is it a space?
721 JE !IsSpacesLoop // yes, go to next
722
723 // no, return false
724 MOV EAX, 0
725 JMP !IsSpacesDone
726
727!IsSpacesTrue:
728 MOV EAX, 1
729
730!IsSpacesDone:
731 LEAVE
732 RETN32 4
733 End;
734
735End;
736{$else}
737// Returns true if s is only spaces (or empty)
738Function IsSpaces( const s: string ): boolean;
739var
740 i: longint;
741Begin
742 for i := 1 to length( s ) do
743 begin
744 if s[ i ] <> ' ' then
745 begin
746 result := false;
747 exit;
748 end;
749 end;
750 result := true;
751end;
752{$endif}
753
754Function StrLeft0Pad( const n: integer; const width: integer ): string;
755Begin
756 Result:= IntToStr( n );
757 while length( Result )<width do
758 Result:= '0' +Result;
759End;
760
761// Returns true if s starts with start
762{$ifdef win32}
763Function StrStarts( const start: string; const s: string ): boolean;
764Var
765 i: integer;
766Begin
767 Result:= false;
768 if length( start ) > length( s ) then
769 exit;
770 for i:= 1 to length( start ) do
771 if UpCase( s[ i ] ) <> UpCase( start[ i ] ) then
772 exit;
773 Result:= true;
774End;
775
776{$else}
777
778Function StrStarts( const start: string; const s: string ): boolean;
779Begin
780 Asm
781 //Locals:
782 //START at [EBP+12]
783 //S at [EBP+8]
784
785 // First get and check lengths
786 MOV ESI,[EBP+12] // get address of start into ESI
787 MOV CL,[ESI] // get length of start (set remainder of CL to zero)
788 MOV EDI,[EBP+8] // get address of s into EDI
789 MOV DL,[EDI] // get length of s
790 CMP CL,DL
791 JBE !StartLengthOK
792
793 // start longer than s so false
794 MOV EAX, 0
795 LEAVE
796 RETN32 8
797
798!StartLengthOK:
799 INC ESI // skip ESI past length byte of start string
800
801 // get ending address of start into EDX
802 MOV EDX, ESI
803
804 MOVZX ECX, CL // widen CL
805 ADD EDX, ECX // ecx is length of start, add to edx
806
807 // get starting address of s
808 INC EDI // skip EDI past length byte of s
809
810 JMP !StartsLoop
811
812!StartsLoopStart:
813 MOV AL, [ESI] // get next char of start string
814 MOV BL, [EDI] // get next char of string
815
816 // Convert chars to uppercase
817 CMP AL,97
818 JB !Upcase1
819 CMP AL,122
820 JA !Upcase1
821 SUB AL,32 // convert lower to upper
822!Upcase1:
823
824 CMP BL,97
825 JB !Upcase2
826 CMP BL,122
827 JA !Upcase2
828 SUB BL,32 // convert lower to upper
829!Upcase2:
830
831 // Compare uppercased chars
832 CMP AL,BL
833 JE !StartsCharMatch
834 // different.
835 MOV EAX, 0
836 LEAVE
837 RETN32 8
838
839!StartsCharMatch:
840 INC ESI
841 INC EDI
842
843!StartsLoop:
844 CMP ESI, EDX // have we reached the end (EDX) of start string
845 JB !StartsLoopStart
846
847 // Match, return true
848 MOV EAX, 1
849 LEAVE
850 RETN32 8
851 End;
852end;
853{$endif}
854
855// Returns true if s ends with endstr (case insensitive)
856Function StrEnds( const endStr: string; const s: string ): boolean;
857Var
858 i, j: integer;
859Begin
860 Result:= false;
861 if Length( s ) < length( endStr ) then
862 exit;
863 j:= Length( s );
864 for i:= length( endstr ) downto 1 do
865 begin
866 if UpCase( s[ j ] ) <> UpCase( endStr[ i ] ) then
867 exit;
868 dec( j );
869 end;
870 Result:= true;
871End;
872
873Procedure RemoveSeparatorSpaces( var S: string;
874 const Separator:string );
875Var
876 SeparatorPos:integer;
877 NewString: string;
878Begin
879 NewString := '';
880 while S <> '' do
881 begin
882 SeparatorPos := pos( Separator, S );
883 if SeparatorPos > 0 then
884 begin
885 NewString := NewString
886 + trim( copy( S, 1, SeparatorPos - 1 ) )
887 + Separator;
888 Delete( S, 1, SeparatorPos );
889 end
890 else
891 begin
892 NewString := NewString + trim( S );
893 S := '';
894 end;
895 end;
896 S := NewString;
897End;
898
899Procedure AddToListString( Var S: string;
900 const NewValue: string;
901 const Separator: string );
902Begin
903 if trim( S )<>'' then
904 S:=S+Separator;
905 S:=S+NewValue;
906End;
907
908Function ListToString( List: TStrings;
909 const Separator: string ): string;
910Var
911 i: longint;
912Begin
913 Result:= '';
914 for i:= 0 to List.Count - 1 do
915 AddToListString( Result, List[ i ], Separator );
916End;
917
918procedure StringToList( S: String;
919 List: TStrings;
920 const Separator: string );
921var
922 Item: string;
923begin
924 List.Clear;
925 while S <> '' do
926 begin
927 Item:= ExtractNextValue( S, Separator );
928 List.Add( Item );
929 end;
930end;
931
932Function StrFirstWord( const S: String ): string;
933Var
934 SpacePos: longint;
935 temp: string;
936Begin
937 temp:= trimleft( S );
938 SpacePos:= pos( ' ', temp );
939 if SpacePos>0 then
940 Result:= Copy( temp, 1, SpacePos-1 )
941 else
942 Result:= temp;
943End;
944
945function FindCharFromEnd( const s: string;
946 const c: char ): longint;
947var
948 i: longint;
949begin
950 i := Length( s );
951 while i > 0 do
952 begin
953 if s[ i ] = c then
954 begin
955 Result := i;
956 exit;
957 end;
958 dec( i );
959 end;
960 result := 0;
961end;
962
963Function IncrementNumberedString( StartString: string ): string;
964Var
965 Number: string;
966 NewNumber: string;
967 i: integer;
968begin
969 // Extract any digits at the end of the string
970 i:= length( StartString );
971 Number:= '';
972 while i>0 do
973 begin
974 if isDigit( StartString[i] ) then
975 begin
976 Number:= StartString[i] + Number;
977 i:= i - 1;
978 end
979 else
980 break;
981 end;
982
983 if Number<>'' then
984 begin
985 // Found a numeric bit to play with
986 // Copy the first part
987 Result:= StrLeftWithout( StartString, length( Number ) );
988 NewNumber:= StrLeft0Pad( StrToInt( Number ) + 1,
989 length( Number ) );
990 Result:= Result + NewNumber;
991 end
992 else
993 // No build number, add a 1
994 Result:= StartString + '1';
995end;
996
997{$ifdef OS2}
998
999Function AnsiTrim( const S: AnsiString ): AnsiString;
1000Var
1001 i: longint;
1002Begin
1003 i:= 1;
1004 while i<length( S) do
1005 begin
1006 if S[ i ]<>' ' then
1007 break;
1008 inc( i );
1009 end;
1010 Result:= S;
1011 if i>1 then
1012 AnsiDelete( Result, 1, i-1 );
1013 i:= length( Result );
1014 while i>=1 do
1015 begin
1016 if S[ i ]<>' ' then
1017 break;
1018 dec( i );
1019 end;
1020 AnsiSetLength( Result, i );
1021End;
1022
1023Procedure AnsiParseConfigLine( const S: Ansistring;
1024 var keyName: Ansistring;
1025 var keyValue: Ansistring );
1026Var
1027 line: AnsiString;
1028 EqualsPos: longint;
1029Begin
1030 KeyName:= '';
1031 KeyValue:= '';
1032
1033 line:= AnsiTrim( S );
1034 EqualsPos:= AnsiPos( '=', line );
1035
1036 if ( EqualsPos>0 ) then
1037 begin
1038 KeyName:= AnsiCopy( line, 1, EqualsPos-1 );
1039 KeyName:= AnsiTrim( KeyName );
1040
1041 KeyValue:= AnsiCopy( line, EqualsPos+1, length( line )-EqualsPos );
1042 KeyValue:= AnsiTrim( KeyValue );
1043 end;
1044end;
1045
1046Function AnsiExtractNextValue( var CSVString: AnsiString;
1047 const Separator: AnsiString ): AnsiString;
1048Var
1049 SeparatorPos: integer;
1050Begin
1051 SeparatorPos:= AnsiPos( Separator, CSVString );
1052 if SeparatorPos>0 then
1053 begin
1054 Result:= AnsiCopy( CSVString, 1, SeparatorPos-1 );
1055 AnsiDelete( CSVString, 1, SeparatorPos + length( Separator ) - 1 );
1056 end
1057 else
1058 begin
1059 Result:= CSVString;
1060 CSVString:= '';
1061 end;
1062 Result:= AnsiTrim( Result );
1063 // Remove qyotes if present
1064 if ( Result[1] = chr(34) )
1065 and ( Result[ length(Result) ] = chr(34) ) then
1066 begin
1067 AnsiDelete( Result, 1, 1 );
1068 AnsiDelete( Result, length( Result ), 1 );
1069 Result:= AnsiTrim( Result );
1070 end;
1071end;
1072{$Endif}
1073
1074Procedure ReverseList( TheList:TStrings );
1075Var
1076 TempList: TStringList;
1077 i: integer;
1078Begin
1079 TempList:= TStringList.Create;
1080 for i:=TheList.count-1 downto 0 do
1081 begin
1082 TempList.AddObject( TheList.Strings[i],
1083 TheList.Objects[i] );
1084 end;
1085 TheList.Assign( TempList );
1086 TempList.Destroy;
1087end;
1088
1089Function FindStringInList( const TheString: string;
1090 TheList:TStrings ): longint;
1091Var
1092 i: longint;
1093Begin
1094 for i:=0 to TheList.count-1 do
1095 begin
1096 if StringsSame( TheString, TheList[ i ] ) then
1097 begin
1098 // found
1099 Result:=i;
1100 exit;
1101 end;
1102 end;
1103 Result:=-1;
1104End;
1105
1106Procedure MergeStringLists( Dest: TStringList;
1107 AdditionalList: TStringList );
1108var
1109 i: integer;
1110 s: string;
1111begin
1112 for i:= 0 to AdditionalList.Count - 1 do
1113 begin
1114 s:= AdditionalList[ i ];
1115 if FindStringInList( s, Dest ) = -1 then
1116 Dest.AddObject( s, AdditionalList.Objects[ i ] );
1117 end;
1118end;
1119
1120// ---------------------- PCHAR Utilities ---------------------------------------
1121
1122function StrNPas( const Ps: PChar; const Length: integer ): String;
1123var
1124 i: integer;
1125begin
1126 Result:= '';
1127 i:= 0;
1128 while ( Ps[ i ] <> #0 ) and ( i < Length ) do
1129 begin
1130 Result:= Result + Ps[ i ];
1131 inc( i );
1132 end;
1133end;
1134
1135Function PCharDiff( const a: PChar; const b: Pchar ): longword;
1136begin
1137 Result:= longword( a ) - longword( b );
1138end;
1139
1140Procedure CheckPCharSize( Var Text: PChar;
1141 const NeededSize: longword );
1142var
1143 temp: PChar;
1144 NewBufferSize: longword;
1145begin
1146 if ( NeededSize + 1 ) // + 1 to allow for null terminator
1147 > StrBufSize( Text ) then
1148 begin
1149 // allocate new buffer, double the size...
1150 NewBufferSize:= StrBufSize( Text ) * 2;
1151 // or if that's not enough...
1152 if NewBufferSize < ( NeededSize + 1 ) then
1153 // double what we are going to need
1154 NewBufferSize:= NeededSize * 2;
1155 temp:= StrAlloc( NewBufferSize );
1156
1157 // copy string to new buffer
1158 StrCopy( temp, Text );
1159 StrDispose( Text );
1160 Text:= temp;
1161 end;
1162end;
1163
1164Procedure AddAndResize( Var Text: PChar;
1165 const AddText: PChar );
1166begin
1167 CheckPCharSize( Text,
1168 strlen( Text )
1169 + strlen( AddText ) );
1170 StrCat( Text, AddText );
1171end;
1172
1173Procedure StrCopyAndResize( Var Dest: PChar;
1174 const Source: PChar );
1175begin
1176 CheckPCharSize( Dest, StrLen( Source ) );
1177 StrCopy( Dest, Source );
1178end;
1179
1180// trims spaces and carriage returns of the end of Text
1181procedure TrimWhitespace( Text: PChar );
1182var
1183 P: PChar;
1184 IsWhitespace: boolean;
1185 TheChar: Char;
1186begin
1187 P:= Text + StrLen( Text );
1188 while P > Text do
1189 begin
1190 dec( P );
1191 TheChar:= P^;
1192 IsWhitespace:= TheChar in [ ' ', #13, #10, #9 ];
1193 if not IsWhiteSpace then
1194 // done
1195 break;
1196 P[ 0 ]:= #0; // Do no use P^ :=
1197 end;
1198end;
1199
1200function TrimChars( const s: string;
1201 chars: TSetOfChars ): string;
1202var
1203 i: longint;
1204 j: longint;
1205begin
1206 i := 1;
1207 while i < Length( s ) do
1208 if s[ i ] in chars then
1209 inc( i )
1210 else
1211 break;
1212
1213 j := Length( s );
1214 while j > i do
1215 if s[ j ] in chars then
1216 dec( j )
1217 else
1218 break;
1219
1220 result := Copy( s, i, j - i + 1 );
1221end;
1222
1223procedure StrPCat( Var Dest: PChar;
1224 const StringToAdd: string );
1225var
1226 Index: longint;
1227 DestP: PChar;
1228begin
1229 CheckPCharSize( Dest,
1230 StrLen( Dest )
1231 + longword( Length( StringToAdd ) ) );
1232 DestP:= Dest + StrLen( Dest );
1233 for Index:= 1 to Length( StringToAdd ) do
1234 begin
1235 DestP[ 0 ]:= StringToAdd[ Index ]; // do not use DestP^ :=
1236 inc( DestP );
1237 end;
1238 DestP[ 0 ]:= #0; // Do not use DestP^ := #0; Under Sibyl at least, this writes *** 2 NULL BYTES!!! ***
1239end;
1240
1241Procedure TrimEndLines( const S: PChar );
1242var
1243 StringIndex: integer;
1244{$ifdef os2}
1245 p: pchar;
1246{$endif}
1247begin
1248 StringIndex:= strlen( S );
1249 while StringIndex > 0 do
1250 begin
1251 dec( StringIndex );
1252 if S[ StringIndex ] in [ #10, #13 ] then
1253 begin
1254{$ifdef win32}
1255 S[ StringIndex ]:= #0
1256{$else}
1257 p := S;
1258 p[ StringIndex ] := #0;
1259{$endif}
1260 end
1261 else
1262 break;
1263 end;
1264end;
1265
1266Function StrDupPas( const s: string ): PChar;
1267Begin
1268 Result:=StrAlloc( length( s )+1 );
1269 StrPCopy( Result, S );
1270// Result^:=s;
1271End;
1272
1273// Returns a copy of the first n chars of s
1274Function StrNDup( const s: PChar; const n: integer ): PChar;
1275Begin
1276 Result:= StrAlloc( n+1 );
1277 Result[ n ]:= '6';
1278 StrLCopy( Result, s, n );
1279End;
1280
1281// Returns a copy of the first line starting at lineStart
1282Function CopyFirstLine( const lineStart: PChar ): PChar;
1283Var
1284 lineEnd: PChar;
1285 lineLength: integer;
1286Begin
1287 // look for an end of line
1288 lineEnd:= strpos( lineStart, EndLine );
1289 if lineEnd <> nil then
1290 begin
1291 // found, line length is difference between line end position and start of line
1292 lineLength:= longword( lineEnd )-longword( lineStart ); // ugly but how else can it be done?
1293 Result:= StrNDup( lineStart, lineLength );
1294 exit;
1295 end;
1296
1297 // no eol found, return copy of remainder of string
1298 Result:= StrNew( lineStart );
1299end;
1300
1301// Returns next line p points to
1302Function NextLine( const p: PChar): PChar;
1303Var
1304 lineEnd: PChar;
1305Begin
1306 // look for an end of line
1307 lineEnd:=strpos( p, EndLine );
1308 if lineEnd<>nil then
1309 begin
1310 // Advance the linestart over the eol
1311 Result:=lineEnd+length( EndLine );
1312 exit;
1313 end;
1314
1315 // no eol found, return pointer to null term
1316 Result:=p+strlen( p );
1317end;
1318
1319{$ifdef os2}
1320Function CaseInsensitivePos( const a: string;
1321 const b: string ): longint;
1322var
1323 EndOfA: longword;
1324Begin
1325 Asm
1326 //Locals:
1327 //a at [EBP+12]
1328 //b at [EBP+8]
1329
1330 // First get and check lengths
1331 MOV ESI, a // get address of a into ESI
1332 MOV CL, [ESI] // get length of a
1333 MOV EDI, b // get address of b into EDI
1334 MOV DL, [EDI] // get length of b
1335 CMP CL, DL
1336 JBE !CIP_AFitsInB
1337
1338 // a longer than b so a can't be in b
1339
1340!CIP_NoMatch:
1341 MOV EAX, 0
1342 LEAVE
1343 RETN32 8
1344
1345!CIP_AFitsInB:
1346
1347 INC ESI // skip length byte in a
1348 INC EDI // skip length byte of b
1349
1350 // get ending address of b into EDX
1351 MOVZX EDX, DL // widen DL
1352 ADD EDX, EDI // add start of b
1353
1354 // get ending address of a into EndOfA
1355 MOVZX ECX, CL // widen CL
1356 ADD ECX, ESI // add start of a
1357 MOV EndOfA, ECX // store to EndOfA
1358
1359 MOV ECX, EDI // set start of current match to start of b
1360
1361 // ESI: current search point in a
1362 // EDI: current search point in b
1363 // EDX: end of b
1364 // ECX: start of current match
1365 // available: eax, ebx
1366
1367 JMP !CIP_Loop
1368
1369!CIP_LoopStart:
1370 CMP EDI, EDX
1371 JE !CIP_NoMatch // run out of b
1372
1373 MOV AL, [ESI] // get next char of a
1374 INC ESI // next in a
1375
1376 MOV BL, [EDI] // get next char of b
1377 INC EDI // next in b
1378
1379 // Convert chars to uppercase
1380
1381 CMP AL, 97
1382 JB !CIP_Upcase1
1383 CMP AL, 122
1384 JA !CIP_Upcase1
1385 SUB AL, 32 // convert lower to upper
1386!CIP_Upcase1:
1387
1388 CMP BL,97
1389 JB !CIP_Upcase2
1390 CMP BL,122
1391 JA !CIP_Upcase2
1392 SUB BL,32 // convert lower to upper
1393!CIP_Upcase2:
1394
1395 // Compare uppercased chars
1396 CMP AL,BL
1397 JE !CIP_Loop
1398
1399 // different.
1400
1401 // Back to start of match + 1
1402 INC ECX // inc start of match
1403 MOV EDI, ECX // back to start of match in b
1404 MOV ESI, a // back to start of a
1405 INC ESI // skip length
1406 JMP !CIP_LoopStart
1407
1408!CIP_Loop:
1409 // same
1410
1411 CMP ESI, EndOfA // have we reached the end of a
1412 JB !CIP_LoopStart
1413
1414 // Match, return position
1415 SUB ECX, [EBP+8] // position = ( start of match ) - ( start of b ) + 1
1416 MOV EAX, ECX
1417 LEAVE
1418 RETN32 8
1419 End;
1420end;
1421{$else}
1422Function CaseInsensitivePos( const a: string;
1423 const b: string ): longint;
1424begin
1425 Result := Pos( UpperCase( a ), Uppercase( b ) );
1426end;
1427
1428{$endif}
1429
1430Function BoolToStr( const b: boolean ): string;
1431begin
1432 if b then
1433 Result := 'True'
1434 else
1435 Result := 'False';
1436end;
1437
1438Initialization
1439 InitHexDigitMap;
1440End.
Note: See TracBrowser for help on using the repository browser.