diff options
Diffstat (limited to 'docview/components/richtext/ACLStringUtility.pas')
| -rw-r--r-- | docview/components/richtext/ACLStringUtility.pas | 1769 |
1 files changed, 1769 insertions, 0 deletions
diff --git a/docview/components/richtext/ACLStringUtility.pas b/docview/components/richtext/ACLStringUtility.pas new file mode 100644 index 00000000..f60aeed0 --- /dev/null +++ b/docview/components/richtext/ACLStringUtility.pas @@ -0,0 +1,1769 @@ +Unit ACLStringUtility; + +{$mode objfpc}{$H+} + +Interface + +Uses + Classes; + +const + CharTAB = chr(9); + CharCR = chr(13); + CharLF = chr(10); + CharSingleQuote = ''''; + CharDoubleQuote = '"'; + + EndLine = CharCR + CharLF; + + StrTAB = CharTAB; + StrCR = CharCR; + StrLF = CharLF; + StrCRLF = StrCR + StrLF; + StrSingleQuote = CharSingleQuote; + StrDoubleQuote = CharDoubleQuote; + +type + TSetOfChars = set of char; + + TCharMatchFunction = function( const a: char ): boolean; + + + TSerializableStringList = class(TObject) + private + stringList: TStringList; + public + constructor Create; + destructor Destroy; override; + function getCount : LongInt; + function get(const anIndex : LongInt) : String; + function getSerializedString : String; + procedure add(const aString : String); + procedure readValuesFromSerializedString(const aSerializedString : String); + end; + + +// Returns true if c is a digit 0..9 +Function IsDigit( const c: char ): boolean; + +// Returns true if c is not a digit +Function IsNonDigit( const c: char ): boolean; + +// Returns true if c is an alphabetic character a..z A..Z +Function IsAlpha( const c: char ): boolean; + +// Returns true if s is only spaces (or empty) +Function IsSpaces( const s: string ): boolean; + +// ---------------------- Numeric conversions --------------------------------------- + +// Converts a hex string to a longint +// May be upper or lower case +// Does not allow a sign +// Is not forgiving as StrToInt: all characters +// must be valid hex chars. +function HexToInt( s: string ): longint; + +// Given a string with a number on the end, increments that +// number by one. +// If there is no number it adds a one. +// If the number is left zero padded then the result is similarly +// padded +Function IncrementNumberedString( StartString: string ): string; + +// ---------------------- Pascal String Utilities --------------------------------------- + +Function CaseInsensitivePos( const a: string; + const b: string ): longint; + +// Looks for occurrences of QuoteChar and inserts a duplicate +Function InsertDuplicateChars( const S: string; + const QuoteChar: char ): string; + +// Returns index of SubString in S, case-insensitve +Function FindSubstring( const SubString: string; + const S: string ): integer; + +// Returns characters at the front of S that match according +// to a given function... for example, IsDigit, IsNonDigit, IsAlpha +Function MatchLeadingChars( + const S: string; + MatchFunction: TCharMatchFunction ): string; + +// Same as MatchLeadingChars, but removes the matching chars from S +Function ExtractLeadingChars( + Var S: string; + MatchFunction: TCharMatchFunction ): string; + +// Case insensitive compare +Function StringsSame( const a, b: string ): boolean; + +// Quoting + +// Note: these functions do not check for existing quotes within +// the string, they only add or delete characters at the end. + +// Returns S in single quotes +Function StrQuote( const s: string ): string; + +// Returns S without single quotes +Function StrUnQuote( const s: string ): string; + +// Returns S in double quotes, +// with any double quotes in S duplicated +Function StrFullDoubleQuote( const s: string ): string; + +// Returns S without double quotes +Function StrUnDoubleQuote( const s: string ): string; +// Returns aString enclosed in single quotes +Function StrInSingleQuotes(const aString : String) : String; +// Returns aString enclosed in double quotes +Function StrInDoubleQuotes(const aString : String) : String; + + +// + +// Substitutes given character - placing all occurences of AFind char. +Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string; + +// Returns the count rightmost chars of S +Function StrRight( const S:string; const count:integer ):string; + +// Returns the remainder of S starting at start +Function StrRightFrom( const S:string; const start:integer ):string; + +// Returns the count leftmost chars of S +Function StrLeft( const S:string; const count:integer ):string; + +// Returns S minus count characters from the right +Function StrLeftWithout( const S:string; const count:integer ):string; + +// Returns S with leftCount chars removed from the left and +// rightCount chars removed from the right. +Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string; + +// Produces a string from n padded on the left with 0's +// to width chars +Function StrLeft0Pad( const n: integer; const width: integer ): string; + +// Returns true if s starts with start (case insensitive) +Function StrStarts( const start: string; const s: string ): boolean; + +// Returns true if s ends with endstr (case insensitive) +Function StrEnds( const endStr: string; const s: string ): boolean; + +// Returns first word from S +Function StrFirstWord( const S: String ): string; + +// prefixes all occurences of one of the chars in aReceiver with +// anEscape char if the escapeChar itself is found, then it is doubled +Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String; + +// Trims punctuation characters from start and end of s +// such as braces, periods, commas. +procedure TrimPunctuation( var s: string ); + +// Returns true if S contains a URL. MAY MODIFY CONTENTS OF S +function CheckAndEncodeURL( var s: string ): boolean; + +// ------------ Seperated value utilities --------------------- + +// Returns the next item starting at Index. Spaces are the separator, +// unless the item is quoted with QuoteChar, in which case it looks for +// a closing quote. Occurrences of the QuoteChar in the item itself, +// can be escaped with a duplicate, e.g. "He said ""bok""" +Procedure GetNextQuotedValue( + const S: string; + var Index: longint; + var Value: string; + const QuoteChar: char ); + +procedure GetNextValue( + const S: String; + var Index: longint; + var Value: string; + const Seperator: char ); + +// Extract all fields in a String delimited by whitespace (blank or tab). +// use double quotes if you need blanks in the strings +Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String); + +// Extract all fields in a String given a set of delimiter characters and +// an optional escape character usable to escape field delimits. +// Example: +// StrExtractStrings('1x2x3\x4', 'x', '\') -> +// returns 4 strings: '1', '', '2' and '3x4' +procedure StrExtractStrings(var aResult : TStrings; const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char); + +// Removes and returns the first value in a separated +// value list (removes quotes if found) +Function ExtractNextValue( + var S: string; + const Separator: string ): string; + +Function ExtractNextValueNoTrim( + var S: string; + const Separator: string ): string; + + +// Parses a line of the form +// key = value into it's components +Procedure ParseConfigLine( const S: string; + var KeyName: string; + var KeyValue: string ); + +// Removes spaces around the separator in the given string +Procedure RemoveSeparatorSpaces( var S: string; const Separator:string ); + +{$ifdef os2} +// ------------ Ansi String utilities ------------------------ + +// Right & left trim that works with AnsiStrings. +Function AnsiTrim( const S: AnsiString ): AnsiString; + +Procedure AnsiParseConfigLine( const S: Ansistring; + var keyName: Ansistring; + var keyValue: Ansistring ); + +Function AnsiExtractNextValue( var CSVString: AnsiString; + const Separator: AnsiString ): AnsiString; + +{$endif} + +// ------------- Lists of strings, and strings as lists ----------- + +// Adds NewValue to S as a separated list +Procedure AddToListString( Var S: string; + const NewValue: string; + const Separator: string ); + +Function ListToString( List: TStrings; + const Separator: string ): string; + +procedure StringToList( S: String; + List: TStrings; + const Separator: string ); + +// Reverse the given list. It must be set to not sorted +Procedure ReverseList( TheList: TStrings ); + +// Sort the given list into reverse alphabetical order +//Procedure ReverseSortList( TheList: TStringList ); + +// Find the given string in the given list, using +// case insensitive searching (and trimming) +// returns -1 if not found +Function FindStringInList( const TheString: string; + TheList:TStrings ):longint; + +Procedure MergeStringLists( Dest: TStringList; + AdditionalList: TStringList ); + +// ---------------------- PCHAR Utilities --------------------------------------- + +function StrNPas( const ps: PChar; const Length: integer ): String; + +// Returns a - b +Function PCharDiff( const a: PChar; const b: Pchar ): longword; + +// trims spaces and carriage returns of the end of Text +procedure TrimWhitespace( Text: PChar ); + + +function TrimChars( const s: string; + chars: TSetOfChars ): string; + +// Concatenates a pascal string onto a PCHar string +// Resizes if needed +procedure StrPCat( Var Dest: PChar; + const StringToAdd: string ); + +// Trim endlines (#10 or #13) off the end of +// the given string. +Procedure TrimEndLines( const S: PChar ); + +// Allocates enough memory for a copy of s as a PChar +// and copies s to it. +Function StrDupPas( const s: string ): PChar; + +// Returns a copy of the first n chars of s +Function StrNDup( const s: PChar; const n: integer ): PChar; + +// Returns a copy of the first line starting at lineStart +Function CopyFirstLine( const lineStart: PChar ): PChar; + +// Returns next line p points to +Function NextLine( const p: PChar): PChar; + +// Concatentate AddText to Text. Reallocate and expand +// Text if necessary. This is a size-safe StrCat +Procedure AddAndResize( Var Text: PChar; + const AddText: PChar ); + +// Copy Source to Dest. Reallocate and expand +// Dest if necessary. This is a size-safe StrCopy +Procedure StrCopyAndResize( Var Dest: PChar; + const Source: PChar ); + +// Return "True" or "False" +Function BoolToStr( const b: boolean ): string; + +// Return true if param matches the form +// /Flag:value +// dash (-) can be used instead of slash (/) +// colon can be omitted +function MatchValueParam( const Param: string; + const Flag: string; + var Value: string ): boolean; + +// Return true if param matches the form +// /Flag +// dash (-) can be used instead of slash (/) +function MatchFlagParam( const Param: string; const Flag: string ): boolean; + +// returns true if the String starts with the provided one +// this is case INsensitive +function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String): Boolean; + +// returns true if the String ends with the provided one +// this is case INsensitive +function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean; + +function StrIsEmptyOrSpaces(const AText: string): boolean; + +implementation + +Uses + SysUtils + ,nvUtilities + ; + +// ---------------------- Pascal String Utilities --------------------------------------- + +Procedure SkipChar( const S: string; + Var index: longint; + const C: Char ); +begin + while Index <= Length( S ) do + begin + if S[ Index ] <> C then + break; + inc( Index ); + end; +end; + + +Procedure GetNextQuotedValue( + const S: string; + var Index: longint; + var Value: string; + const QuoteChar: char ); +begin + Value := ''; + SkipChar( S, Index, ' ' ); + if Index > Length( S ) then + exit; + + if S[ Index ] <> QuoteChar then + begin + // not quoted, go to next space + while Index <= Length( S ) do + begin + if S[ Index ] = ' ' then + break; + Value := Value + S[ Index ]; + inc( Index ); + end; + // skip following spaces + SkipChar( S, Index, ' ' ); + exit; + end; + + // quoted string + inc( Index ); // skip opening quote + + while Index <= Length( S ) do + begin + if S[ Index ] = QuoteChar then + begin + inc( index ); // skip closing quote + if Index > Length( S ) then + break; // done + if S[ Index ] <> QuoteChar then + break; // done + + // escaped quote e.g "" so we do want it. + end; + Value := Value + S[ Index ]; + inc( Index ); + end; + + SkipChar( S, Index, ' ' ); + +end; + +Function InsertDuplicateChars( const S: string; + const QuoteChar: char ): string; +var + i: integer; +begin + Result := ''; + for i := 1 to Length( S ) do + begin + Result := Result + S[ i ]; + if S[ i ] = QuoteChar then + Result := Result + QuoteChar; // insert duplicate + end; +end; + +Function FindSubstring( const SubString: string; + const S: string ): integer; +begin + Result := Pos( Uppercase( SubString ), + Uppercase( S ) ); +end; + +Function MatchLeadingChars( + const S: string; + MatchFunction: TCharMatchFunction ): string; +var + i: integer; + TheChar: char; +begin + Result:= ''; + i := 1; + while i <= Length( S ) do + begin + TheChar:= S[ i ]; + if not MatchFunction( TheChar ) then + // found a non matching char. Stop looking + break; + Result:= Result + TheChar; + inc( i ); + end; +end; + +Function ExtractLeadingChars( + Var S: string; + MatchFunction: TCharMatchFunction ): string; +begin + Result := MatchLeadingChars( s, MatchFunction ); + if Length( Result ) > 0 then + // remove matching section from string + Delete( S, 1, Length( Result ) ); +end; + +// Hex conversion: sheer extravagance. Conversion from +// a hex digit char to int is done by creating a lookup table +// in advance. +var + MapHexDigitToInt: array[ Chr( 0 ) .. Chr( 255 ) ] of longint; + +procedure InitHexDigitMap; +var + c: char; + IntValue: longint; +begin + for c := Chr( 0 ) to Chr( 255 ) do + begin + IntValue := -1; + if ( c >= '0' ) + and ( c <= '9' ) then + IntValue := Ord( c ) - Ord( '0' ); + + if ( Upcase( c ) >= 'A' ) + and ( Upcase( c ) <= 'F' ) then + IntValue := 10 + Ord( Upcase( c ) ) - Ord( 'A' ); + + MapHexDigitToInt[ c ] := IntValue; + end; +end; + +function HexDigitToInt( c: char ): longint; +begin + Result := MapHexDigitToInt[ c ]; + if Result = -1 then + raise EConvertError.Create( 'Invalid hex char: ' + c ); +end; + +function HexToInt( s: string ): longint; +var + i: integer; +begin + if Length( s ) = 0 then + raise EConvertError.Create( 'No chars in hex string' ); + Result := 0; + for i:= 1 to Length( s ) do + begin + Result := Result shl 4; + inc( Result, HexDigitToInt( s[ i ] ) ); + end; +end; + +Function StringsSame( const a, b: string ): boolean; +begin + Result:= CompareText( a, b ) = 0; +end; + +// Returns S in single quotes +Function StrQuote( const s: string ): string; +begin + Result := StrSingleQuote + s + StrSingleQuote; +end; + +// Returns S without double quotes +Function StrUnQuote( const s: string ): string; +begin + Result := S; + if S = '' then + exit; + + if Result[ 1 ] = StrSingleQuote then + Delete( Result, 1, 1 ); + + if Result = '' then + exit; + + if Result[ Length( Result ) ] = StrSingleQuote then + Delete( Result, Length( Result ), 1 ); +end; + +Function StrFullDoubleQuote( const s: string ): string; +begin + Result := StrDoubleQuote + + InsertDuplicateChars( s, '"' ) + + StrDoubleQuote; +end; + +// Returns S without double quotes +Function StrUnDoubleQuote( const s: string ): string; +begin + Result := S; + if S = '' then + exit; + + if Result[ 1 ] = StrDoubleQuote then + Delete( Result, 1, 1 ); + + if Result = '' then + exit; + + if Result[ Length( Result ) ] = StrDoubleQuote then + Delete( Result, Length( Result ), 1 ); +end; + +Function StrInSingleQuotes(const aString : String) : String; +begin + Result := StrSingleQuote + aString + StrSingleQuote; +end; + +Function StrInDoubleQuotes(const aString : String) : String; +begin + Result := StrDoubleQuote + aString + StrDoubleQuote; +end; + +Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string; +Var + i: longint; +Begin + Result:= S; + for i:=1 to length( S ) do + if Result[ i ] = Find then + Result[ i ]:= Replace; +End; + +Function StrRight( const S:string; const count:integer ):string; +Begin + if count>=length(s) then + begin + Result:=S; + end + else + begin + Result:=copy( S, length( s )-count+1, count ); + end; +end; + +Function StrLeft( const S:string; const count:integer ):string; +Begin + if count>=length(s) then + Result:=S + else + Result:=copy( S, 1, count ); +end; + +// Returns S minus count characters from the right +Function StrLeftWithout( const S:string; const count:integer ):string; +Begin + Result:= copy( S, 1, length( S )-count ); +End; + +Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string; +Begin + Result:= S; + Delete( Result, 1, leftCount ); + Delete( Result, length( S )-rightCount, rightCount ); +End; + +Function StrRightFrom( const S:string; const start:integer ):string; +Begin + Result:= copy( S, start, length( S )-start+1 ); +end; + +Procedure ParseConfigLine( const S: string; + var keyName: string; + var keyValue: string ); +Var + line: String; + EqualsPos: longint; +Begin + KeyName:= ''; + KeyValue:= ''; + + line:= trim( S ); + EqualsPos:= Pos( '=', line ); + + if ( EqualsPos>0 ) then + begin + KeyName:= line; + Delete( KeyName, EqualsPos, length( KeyName )-EqualsPos+1 ); + KeyName:= Trim( KeyName ); + + KeyValue:= line; + Delete( KeyValue, 1, EqualsPos ); + KeyValue:= Trim( KeyValue ); + end; +end; + +Function ExtractNextValueNoTrim( var S: string; + const Separator: string ): string; +Var + SeparatorPos: integer; +Begin + SeparatorPos := Pos( Separator, S ); + if SeparatorPos > 0 then + begin + Result := Copy( S, 1, SeparatorPos-1 ); + Delete( S, 1, SeparatorPos + length( Separator ) - 1 ); + end + else + begin + Result := S; + S := ''; + end; +end; + +Function ExtractNextValue( var S: string; + const Separator: string ): string; +begin + Result := ExtractNextValueNoTrim( S, Separator ); + Result := trim( Result ); + + // Remove quotes if present + if Result <> '' then + if Result[ 1 ] = StrDoubleQuote then + Delete( Result, 1, 1 ); + + if Result <> '' then + if Result[ length( Result ) ] = StrDoubleQuote then + Delete( Result, length( Result ), 1 ); +end; + +procedure GetNextValue( const S: String; + Var Index: longint; + Var Value: String; + const Seperator: Char ); +var + NextSeperatorPosition: longint; + StringLen: longint; +begin + Value := ''; + StringLen := Length( S ); + if Index > StringLen then + exit; + NextSeperatorPosition := Index; + while NextSeperatorPosition < StringLen do + begin + if S[ NextSeperatorPosition ] = Seperator then + break; + inc( NextSeperatorPosition ); + end; + + if NextSeperatorPosition < StringLen then + begin + Value := Copy( S, + Index, + NextSeperatorPosition - Index ); + Index := NextSeperatorPosition + 1; + end + else + begin + Value := Copy( S, + Index, + StringLen - Index + 1 ); + Index := StringLen + 1; + end; + TrimRight( Value ); +end; + +Procedure StrExtractStringsQuoted(Var aResult: TStrings; const aReceiver: String); +Var + tmpState : (WHITESPACE, INSIDE, START_QUOTE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE); + tmpCurrentParsePosition : Integer; + tmpCurrentChar : Char; + tmpPart : String; + +Begin + if (length(aReceiver) < 1) then exit; + + tmpState := WHITESPACE; + tmpPart := ''; + + tmpCurrentParsePosition := 1; + + for tmpCurrentParsePosition:=1 to length(aReceiver) do + begin + tmpCurrentChar := aReceiver[tmpCurrentParsePosition]; + + Case tmpCurrentChar of + ' ', StrTAB : + begin + + Case tmpState of + + WHITESPACE : + begin + // nothing + end; + + INSIDE : + begin + aResult.add(tmpPart); + tmpPart := ''; + tmpState := WHITESPACE; + end; + + INSIDE_QUOTED : + begin + tmpPart := tmpPart + tmpCurrentChar; + end; + + START_QUOTE : + begin + tmpPart := tmpPart + tmpCurrentChar; + tmpState := INSIDE_QUOTED; + end; + + INSIDE_QUOTED_START_QUOTE : + begin + aResult.add(tmpPart); + tmpPart := ''; + tmpState := WHITESPACE; + end; + end; + end; + + StrDoubleQuote : + begin + + Case tmpState of + + WHITESPACE : + begin + tmpState := START_QUOTE; + end; + + INSIDE : + begin + aResult.add(tmpPart); + tmpPart := ''; + tmpState := START_QUOTE; + end; + + INSIDE_QUOTED : + begin + tmpState := INSIDE_QUOTED_START_QUOTE; + end; + + START_QUOTE : + begin + tmpState := INSIDE_QUOTED_START_QUOTE; + end; + + INSIDE_QUOTED_START_QUOTE : + begin + tmpPart := tmpPart + tmpCurrentChar; + tmpState := INSIDE_QUOTED; + end; + end; + end; + + else + begin + Case tmpState of + + WHITESPACE : + begin + tmpPart := tmpPart + tmpCurrentChar; + tmpState := INSIDE; + end; + + INSIDE, INSIDE_QUOTED : + begin + tmpPart := tmpPart + tmpCurrentChar; + end; + + START_QUOTE : + begin + tmpPart := tmpPart + tmpCurrentChar; + tmpState := INSIDE_QUOTED; + end; + + INSIDE_QUOTED_START_QUOTE : + begin + aResult.add(tmpPart); + tmpPart := tmpCurrentChar; + tmpState := INSIDE; + end; + end; + end; + + end; + end; + + Case tmpState of + WHITESPACE, START_QUOTE : {nothing to do}; + + INSIDE, INSIDE_QUOTED, INSIDE_QUOTED_START_QUOTE : + begin + aResult.add(tmpPart); + end; + end; +end; + +Procedure PrivateStrExtractStrings( Var aResult: TStrings; + const aReceiver: String; + const aSetOfChars: TSetOfChars; + const anEscapeChar: char; + const anIgnoreEmptyFlag : boolean); +Var + i : Integer; + tmpChar,tmpNextChar : Char; + tmpPart: String; +Begin + if (length(aReceiver) < 1) then exit; + + tmpPart := ''; + + i := 1; + while i <= length(aReceiver) do + begin + tmpChar := aReceiver[i]; + if i < length(aReceiver) then + tmpNextChar := aReceiver[i+1] + else + tmpNextChar := #0; + + if (tmpChar = anEscapeChar) and (tmpNextChar = anEscapeChar) then + begin + tmpPart := tmpPart + anEscapeChar; + i := i + 2; + end + else + if (tmpChar = anEscapeChar) and (tmpNextChar in aSetOfChars) then + begin + tmpPart := tmpPart + tmpNextChar; + i := i + 2; + end + else + begin + if (tmpChar in aSetOfChars) then + begin + if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then + aResult.add(tmpPart); + tmpPart := ''; + i := i + 1; + end + else + begin + tmpPart := tmpPart + tmpChar; + i := i + 1; + end; + end; { if/else } + end; + + if (NOT anIgnoreEmptyFlag) OR ('' <> tmpPart) then + begin + aResult.add(tmpPart); + end; +end; + +procedure StrExtractStrings(Var aResult: TStrings; Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char); +begin + PrivateStrExtractStrings(aResult, aReceiver, aSetOfChars, anEscapeChar, false); +end; + + +Function IsDigit( const c: char ): boolean; +Begin + Result:=( c>='0' ) and ( c<='9' ); +End; + +Function IsNonDigit( const c: char ): boolean; +Begin + Result:=( c<'0' ) or ( c>'9' ); +End; + +Function IsAlpha( const c: char ): boolean; +var + UppercaseC: char; +Begin + UppercaseC := UpCase( c ); + Result := ( UppercaseC >= 'A' ) and ( UppercaseC <= 'Z' ); +end; + +{$ifdef os2} +// Returns true if s is only spaces (or empty) +Function IsSpaces( const s: string ): boolean; +Begin + Asm + MOV ESI,s // get address of s into ESI + MOV CL,[ESI] // get length of s + MOVZX ECX, CL // widen CL + INC ECX + +!IsSpacesLoop: + INC ESI // move to next char + DEC ECX + JE !IsSpacesTrue + + MOV AL,[ESI] // load character + CMP AL,32 // is it a space? + JE !IsSpacesLoop // yes, go to next + + // no, return false + MOV EAX, 0 + JMP !IsSpacesDone + +!IsSpacesTrue: + MOV EAX, 1 + +!IsSpacesDone: + LEAVE + RETN32 4 + End; + +End; +{$else} +// Returns true if s is only spaces (or empty) +Function IsSpaces( const s: string ): boolean; +var + i: longint; +Begin + for i := 1 to length( s ) do + begin + if s[ i ] <> ' ' then + begin + result := false; + exit; + end; + end; + result := true; +end; +{$endif} + +Function StrLeft0Pad( const n: integer; const width: integer ): string; +Begin + Result:= IntToStr( n ); + while length( Result )<width do + Result:= '0' +Result; +End; + +// Returns true if s starts with start +Function StrStarts( const start: string; const s: string ): boolean; +Var + i: integer; +Begin + Result:= false; + if length( start ) > length( s ) then + exit; + for i:= 1 to length( start ) do + if UpCase( s[ i ] ) <> UpCase( start[ i ] ) then + exit; + Result:= true; +End; + +// Returns true if s ends with endstr (case insensitive) +Function StrEnds( const endStr: string; const s: string ): boolean; +Var + i, j: integer; +Begin + Result:= false; + if Length( s ) < length( endStr ) then + exit; + j:= Length( s ); + for i:= length( endstr ) downto 1 do + begin + if UpCase( s[ j ] ) <> UpCase( endStr[ i ] ) then + exit; + dec( j ); + end; + Result:= true; +End; + +Procedure RemoveSeparatorSpaces( var S: string; + const Separator:string ); +Var + SeparatorPos:integer; + NewString: string; +Begin + NewString := ''; + while S <> '' do + begin + SeparatorPos := pos( Separator, S ); + if SeparatorPos > 0 then + begin + NewString := NewString + + trim( copy( S, 1, SeparatorPos - 1 ) ) + + Separator; + Delete( S, 1, SeparatorPos ); + end + else + begin + NewString := NewString + trim( S ); + S := ''; + end; + end; + S := NewString; +End; + +Procedure AddToListString( Var S: string; + const NewValue: string; + const Separator: string ); +Begin + if trim( S )<>'' then + S:=S+Separator; + S:=S+NewValue; +End; + +Function ListToString( List: TStrings; + const Separator: string ): string; +Var + i: longint; +Begin + Result:= ''; + for i:= 0 to List.Count - 1 do + AddToListString( Result, List[ i ], Separator ); +End; + +procedure StringToList( S: String; + List: TStrings; + const Separator: string ); +var + Item: string; +begin + List.Clear; + while S <> '' do + begin + Item:= ExtractNextValue( S, Separator ); + List.Add( Item ); + end; +end; + +Function StrFirstWord( const S: String ): string; +Var + SpacePos: longint; + temp: string; +Begin + temp:= trimleft( S ); + SpacePos:= pos( ' ', temp ); + if SpacePos>0 then + Result:= Copy( temp, 1, SpacePos-1 ) + else + Result:= temp; +End; + +Function StrEscapeAllCharsBy(Const aReceiver: String; const aSetOfChars: TSetOfChars; const anEscapeChar: char): String; +Var + i : Integer; + tmpChar : Char; +Begin + Result := ''; + + for i := 1 To length(aReceiver) do + begin + tmpChar := aReceiver[i]; + + if (tmpChar = anEscapeChar) or (tmpChar IN aSetOfChars) then + result := result + anEscapeChar + tmpChar + else + result := result + tmpChar; + end; +end; + +const + StartPunctuationChars: set of char = + [ '(', '[', '{', '<', '''', '"' ]; + + EndPunctuationChars: set of char = + [ ')', ']', '}', '>', '''', '"', '.', ',', ':', ';', '!', '?' ]; + +procedure TrimPunctuation( var s: string ); +var + ChangesMade: boolean; + c: Char; +begin + while Length(s) > 0 do + begin + ChangesMade := false; + c := s[1]; + if c in StartPunctuationChars then + begin + ChangesMade := true; + Delete(s, 1, 1); + end; + + if Length(s) = 0 then + exit; + + c := s[Length(s)]; + if c in EndPunctuationChars then + begin + ChangesMade := true; + Delete(s, Length(s), 1); + end; + + if not ChangesMade then + exit; // done + end; +end; + +function IsDomainName( const s: string; StartingAt: longint ): boolean; +var + DotPos: longint; + t: string; +begin + Result := false; + t := Copy(s, StartingAt+1, Length(s)); + + // must be a dot in the domain... + DotPos := pos('.', t); + if DotPos = 0 then + // nope + exit; + + // must be some text between start and dot, + // and between dot and end + // ie. a.b not .b or a. + + if DotPos = Length(t) then + // no b; + exit; + + Result := true; +end; + +function IsEmailAddress( const s: string ): boolean; +var + AtPos: longint; + SecondAtPos: longint; +begin + result := false; + // must be a @... + AtPos := pos('@', s); + if AtPos = 0 then + // no @ + exit; + if AtPos = 1 then + // can't be the first char though + exit; + + // there is? There must be only one though... + SecondAtPos := LastDelimiter('@', s); + if (SecondAtPos <> AtPos) then + // there's a second @ + exit; + + Result := IsDomainName( s, AtPos + 1 ); +end; + +function CheckAndEncodeURL( var s: string ): boolean; + // simple userfriendly routine + function StartsWith(const s:string; const text: string): boolean; + begin + Result := pos(text, s) = 1; + end; + +begin + + if StartsWith(s, 'www.') then + begin + if not IsDomainName( s, 4 ) then + exit; + Insert('http://', s, 1); + Result := true; + exit; + end; + + if StartsWith(s, 'ftp.') then + begin + if not IsDomainName( s, 4 ) then + exit; + Insert('ftp://', s, 1); + Result := true; + exit; + end; + + if StartsWith(s, 'http://' ) + or StartsWith(s, 'https://' ) + or StartsWith(s, 'ftp://' ) + or StartsWith(s, 'mailto:' ) + or StartsWith(s, 'news:' ) then + begin + Result := true; + exit; + end; + + if IsEmailAddress( s ) then + begin + Insert('mailto:', s, 1); + Result := true; + exit; + end; + + Result := false; +end; + +Function IncrementNumberedString( StartString: string ): string; +Var + Number: string; + NewNumber: string; + i: integer; +begin + // Extract any digits at the end of the string + i:= length( StartString ); + Number:= ''; + while i>0 do + begin + if isDigit( StartString[i] ) then + begin + Number:= StartString[i] + Number; + i:= i - 1; + end + else + break; + end; + + if Number<>'' then + begin + // Found a numeric bit to play with + // Copy the first part + Result:= StrLeftWithout( StartString, length( Number ) ); + NewNumber:= StrLeft0Pad( StrToInt( Number ) + 1, + length( Number ) ); + Result:= Result + NewNumber; + end + else + // No build number, add a 1 + Result:= StartString + '1'; +end; + +{$ifdef OS2} + +Function AnsiTrim( const S: AnsiString ): AnsiString; +Var + i: longint; +Begin + i:= 1; + while i<length( S) do + begin + if S[ i ]<>' ' then + break; + inc( i ); + end; + Result:= S; + if i>1 then + AnsiDelete( Result, 1, i-1 ); + i:= length( Result ); + while i>=1 do + begin + if S[ i ]<>' ' then + break; + dec( i ); + end; + AnsiSetLength( Result, i ); +End; + +Procedure AnsiParseConfigLine( const S: Ansistring; + var keyName: Ansistring; + var keyValue: Ansistring ); +Var + line: AnsiString; + EqualsPos: longint; +Begin + KeyName:= ''; + KeyValue:= ''; + + line:= AnsiTrim( S ); + EqualsPos:= AnsiPos( '=', line ); + + if ( EqualsPos>0 ) then + begin + KeyName:= AnsiCopy( line, 1, EqualsPos-1 ); + KeyName:= AnsiTrim( KeyName ); + + KeyValue:= AnsiCopy( line, EqualsPos+1, length( line )-EqualsPos ); + KeyValue:= AnsiTrim( KeyValue ); + end; +end; + +Function AnsiExtractNextValue( var CSVString: AnsiString; + const Separator: AnsiString ): AnsiString; +Var + SeparatorPos: integer; +Begin + SeparatorPos:= AnsiPos( Separator, CSVString ); + if SeparatorPos>0 then + begin + Result:= AnsiCopy( CSVString, 1, SeparatorPos-1 ); + AnsiDelete( CSVString, 1, SeparatorPos + length( Separator ) - 1 ); + end + else + begin + Result:= CSVString; + CSVString:= ''; + end; + Result:= AnsiTrim( Result ); + // Remove qyotes if present + if ( Result[1] = chr(34) ) + and ( Result[ length(Result) ] = chr(34) ) then + begin + AnsiDelete( Result, 1, 1 ); + AnsiDelete( Result, length( Result ), 1 ); + Result:= AnsiTrim( Result ); + end; +end; +{$Endif} + +Procedure ReverseList( TheList:TStrings ); +Var + TempList: TStringList; + i: integer; +Begin + TempList:= TStringList.Create; + for i:=TheList.count-1 downto 0 do + begin + TempList.AddObject( TheList.Strings[i], + TheList.Objects[i] ); + end; + TheList.Assign( TempList ); + TempList.Destroy; +end; + +Function FindStringInList( const TheString: string; + TheList:TStrings ): longint; +Var + i: longint; +Begin + for i:=0 to TheList.count-1 do + begin + if StringsSame( TheString, TheList[ i ] ) then + begin + // found + Result:=i; + exit; + end; + end; + Result:=-1; +End; + +Procedure MergeStringLists( Dest: TStringList; + AdditionalList: TStringList ); +var + i: integer; + s: string; +begin + for i:= 0 to AdditionalList.Count - 1 do + begin + s:= AdditionalList[ i ]; + if FindStringInList( s, Dest ) = -1 then + Dest.AddObject( s, AdditionalList.Objects[ i ] ); + end; +end; + +// ---------------------- PCHAR Utilities --------------------------------------- + +function StrNPas( const Ps: PChar; const Length: integer ): String; +var + i: integer; +begin + Result:= ''; + i:= 0; + while ( Ps[ i ] <> #0 ) and ( i < Length ) do + begin + Result:= Result + Ps[ i ]; + inc( i ); + end; +end; + +Function PCharDiff( const a: PChar; const b: Pchar ): longword; +begin + Result:= longword( a ) - longword( b ); +end; + +Procedure CheckPCharSize( Var Text: PChar; + const NeededSize: longword ); +var + temp: PChar; + NewBufferSize: longword; +begin + if ( NeededSize + 1 ) // + 1 to allow for null terminator + > StrBufSize( Text ) then + begin + // allocate new buffer, double the size... + NewBufferSize:= StrBufSize( Text ) * 2; + // or if that's not enough... + if NewBufferSize < ( NeededSize + 1 ) then + // double what we are going to need + NewBufferSize:= NeededSize * 2; + temp:= StrAlloc( NewBufferSize ); + + // copy string to new buffer + StrCopy( temp, Text ); + StrDispose( Text ); + Text:= temp; + end; +end; + +Procedure AddAndResize( Var Text: PChar; const AddText: PChar ); +var + s: string; + s1, s2: string; +begin + //CheckPCharSize( Text, + // strlen( Text ) + // + strlen( AddText ) ); + //StrCat( Text, AddText ); + s1 := Text; + s2 := AddText; + s := s1 + s2; + StrDispose(Text); + Text := StrAlloc(length(s) + 1); + StrPCopy(Text, s); +end; + +Procedure StrCopyAndResize( Var Dest: PChar; + const Source: PChar ); +begin + CheckPCharSize( Dest, StrLen( Source ) ); + StrCopy( Dest, Source ); +end; + +// trims spaces and carriage returns of the end of Text +procedure TrimWhitespace( Text: PChar ); +var + P: PChar; + IsWhitespace: boolean; + TheChar: Char; +begin + P:= Text + StrLen( Text ); + while P > Text do + begin + dec( P ); + TheChar:= P^; + IsWhitespace:= TheChar in [ ' ', #13, #10, #9 ]; + if not IsWhiteSpace then + // done + break; + P[ 0 ]:= #0; // Do no use P^ := + end; +end; + +function TrimChars( const s: string; + chars: TSetOfChars ): string; +var + i: longint; + j: longint; +begin + i := 1; + while i < Length( s ) do + if s[ i ] in chars then + inc( i ) + else + break; + + j := Length( s ); + while j > i do + if s[ j ] in chars then + dec( j ) + else + break; + + result := Copy( s, i, j - i + 1 ); +end; + +procedure StrPCat( Var Dest: PChar; + const StringToAdd: string ); +var + Index: longint; + DestP: PChar; +begin + CheckPCharSize( Dest, + StrLen( Dest ) + + longword( Length( StringToAdd ) ) ); + DestP:= Dest + StrLen( Dest ); + for Index:= 1 to Length( StringToAdd ) do + begin + DestP[ 0 ]:= StringToAdd[ Index ]; // do not use DestP^ := + inc( DestP ); + end; + DestP[ 0 ]:= #0; // Do not use DestP^ := #0; Under Sibyl at least, this writes *** 2 NULL BYTES!!! *** +end; + +Procedure TrimEndLines( const S: PChar ); +var + StringIndex: integer; +begin + StringIndex:= strlen( S ); + while StringIndex > 0 do + begin + dec( StringIndex ); + if S[ StringIndex ] in [ #10, #13 ] then + begin + S[ StringIndex ]:= #0 + end + else + break; + end; +end; + +Function StrDupPas( const s: string ): PChar; +Begin + Result:=StrAlloc( length( s )+1 ); + StrPCopy( Result, S ); +// Result^:=s; +End; + +// Returns a copy of the first n chars of s +Function StrNDup( const s: PChar; const n: integer ): PChar; +Begin + Result:= StrAlloc( n+1 ); + Result[ n ]:= '6'; + StrLCopy( Result, s, n ); +End; + +// Returns a copy of the first line starting at lineStart +Function CopyFirstLine( const lineStart: PChar ): PChar; +Var + lineEnd: PChar; + lineLength: integer; +Begin + // look for an end of line + lineEnd:= strpos( lineStart, EndLine ); + if lineEnd <> nil then + begin + // found, line length is difference between line end position and start of line + lineLength:= longword( lineEnd )-longword( lineStart ); // ugly but how else can it be done? + Result:= StrNDup( lineStart, lineLength ); + exit; + end; + + // no eol found, return copy of remainder of string + Result:= StrNew( lineStart ); +end; + +// Returns next line p points to +Function NextLine( const p: PChar): PChar; +Var + lineEnd: PChar; +Begin + // look for an end of line + lineEnd:=strpos( p, EndLine ); + if lineEnd<>nil then + begin + // Advance the linestart over the eol + Result:=lineEnd+length( EndLine ); + exit; + end; + + // no eol found, return pointer to null term + Result:=p+strlen( p ); +end; + +Function CaseInsensitivePos( const a: string; const b: string ): longint; +begin + Result := Pos( UpperCase( a ), Uppercase( b ) ); +end; + + +Function BoolToStr( const b: boolean ): string; +begin + if b then + Result := 'True' + else + Result := 'False'; +end; + +// Return true if param matches the form +// /Flag:value +// dash (-) can be used instead of slash (/) +// colon can be omitted +function MatchValueParam( const Param: string; + const Flag: string; + var Value: string ): boolean; +begin + Result := false; + + if Param = '' then + exit; + + if ( Param[ 1 ] <> '/' ) + and ( Param[ 1 ] <> '-' ) then + exit; + + if not StringsSame( Copy( Param, 2, Length( Flag ) ), + Flag ) then + exit; + + Result := true; + + Value := StrRightFrom( Param, 2 + Length( Flag ) ); + if Value <> '' then + if Value[ 1 ] = ':' then + Delete( Value, 1, 1 ); +end; + +// Return true if param matches the form +// /Flag +// dash (-) can be used instead of slash (/) +function MatchFlagParam( const Param: string; + const Flag: string ): boolean; +begin + Result := false; + + if Param = '' then + exit; + + if ( Param[ 1 ] <> '/' ) + and ( Param[ 1 ] <> '-' ) then + exit; + + Result := StringsSame( StrRightFrom( Param, 2 ), + Flag ); +end; + +function StrStartsWithIgnoringCase(const aReceiver: String; const aStartString: String): Boolean; +var + tmpStringPos : integer; + tmpStartStringLength : integer; +begin + tmpStartStringLength := Length(aStartString); + + if Length(aReceiver) < tmpStartStringLength then + begin + result := false; + exit; + end; + + for tmpStringPos := 1 to tmpStartStringLength do + begin + if UpCase(aReceiver[tmpStringPos]) <> UpCase(aStartString[tmpStringPos]) then + begin + result := false; + exit; + end; + end; + + result := true; +end; + +Function StrEndsWithIgnoringCase(const aReceiver: String; const anEndString: String): Boolean; +Var + tmpStringPos : Longint; + tmpMatchPos : Longint; +Begin + tmpStringPos := length(aReceiver); + tmpMatchPos := length(anEndString); + + if tmpMatchPos > tmpStringPos then + begin + result := false; + exit; + end; + + while tmpMatchPos > 0 do + begin + if upcase(aReceiver[tmpStringPos]) <> upcase(anEndString[tmpMatchPos]) then + begin + result := false; + exit; + end; + dec(tmpMatchPos); + dec(tmpStringPos); + end; + + result := true; +end; + +function StrIsEmptyOrSpaces(const AText: string): boolean; +begin + Result := Trim(AText) = ''; +end; + +{ TSerializableStringList } + +constructor TSerializableStringList.Create; +begin + LogEvent(LogObjConstDest, 'TSerializableStringList createdestroy'); + inherited Create; + stringList := TStringList.Create; +end; + +destructor TSerializableStringList.Destroy; +begin + LogEvent(LogObjConstDest, 'TSerializableStringList destroy'); + stringList.Free; + inherited Destroy; +end; + +function TSerializableStringList.getCount: LongInt; +begin + Result := stringlist.Count; +end; + +function TSerializableStringList.get(const anIndex: LongInt): String; +begin + Result := stringList[anIndex]; +end; + +function TSerializableStringList.getSerializedString: String; +var + i: Integer; +begin + Result := ''; + for i := 0 to stringList.count-1 do + begin + if (i > 0) then result := result + '&'; + Result := Result + StrEscapeAllCharsBy(stringList[i], ['&'], '\'); + end; +end; + +procedure TSerializableStringList.add(const aString: String); +begin + stringList.add(aString); +end; + +procedure TSerializableStringList.readValuesFromSerializedString(const aSerializedString: String); +begin + if length(aSerializedString) < 1 then + exit; + LogEvent(LogObjConstDest, 'readValuesFromSerializedString'); + stringList.Clear; + LogEvent(LogObjConstDest, 'readValuesFromSerializedString clear done'); + StrExtractStrings(stringList, aSerializedString, ['&'], '\'); +end; + +initialization + InitHexDigitMap; + +End. |