source: trunk/Library/ACLStringUtility.pas@ 17

Last change on this file since 17 was 17, checked in by RBRi, 19 years ago

+ Library

  • Property svn:eol-style set to native
File size: 34.7 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// Return true if param matches the form
287// /Flag:value
288// dash (-) can be used instead of slash (/)
289// colon can be omitted
290function MatchValueParam( const Param: string;
291 const Flag: string;
292 var Value: string ): boolean;
293
294// Return true if param matches the form
295// /Flag
296// dash (-) can be used instead of slash (/)
297function MatchFlagParam( const Param: string;
298 const Flag: string ): boolean;
299
300Implementation
301
302Uses
303 SysUtils, ACLUtility;
304
305// ---------------------- Pascal String Utilities ---------------------------------------
306
307Procedure SkipChar( const S: string;
308 Var index: longint;
309 const C: Char );
310begin
311 while Index <= Length( S ) do
312 begin
313 if S[ Index ] <> C then
314 break;
315 inc( Index );
316 end;
317end;
318
319
320Procedure GetNextQuotedValue(
321 const S: string;
322 var Index: longint;
323 var Value: string;
324 const QuoteChar: char );
325begin
326 Value := '';
327 SkipChar( S, Index, ' ' );
328 if Index > Length( S ) then
329 exit;
330
331 if S[ Index ] <> QuoteChar then
332 begin
333 // not quoted, go to next space
334 while Index <= Length( S ) do
335 begin
336 if S[ Index ] = ' ' then
337 break;
338 Value := Value + S[ Index ];
339 inc( Index );
340 end;
341 // skip following spaces
342 SkipChar( S, Index, ' ' );
343 exit;
344 end;
345
346 // quoted string
347 inc( Index ); // skip opening quote
348
349 while Index <= Length( S ) do
350 begin
351 if S[ Index ] = QuoteChar then
352 begin
353 inc( index ); // skip closing quote
354 if Index > Length( S ) then
355 break; // done
356 if S[ Index ] <> QuoteChar then
357 break; // done
358
359 // escaped quote e.g "" so we do want it.
360 end;
361 Value := Value + S[ Index ];
362 inc( Index );
363 end;
364
365 SkipChar( S, Index, ' ' );
366
367end;
368
369Function InsertDuplicateChars( const S: string;
370 const QuoteChar: char ): string;
371var
372 i: integer;
373begin
374 Result := '';
375 for i := 1 to Length( S ) do
376 begin
377 Result := Result + S[ i ];
378 if S[ i ] = QuoteChar then
379 Result := Result + QuoteChar; // insert duplicate
380 end;
381end;
382
383Function FindSubstring( const SubString: string;
384 const S: string ): integer;
385begin
386 Result := Pos( Uppercase( SubString ),
387 Uppercase( S ) );
388end;
389
390Function MatchLeadingChars(
391 const S: string;
392 MatchFunction: TCharMatchFunction ): string;
393var
394 i: integer;
395 TheChar: char;
396begin
397 Result:= '';
398 i := 1;
399 while i <= Length( S ) do
400 begin
401 TheChar:= S[ i ];
402 if not MatchFunction( TheChar ) then
403 // found a non matching char. Stop looking
404 break;
405 Result:= Result + TheChar;
406 inc( i );
407 end;
408end;
409
410Function ExtractLeadingChars(
411 Var S: string;
412 MatchFunction: TCharMatchFunction ): string;
413begin
414 Result := MatchLeadingChars( s, MatchFunction );
415 if Length( Result ) > 0 then
416 // remove matching section from string
417 Delete( S, 1, Length( Result ) );
418end;
419
420// Hex conversion: sheer extravagance. Conversion from
421// a hex digit char to int is done by creating a lookup table
422// in advance.
423var
424 MapHexDigitToInt: array[ Chr( 0 ) .. Chr( 255 ) ] of longint;
425
426procedure InitHexDigitMap;
427var
428 c: char;
429 IntValue: longint;
430begin
431 for c := Chr( 0 ) to Chr( 255 ) do
432 begin
433 IntValue := -1;
434 if ( c >= '0' )
435 and ( c <= '9' ) then
436 IntValue := Ord( c ) - Ord( '0' );
437
438 if ( Upcase( c ) >= 'A' )
439 and ( Upcase( c ) <= 'F' ) then
440 IntValue := 10 + Ord( Upcase( c ) ) - Ord( 'A' );
441
442 MapHexDigitToInt[ c ] := IntValue;
443 end;
444end;
445
446function HexDigitToInt( c: char ): longint;
447begin
448 Result := MapHexDigitToInt[ c ];
449 if Result = -1 then
450 raise EConvertError.Create( 'Invalid hex char: ' + c );
451end;
452
453function HexToInt( s: string ): longint;
454var
455 i: integer;
456begin
457 if Length( s ) = 0 then
458 raise EConvertError.Create( 'No chars in hex string' );
459 Result := 0;
460 for i:= 1 to Length( s ) do
461 begin
462 Result := Result shl 4;
463 inc( Result, HexDigitToInt( s[ i ] ) );
464 end;
465end;
466
467{$ifdef os2}
468procedure GetMemString( p: pointer;
469 Var s: string;
470 Size: byte );
471begin
472 S[ 0 ]:= char( size );
473 MemCopy( p, Addr( S[ 1 ] ), Size );
474end;
475
476procedure FreePString( Var ps: PString );
477begin
478 if ps = nil then
479 exit;
480
481 FreeMem( ps, Length( ps^ ) + 1 );
482 ps:= nil;
483end;
484
485function NewPStringLen( const Length: longint ): PString;
486begin
487 GetMem( Result, Length + 1 );
488end;
489
490function NewPString( const s: string ): PString;
491begin
492 GetMem( Result, Length( S ) + 1 );
493 Result^:= S;
494end;
495{$endif}
496
497Function StringsSame( const a, b: string ): boolean;
498begin
499 Result:= CompareText( a, b ) = 0;
500end;
501
502// Returns S in single quotes
503Function StrQuote( const s: string ): string;
504begin
505 Result := Quote + s + Quote;
506end;
507
508// Returns S without double quotes
509Function StrUnQuote( const s: string ): string;
510begin
511 Result := S;
512 if S = '' then
513 exit;
514
515 if Result[ 1 ] = Quote then
516 Delete( Result, 1, 1 );
517
518 if Result = '' then
519 exit;
520
521 if Result[ Length( Result ) ] = Quote then
522 Delete( Result, Length( Result ), 1 );
523end;
524
525Function StrDoubleQuote( const s: string ): string;
526begin
527 Result := DoubleQuote + s + DoubleQuote;
528end;
529
530Function StrFullDoubleQuote( const s: string ): string;
531begin
532 Result := DoubleQuote
533 + InsertDuplicateChars( s, '"' )
534 + DoubleQuote;
535end;
536
537// Returns S without double quotes
538Function StrUnDoubleQuote( const s: string ): string;
539begin
540 Result := S;
541 if S = '' then
542 exit;
543
544 if Result[ 1 ] = DoubleQuote then
545 Delete( Result, 1, 1 );
546
547 if Result = '' then
548 exit;
549
550 if Result[ Length( Result ) ] = DoubleQuote then
551 Delete( Result, Length( Result ), 1 );
552end;
553
554Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
555Var
556 i: longint;
557Begin
558 Result:= S;
559 for i:=1 to length( S ) do
560 if Result[ i ] = Find then
561 Result[ i ]:= Replace;
562End;
563
564Function StrRight( const S:string; const count:integer ):string;
565Begin
566 if count>=length(s) then
567 begin
568 Result:=S;
569 end
570 else
571 begin
572 Result:=copy( S, length( s )-count+1, count );
573 end;
574end;
575
576Function StrLeft( const S:string; const count:integer ):string;
577Begin
578 if count>=length(s) then
579 Result:=S
580 else
581 Result:=copy( S, 1, count );
582end;
583
584// Returns S minus count characters from the right
585Function StrLeftWithout( const S:string; const count:integer ):string;
586Begin
587 Result:= copy( S, 1, length( S )-count );
588End;
589
590Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
591Begin
592 Result:= S;
593 Delete( Result, 1, leftCount );
594 Delete( Result, length( S )-rightCount, rightCount );
595End;
596
597Function StrRightFrom( const S:string; const start:integer ):string;
598Begin
599 Result:= copy( S, start, length( S )-start+1 );
600end;
601
602Procedure ParseConfigLine( const S: string;
603 var keyName: string;
604 var keyValue: string );
605Var
606 line: String;
607 EqualsPos: longint;
608Begin
609 KeyName:= '';
610 KeyValue:= '';
611
612 line:= trim( S );
613 EqualsPos:= Pos( '=', line );
614
615 if ( EqualsPos>0 ) then
616 begin
617 KeyName:= line;
618 Delete( KeyName, EqualsPos, length( KeyName )-EqualsPos+1 );
619 KeyName:= Trim( KeyName );
620
621 KeyValue:= line;
622 Delete( KeyValue, 1, EqualsPos );
623 KeyValue:= Trim( KeyValue );
624 end;
625end;
626
627Function ExtractNextValueNoTrim( var S: string;
628 const Separator: string ): string;
629Var
630 SeparatorPos: integer;
631Begin
632 SeparatorPos := Pos( Separator, S );
633 if SeparatorPos > 0 then
634 begin
635 Result := Copy( S, 1, SeparatorPos-1 );
636 Delete( S, 1, SeparatorPos + length( Separator ) - 1 );
637 end
638 else
639 begin
640 Result := S;
641 S := '';
642 end;
643end;
644
645Function ExtractNextValue( var S: string;
646 const Separator: string ): string;
647begin
648 Result := ExtractNextValueNoTrim( S, Separator );
649 Result := trim( Result );
650
651 // Remove quotes if present
652 if Result <> '' then
653 if Result[ 1 ] = DoubleQuote then
654 Delete( Result, 1, 1 );
655
656 if Result <> '' then
657 if Result[ length( Result ) ] = DoubleQuote then
658 Delete( Result, length( Result ), 1 );
659end;
660
661procedure GetNextValue( const S: String;
662 Var Index: longint;
663 Var Value: String;
664 const Seperator: Char );
665var
666 NextSeperatorPosition: longint;
667 StringLen: longint;
668begin
669 Value := '';
670 StringLen := Length( S );
671 if Index > StringLen then
672 exit;
673 NextSeperatorPosition := Index;
674 while NextSeperatorPosition < StringLen do
675 begin
676 if S[ NextSeperatorPosition ] = Seperator then
677 break;
678 inc( NextSeperatorPosition );
679 end;
680
681 if NextSeperatorPosition < StringLen then
682 begin
683 Value := Copy( S,
684 Index,
685 NextSeperatorPosition - Index );
686 Index := NextSeperatorPosition + 1;
687 end
688 else
689 begin
690 Value := Copy( S,
691 Index,
692 StringLen - Index + 1 );
693 Index := StringLen + 1;
694 end;
695 TrimRight( Value );
696end;
697
698Function IsDigit( const c: char ): boolean;
699Begin
700 Result:=( c>='0' ) and ( c<='9' );
701End;
702
703Function IsNonDigit( const c: char ): boolean;
704Begin
705 Result:=( c<'0' ) or ( c>'9' );
706End;
707
708Function IsAlpha( const c: char ): boolean;
709var
710 UppercaseC: char;
711Begin
712 UppercaseC := UpCase( c );
713 Result := ( UppercaseC >= 'A' ) and ( UppercaseC <= 'Z' );
714end;
715
716{$ifdef os2}
717// Returns true if s is only spaces (or empty)
718Function IsSpaces( const s: string ): boolean;
719Begin
720 Asm
721 MOV ESI,s // get address of s into ESI
722 MOV CL,[ESI] // get length of s
723 MOVZX ECX, CL // widen CL
724 INC ECX
725
726!IsSpacesLoop:
727 INC ESI // move to next char
728 DEC ECX
729 JE !IsSpacesTrue
730
731 MOV AL,[ESI] // load character
732 CMP AL,32 // is it a space?
733 JE !IsSpacesLoop // yes, go to next
734
735 // no, return false
736 MOV EAX, 0
737 JMP !IsSpacesDone
738
739!IsSpacesTrue:
740 MOV EAX, 1
741
742!IsSpacesDone:
743 LEAVE
744 RETN32 4
745 End;
746
747End;
748{$else}
749// Returns true if s is only spaces (or empty)
750Function IsSpaces( const s: string ): boolean;
751var
752 i: longint;
753Begin
754 for i := 1 to length( s ) do
755 begin
756 if s[ i ] <> ' ' then
757 begin
758 result := false;
759 exit;
760 end;
761 end;
762 result := true;
763end;
764{$endif}
765
766Function StrLeft0Pad( const n: integer; const width: integer ): string;
767Begin
768 Result:= IntToStr( n );
769 while length( Result )<width do
770 Result:= '0' +Result;
771End;
772
773// Returns true if s starts with start
774{$ifdef win32}
775Function StrStarts( const start: string; const s: string ): boolean;
776Var
777 i: integer;
778Begin
779 Result:= false;
780 if length( start ) > length( s ) then
781 exit;
782 for i:= 1 to length( start ) do
783 if UpCase( s[ i ] ) <> UpCase( start[ i ] ) then
784 exit;
785 Result:= true;
786End;
787
788{$else}
789
790Function StrStarts( const start: string; const s: string ): boolean;
791Begin
792 Asm
793 //Locals:
794 //START at [EBP+12]
795 //S at [EBP+8]
796
797 // First get and check lengths
798 MOV ESI,[EBP+12] // get address of start into ESI
799 MOV CL,[ESI] // get length of start (set remainder of CL to zero)
800 MOV EDI,[EBP+8] // get address of s into EDI
801 MOV DL,[EDI] // get length of s
802 CMP CL,DL
803 JBE !StartLengthOK
804
805 // start longer than s so false
806 MOV EAX, 0
807 LEAVE
808 RETN32 8
809
810!StartLengthOK:
811 INC ESI // skip ESI past length byte of start string
812
813 // get ending address of start into EDX
814 MOV EDX, ESI
815
816 MOVZX ECX, CL // widen CL
817 ADD EDX, ECX // ecx is length of start, add to edx
818
819 // get starting address of s
820 INC EDI // skip EDI past length byte of s
821
822 JMP !StartsLoop
823
824!StartsLoopStart:
825 MOV AL, [ESI] // get next char of start string
826 MOV BL, [EDI] // get next char of string
827
828 // Convert chars to uppercase
829 CMP AL,97
830 JB !Upcase1
831 CMP AL,122
832 JA !Upcase1
833 SUB AL,32 // convert lower to upper
834!Upcase1:
835
836 CMP BL,97
837 JB !Upcase2
838 CMP BL,122
839 JA !Upcase2
840 SUB BL,32 // convert lower to upper
841!Upcase2:
842
843 // Compare uppercased chars
844 CMP AL,BL
845 JE !StartsCharMatch
846 // different.
847 MOV EAX, 0
848 LEAVE
849 RETN32 8
850
851!StartsCharMatch:
852 INC ESI
853 INC EDI
854
855!StartsLoop:
856 CMP ESI, EDX // have we reached the end (EDX) of start string
857 JB !StartsLoopStart
858
859 // Match, return true
860 MOV EAX, 1
861 LEAVE
862 RETN32 8
863 End;
864end;
865{$endif}
866
867// Returns true if s ends with endstr (case insensitive)
868Function StrEnds( const endStr: string; const s: string ): boolean;
869Var
870 i, j: integer;
871Begin
872 Result:= false;
873 if Length( s ) < length( endStr ) then
874 exit;
875 j:= Length( s );
876 for i:= length( endstr ) downto 1 do
877 begin
878 if UpCase( s[ j ] ) <> UpCase( endStr[ i ] ) then
879 exit;
880 dec( j );
881 end;
882 Result:= true;
883End;
884
885Procedure RemoveSeparatorSpaces( var S: string;
886 const Separator:string );
887Var
888 SeparatorPos:integer;
889 NewString: string;
890Begin
891 NewString := '';
892 while S <> '' do
893 begin
894 SeparatorPos := pos( Separator, S );
895 if SeparatorPos > 0 then
896 begin
897 NewString := NewString
898 + trim( copy( S, 1, SeparatorPos - 1 ) )
899 + Separator;
900 Delete( S, 1, SeparatorPos );
901 end
902 else
903 begin
904 NewString := NewString + trim( S );
905 S := '';
906 end;
907 end;
908 S := NewString;
909End;
910
911Procedure AddToListString( Var S: string;
912 const NewValue: string;
913 const Separator: string );
914Begin
915 if trim( S )<>'' then
916 S:=S+Separator;
917 S:=S+NewValue;
918End;
919
920Function ListToString( List: TStrings;
921 const Separator: string ): string;
922Var
923 i: longint;
924Begin
925 Result:= '';
926 for i:= 0 to List.Count - 1 do
927 AddToListString( Result, List[ i ], Separator );
928End;
929
930procedure StringToList( S: String;
931 List: TStrings;
932 const Separator: string );
933var
934 Item: string;
935begin
936 List.Clear;
937 while S <> '' do
938 begin
939 Item:= ExtractNextValue( S, Separator );
940 List.Add( Item );
941 end;
942end;
943
944Function StrFirstWord( const S: String ): string;
945Var
946 SpacePos: longint;
947 temp: string;
948Begin
949 temp:= trimleft( S );
950 SpacePos:= pos( ' ', temp );
951 if SpacePos>0 then
952 Result:= Copy( temp, 1, SpacePos-1 )
953 else
954 Result:= temp;
955End;
956
957function FindCharFromEnd( const s: string;
958 const c: char ): longint;
959var
960 i: longint;
961begin
962 i := Length( s );
963 while i > 0 do
964 begin
965 if s[ i ] = c then
966 begin
967 Result := i;
968 exit;
969 end;
970 dec( i );
971 end;
972 result := 0;
973end;
974
975Function IncrementNumberedString( StartString: string ): string;
976Var
977 Number: string;
978 NewNumber: string;
979 i: integer;
980begin
981 // Extract any digits at the end of the string
982 i:= length( StartString );
983 Number:= '';
984 while i>0 do
985 begin
986 if isDigit( StartString[i] ) then
987 begin
988 Number:= StartString[i] + Number;
989 i:= i - 1;
990 end
991 else
992 break;
993 end;
994
995 if Number<>'' then
996 begin
997 // Found a numeric bit to play with
998 // Copy the first part
999 Result:= StrLeftWithout( StartString, length( Number ) );
1000 NewNumber:= StrLeft0Pad( StrToInt( Number ) + 1,
1001 length( Number ) );
1002 Result:= Result + NewNumber;
1003 end
1004 else
1005 // No build number, add a 1
1006 Result:= StartString + '1';
1007end;
1008
1009{$ifdef OS2}
1010
1011Function AnsiTrim( const S: AnsiString ): AnsiString;
1012Var
1013 i: longint;
1014Begin
1015 i:= 1;
1016 while i<length( S) do
1017 begin
1018 if S[ i ]<>' ' then
1019 break;
1020 inc( i );
1021 end;
1022 Result:= S;
1023 if i>1 then
1024 AnsiDelete( Result, 1, i-1 );
1025 i:= length( Result );
1026 while i>=1 do
1027 begin
1028 if S[ i ]<>' ' then
1029 break;
1030 dec( i );
1031 end;
1032 AnsiSetLength( Result, i );
1033End;
1034
1035Procedure AnsiParseConfigLine( const S: Ansistring;
1036 var keyName: Ansistring;
1037 var keyValue: Ansistring );
1038Var
1039 line: AnsiString;
1040 EqualsPos: longint;
1041Begin
1042 KeyName:= '';
1043 KeyValue:= '';
1044
1045 line:= AnsiTrim( S );
1046 EqualsPos:= AnsiPos( '=', line );
1047
1048 if ( EqualsPos>0 ) then
1049 begin
1050 KeyName:= AnsiCopy( line, 1, EqualsPos-1 );
1051 KeyName:= AnsiTrim( KeyName );
1052
1053 KeyValue:= AnsiCopy( line, EqualsPos+1, length( line )-EqualsPos );
1054 KeyValue:= AnsiTrim( KeyValue );
1055 end;
1056end;
1057
1058Function AnsiExtractNextValue( var CSVString: AnsiString;
1059 const Separator: AnsiString ): AnsiString;
1060Var
1061 SeparatorPos: integer;
1062Begin
1063 SeparatorPos:= AnsiPos( Separator, CSVString );
1064 if SeparatorPos>0 then
1065 begin
1066 Result:= AnsiCopy( CSVString, 1, SeparatorPos-1 );
1067 AnsiDelete( CSVString, 1, SeparatorPos + length( Separator ) - 1 );
1068 end
1069 else
1070 begin
1071 Result:= CSVString;
1072 CSVString:= '';
1073 end;
1074 Result:= AnsiTrim( Result );
1075 // Remove qyotes if present
1076 if ( Result[1] = chr(34) )
1077 and ( Result[ length(Result) ] = chr(34) ) then
1078 begin
1079 AnsiDelete( Result, 1, 1 );
1080 AnsiDelete( Result, length( Result ), 1 );
1081 Result:= AnsiTrim( Result );
1082 end;
1083end;
1084{$Endif}
1085
1086Procedure ReverseList( TheList:TStrings );
1087Var
1088 TempList: TStringList;
1089 i: integer;
1090Begin
1091 TempList:= TStringList.Create;
1092 for i:=TheList.count-1 downto 0 do
1093 begin
1094 TempList.AddObject( TheList.Strings[i],
1095 TheList.Objects[i] );
1096 end;
1097 TheList.Assign( TempList );
1098 TempList.Destroy;
1099end;
1100
1101Function FindStringInList( const TheString: string;
1102 TheList:TStrings ): longint;
1103Var
1104 i: longint;
1105Begin
1106 for i:=0 to TheList.count-1 do
1107 begin
1108 if StringsSame( TheString, TheList[ i ] ) then
1109 begin
1110 // found
1111 Result:=i;
1112 exit;
1113 end;
1114 end;
1115 Result:=-1;
1116End;
1117
1118Procedure MergeStringLists( Dest: TStringList;
1119 AdditionalList: TStringList );
1120var
1121 i: integer;
1122 s: string;
1123begin
1124 for i:= 0 to AdditionalList.Count - 1 do
1125 begin
1126 s:= AdditionalList[ i ];
1127 if FindStringInList( s, Dest ) = -1 then
1128 Dest.AddObject( s, AdditionalList.Objects[ i ] );
1129 end;
1130end;
1131
1132// ---------------------- PCHAR Utilities ---------------------------------------
1133
1134function StrNPas( const Ps: PChar; const Length: integer ): String;
1135var
1136 i: integer;
1137begin
1138 Result:= '';
1139 i:= 0;
1140 while ( Ps[ i ] <> #0 ) and ( i < Length ) do
1141 begin
1142 Result:= Result + Ps[ i ];
1143 inc( i );
1144 end;
1145end;
1146
1147Function PCharDiff( const a: PChar; const b: Pchar ): longword;
1148begin
1149 Result:= longword( a ) - longword( b );
1150end;
1151
1152Procedure CheckPCharSize( Var Text: PChar;
1153 const NeededSize: longword );
1154var
1155 temp: PChar;
1156 NewBufferSize: longword;
1157begin
1158 if ( NeededSize + 1 ) // + 1 to allow for null terminator
1159 > StrBufSize( Text ) then
1160 begin
1161 // allocate new buffer, double the size...
1162 NewBufferSize:= StrBufSize( Text ) * 2;
1163 // or if that's not enough...
1164 if NewBufferSize < ( NeededSize + 1 ) then
1165 // double what we are going to need
1166 NewBufferSize:= NeededSize * 2;
1167 temp:= StrAlloc( NewBufferSize );
1168
1169 // copy string to new buffer
1170 StrCopy( temp, Text );
1171 StrDispose( Text );
1172 Text:= temp;
1173 end;
1174end;
1175
1176Procedure AddAndResize( Var Text: PChar;
1177 const AddText: PChar );
1178begin
1179 CheckPCharSize( Text,
1180 strlen( Text )
1181 + strlen( AddText ) );
1182 StrCat( Text, AddText );
1183end;
1184
1185Procedure StrCopyAndResize( Var Dest: PChar;
1186 const Source: PChar );
1187begin
1188 CheckPCharSize( Dest, StrLen( Source ) );
1189 StrCopy( Dest, Source );
1190end;
1191
1192// trims spaces and carriage returns of the end of Text
1193procedure TrimWhitespace( Text: PChar );
1194var
1195 P: PChar;
1196 IsWhitespace: boolean;
1197 TheChar: Char;
1198begin
1199 P:= Text + StrLen( Text );
1200 while P > Text do
1201 begin
1202 dec( P );
1203 TheChar:= P^;
1204 IsWhitespace:= TheChar in [ ' ', #13, #10, #9 ];
1205 if not IsWhiteSpace then
1206 // done
1207 break;
1208 P[ 0 ]:= #0; // Do no use P^ :=
1209 end;
1210end;
1211
1212function TrimChars( const s: string;
1213 chars: TSetOfChars ): string;
1214var
1215 i: longint;
1216 j: longint;
1217begin
1218 i := 1;
1219 while i < Length( s ) do
1220 if s[ i ] in chars then
1221 inc( i )
1222 else
1223 break;
1224
1225 j := Length( s );
1226 while j > i do
1227 if s[ j ] in chars then
1228 dec( j )
1229 else
1230 break;
1231
1232 result := Copy( s, i, j - i + 1 );
1233end;
1234
1235procedure StrPCat( Var Dest: PChar;
1236 const StringToAdd: string );
1237var
1238 Index: longint;
1239 DestP: PChar;
1240begin
1241 CheckPCharSize( Dest,
1242 StrLen( Dest )
1243 + longword( Length( StringToAdd ) ) );
1244 DestP:= Dest + StrLen( Dest );
1245 for Index:= 1 to Length( StringToAdd ) do
1246 begin
1247 DestP[ 0 ]:= StringToAdd[ Index ]; // do not use DestP^ :=
1248 inc( DestP );
1249 end;
1250 DestP[ 0 ]:= #0; // Do not use DestP^ := #0; Under Sibyl at least, this writes *** 2 NULL BYTES!!! ***
1251end;
1252
1253Procedure TrimEndLines( const S: PChar );
1254var
1255 StringIndex: integer;
1256{$ifdef os2}
1257 p: pchar;
1258{$endif}
1259begin
1260 StringIndex:= strlen( S );
1261 while StringIndex > 0 do
1262 begin
1263 dec( StringIndex );
1264 if S[ StringIndex ] in [ #10, #13 ] then
1265 begin
1266{$ifdef win32}
1267 S[ StringIndex ]:= #0
1268{$else}
1269 p := S;
1270 p[ StringIndex ] := #0;
1271{$endif}
1272 end
1273 else
1274 break;
1275 end;
1276end;
1277
1278Function StrDupPas( const s: string ): PChar;
1279Begin
1280 Result:=StrAlloc( length( s )+1 );
1281 StrPCopy( Result, S );
1282// Result^:=s;
1283End;
1284
1285// Returns a copy of the first n chars of s
1286Function StrNDup( const s: PChar; const n: integer ): PChar;
1287Begin
1288 Result:= StrAlloc( n+1 );
1289 Result[ n ]:= '6';
1290 StrLCopy( Result, s, n );
1291End;
1292
1293// Returns a copy of the first line starting at lineStart
1294Function CopyFirstLine( const lineStart: PChar ): PChar;
1295Var
1296 lineEnd: PChar;
1297 lineLength: integer;
1298Begin
1299 // look for an end of line
1300 lineEnd:= strpos( lineStart, EndLine );
1301 if lineEnd <> nil then
1302 begin
1303 // found, line length is difference between line end position and start of line
1304 lineLength:= longword( lineEnd )-longword( lineStart ); // ugly but how else can it be done?
1305 Result:= StrNDup( lineStart, lineLength );
1306 exit;
1307 end;
1308
1309 // no eol found, return copy of remainder of string
1310 Result:= StrNew( lineStart );
1311end;
1312
1313// Returns next line p points to
1314Function NextLine( const p: PChar): PChar;
1315Var
1316 lineEnd: PChar;
1317Begin
1318 // look for an end of line
1319 lineEnd:=strpos( p, EndLine );
1320 if lineEnd<>nil then
1321 begin
1322 // Advance the linestart over the eol
1323 Result:=lineEnd+length( EndLine );
1324 exit;
1325 end;
1326
1327 // no eol found, return pointer to null term
1328 Result:=p+strlen( p );
1329end;
1330
1331{$ifdef os2}
1332Function CaseInsensitivePos( const a: string;
1333 const b: string ): longint;
1334var
1335 EndOfA: longword;
1336Begin
1337 Asm
1338 //Locals:
1339 //a at [EBP+12]
1340 //b at [EBP+8]
1341
1342 // First get and check lengths
1343 MOV ESI, a // get address of a into ESI
1344 MOV CL, [ESI] // get length of a
1345 MOV EDI, b // get address of b into EDI
1346 MOV DL, [EDI] // get length of b
1347 CMP CL, DL
1348 JBE !CIP_AFitsInB
1349
1350 // a longer than b so a can't be in b
1351
1352!CIP_NoMatch:
1353 MOV EAX, 0
1354 LEAVE
1355 RETN32 8
1356
1357!CIP_AFitsInB:
1358
1359 INC ESI // skip length byte in a
1360 INC EDI // skip length byte of b
1361
1362 // get ending address of b into EDX
1363 MOVZX EDX, DL // widen DL
1364 ADD EDX, EDI // add start of b
1365
1366 // get ending address of a into EndOfA
1367 MOVZX ECX, CL // widen CL
1368 ADD ECX, ESI // add start of a
1369 MOV EndOfA, ECX // store to EndOfA
1370
1371 MOV ECX, EDI // set start of current match to start of b
1372
1373 // ESI: current search point in a
1374 // EDI: current search point in b
1375 // EDX: end of b
1376 // ECX: start of current match
1377 // available: eax, ebx
1378
1379 JMP !CIP_Loop
1380
1381!CIP_LoopStart:
1382 CMP EDI, EDX
1383 JE !CIP_NoMatch // run out of b
1384
1385 MOV AL, [ESI] // get next char of a
1386 INC ESI // next in a
1387
1388 MOV BL, [EDI] // get next char of b
1389 INC EDI // next in b
1390
1391 // Convert chars to uppercase
1392
1393 CMP AL, 97
1394 JB !CIP_Upcase1
1395 CMP AL, 122
1396 JA !CIP_Upcase1
1397 SUB AL, 32 // convert lower to upper
1398!CIP_Upcase1:
1399
1400 CMP BL,97
1401 JB !CIP_Upcase2
1402 CMP BL,122
1403 JA !CIP_Upcase2
1404 SUB BL,32 // convert lower to upper
1405!CIP_Upcase2:
1406
1407 // Compare uppercased chars
1408 CMP AL,BL
1409 JE !CIP_Loop
1410
1411 // different.
1412
1413 // Back to start of match + 1
1414 INC ECX // inc start of match
1415 MOV EDI, ECX // back to start of match in b
1416 MOV ESI, a // back to start of a
1417 INC ESI // skip length
1418 JMP !CIP_LoopStart
1419
1420!CIP_Loop:
1421 // same
1422
1423 CMP ESI, EndOfA // have we reached the end of a
1424 JB !CIP_LoopStart
1425
1426 // Match, return position
1427 SUB ECX, [EBP+8] // position = ( start of match ) - ( start of b ) + 1
1428 MOV EAX, ECX
1429 LEAVE
1430 RETN32 8
1431 End;
1432end;
1433{$else}
1434Function CaseInsensitivePos( const a: string;
1435 const b: string ): longint;
1436begin
1437 Result := Pos( UpperCase( a ), Uppercase( b ) );
1438end;
1439
1440{$endif}
1441
1442Function BoolToStr( const b: boolean ): string;
1443begin
1444 if b then
1445 Result := 'True'
1446 else
1447 Result := 'False';
1448end;
1449
1450// Return true if param matches the form
1451// /Flag:value
1452// dash (-) can be used instead of slash (/)
1453// colon can be omitted
1454function MatchValueParam( const Param: string;
1455 const Flag: string;
1456 var Value: string ): boolean;
1457begin
1458 Result := false;
1459
1460 if Param = '' then
1461 exit;
1462
1463 if ( Param[ 1 ] <> '/' )
1464 and ( Param[ 1 ] <> '-' ) then
1465 exit;
1466
1467 if not StringsSame( Copy( Param, 2, Length( Flag ) ),
1468 Flag ) then
1469 exit;
1470
1471 Result := true;
1472
1473 Value := StrRightFrom( Param, 2 + Length( Flag ) );
1474 if Value <> '' then
1475 if Value[ 1 ] = ':' then
1476 Delete( Value, 1, 1 );
1477end;
1478
1479// Return true if param matches the form
1480// /Flag
1481// dash (-) can be used instead of slash (/)
1482function MatchFlagParam( const Param: string;
1483 const Flag: string ): boolean;
1484begin
1485 Result := false;
1486
1487 if Param = '' then
1488 exit;
1489
1490 if ( Param[ 1 ] <> '/' )
1491 and ( Param[ 1 ] <> '-' ) then
1492 exit;
1493
1494 Result := StringsSame( StrRightFrom( Param, 2 ),
1495 Flag );
1496end;
1497
1498Initialization
1499 InitHexDigitMap;
1500End.
Note: See TracBrowser for help on using the repository browser.