{ Double Commander ------------------------------------------------------------------------- Useful functions dealing with strings. Copyright (C) 2006-2025 Alexander Koblov (alexx2000@mail.ru) Copyright (C) 2012 Przemyslaw Nagay (cobines@gmail.com) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . } unit DCStrUtils; {$mode objfpc}{$H+} interface uses Classes, SysUtils, DCBasicTypes, LazUtf8; const NoQuotesSpecialChars = [' ', '"', '''', '(', ')', ':', '&', '!', '$', '*', '?', '=', '`', '\', '|', ';', #10]; DoubleQuotesSpecialChars = ['$', '\', '`', '"', #10]; type TPathType = (ptNone, ptRelative, ptAbsolute); {en Checks if StringToCheck contains any of the single characters in PossibleCharacters. Only ASCII can be searched. } function ContainsOneOf(StringToCheck: String; PossibleCharacters: String): Boolean; {en Convert known directory separators to the current directory separator. } function NormalizePathDelimiters(const Path: String): String; {en Convert known directory separators to user defined directory separator. } function ReplaceDirectorySeparator(const Path: String; const Separator : Char): String; {en Get last directory name in path @returns(Last directory name in path) } function GetLastDir(Path : String) : String; {en Retrieves the root directory for a path. @param(sPath Absolute path to a directory or a file.) @returns(Root directory or an empty string if the path is not absolute.) } function GetRootDir(sPath : String) : String; {en Retrieves parent directory for a path (removes the last subdirectory in the path). @param(sPath Absolute or relative path to a directory or a file.) @returns(Parent directory or an empty string if the path does not have a parent directory.) } function GetParentDir(sPath : String) : String; {en Gets the deepest (longest) path that exist. } function GetDeepestExistingPath(const sPath : String) : String; function GetSplitFileName(var sFileName, sPath : String) : String; function MakeFileName(const sPath, sFileNameDef : String) : String; {en Split path into list of directories @param(DirName Path) @param(Dirs List of directories names) @returns(The function returns the number of directories found, or -1 if none were found.) } function GetDirs (DirName : String; var Dirs : TStringList) : Longint; {en Get absolute file name from relative file name @param(sPath Current path) @param(sRelativeFileName Relative file name) @returns(Absolute file name) } function GetAbsoluteFileName(const sPath, sRelativeFileName : String) : String; {en Checks if a path to a directory or file is absolute or relative. @returns(ptNone if a path is just a directory or file name (MyDir) ptRelative if a path is relative (MyDir/MySubDir) ptAbsolute if a path is absolute) (/root/MyDir) } function GetPathType(const sPath : String): TPathType; function ExtractFileDirEx(const FileName: String): String; function ExtractFilePathEx(const FileName: String): String; function ExtractFileNameEx(const FileName: String): String; {en Get file name without path and extension @param(FileName File name) @returns(File name without path and extension) } function ExtractOnlyFileName(const FileName: string): string; {en Get file extension without the '.' at the front. } function ExtractOnlyFileExt(const FileName: string): string; {en Remove file extension with the '.' from file name. } function RemoveFileExt(const FileName: String): String; function ReplaceInvalidChars(const FileName: String): String; function RemoveInvalidCharsFromFileName(const FileName: String): String; function ContainsWildcards(const Path: String): Boolean; {en Expands an absolute file path by removing all relative references. Processes '/../' and '/./'. Example: /home/user/files/../somedirectory/./file.txt = /home/user/somedirectory/file.txt @param(Path path to expand.) } function ExpandAbsolutePath(const Path: String): String; function HasPathInvalidCharacters(Path: String): Boolean; {en Checks if a file or directory belongs in the specified path. Only strings are compared, no file-system checks are done. @param(sBasePath Absolute path where the path to check should be in.) @param(sPathToCheck Absolute path to file or directory to check.) @param(AllowSubDirs If @true, allows the sPathToCheck to point to a file or directory in some subdirectory of sBasePath. If @false, only allows the sPathToCheck to point directly to a file or directory in sBasePath.) @param(AllowSame If @true, returns @true if sBasePath = sPathToCheck. If @false, returns @false if sBasePath = sPathToCheck.) @return(@true if sPathToCheck points to a directory or file in sBasePath. @false otherwise.) Examples: IsInPath('/home', '/home/somedir/somefile', True, False) = True IsInPath('/home', '/home/somedir/somefile', False, False) = False IsInPath('/home', '/home/somedir/', False, False) = True IsInPath('/home', '/home', False, False) = False IsInPath('/home', '/home', False, True) = True } function IsInPath(sBasePath : String; sPathToCheck : String; AllowSubDirs : Boolean; AllowSame : Boolean) : Boolean; {en Changes a path to be relative to some parent directory. @param(sPrefix Absolute path that is a parent of sPath.) @param(sPath Path to change. Must be a subpath of sPrefix, otherwise no change is made.) Examples: ExtractDirLevel('/home', '/home/somedir/somefile') = '/somedir/somefile' } function ExtractDirLevel(const sPrefix, sPath: String): String; {en Adds a path delimiter at the beginning of the string, if it not exists. } function IncludeFrontPathDelimiter(s: String): String; {en Removes a path delimiter at the beginning of the string, if it exists. } function ExcludeFrontPathDelimiter(s: String): String; {en Removes a path delimiter at the ending of the string, if it exists. Doesn't remove path delimiter if it is the only character in the path (root dir), so it is safer to use than ExcludeTrailingPathDelimiter, especially on Unix. } function ExcludeBackPathDelimiter(const Path: String): String; {en Return position of character in string begun from start position @param(C character) @param(S String) @param(StartPos Start position) @returns(Position of character in string) } function CharPos(C: Char; const S: string; StartPos: Integer = 1): Integer; {en Return position of any of tag-characters in string T in string S begun from start position @param(T set of characters) @param(S String) @param(StartPos Start position) @param(SearchBackward set @True if need search backwards) @returns(Position of character in string) } function TagPos(T: string; const S: string; StartPos: Integer;SearchBackward: boolean=False): Integer; {en Split file name on name and extension @param(sFileName File name) @param(n Name) @param(e Extension) } procedure DivFileName(const sFileName:String; out n,e:String); {en Split ';' separated path list to array @param(Path Path list to split) @returns(Path array) } function SplitPath(const Path: String): TDynamicStringArray; {en Split file mask on name mask and extension mask @param(DestMask File mask) @param(DestNameMask Name mask) @param(DestExtMask Extension mask) } procedure SplitFileMask(const DestMask: String; out DestNameMask: String; out DestExtMask: String); {en Apply name and extension mask to the file name @param(aFileName File name) @param(NameMask Name mask) @param(ExtMask Extension mask) } function ApplyRenameMask(aFileName: String; NameMask: String; ExtMask: String): String; {en Get count of character in string @param(Char Character) @param(S String) @returns(Count of character) } function NumCountChars(const Char: Char; const S: String): Integer; {en Trim the leading and ending spaces } function TrimPath(const Path: String): String; {en Remove last line ending in text @param(sText Text) @param(TextLineBreakStyle Text line break style) } function TrimRightLineEnding(const sText: String; TextLineBreakStyle: TTextLineBreakStyle): String; function mbCompareText(const s1, s2: String): PtrInt; function StrNewW(const mbString: String): PWideChar; procedure StrDisposeW(var pStr : PWideChar); function StrLCopyW(Dest, Source: PWideChar; MaxLen: SizeInt): PWideChar; function StrPCopyW(Dest: PWideChar; const Source: WideString): PWideChar; function StrPLCopyW(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar; function RPos(const Substr : UnicodeString; const Source : UnicodeString) : Integer; overload; {en Checks if a string begins with another string. @returns(@true if StringToCheck begins with StringToMatch. StringToCheck may be longer than StringToMatch.) } function StrBegins(const StringToCheck, StringToMatch: String): Boolean; {en Checks if a string ends with another string. @returns(@true if StringToCheck ends with StringToMatch. StringToCheck may be longer than StringToMatch.) } function StrEnds(const StringToCheck, StringToMatch: String): Boolean; {en Adds a string to another string. If the source string is not empty adds a separator before adding the string. } procedure AddStrWithSep(var SourceString: String; const StringToAdd: String; const Separator: Char = ' '); procedure AddStrWithSep(var SourceString: String; const StringToAdd: String; const Separator: String); procedure ParseLineToList(sLine: String; ssItems: TStrings); function ParseLineToFileFilter(sFilterPair: array of string): string; {en Convert a number specified as an octal number to it's decimal value. @param(Value Octal number as string) @returns(Decimal number) } function OctToDec(Value: String): LongInt; {en Convert a number specified as an decimal number to it's octal value. @param(Value Decimal number) @returns(Octal number as string) } function DecToOct(Value: LongInt): String; procedure AddString(var anArray: TDynamicStringArray; const sToAdd: String); {en Splits a string into different parts delimited by the specified delimiter character. } function SplitString(const S: String; Delimiter: AnsiChar): TDynamicStringArray; {en Checks if the second array is the beginning of first. If BothWays is @true then also checks the other way around, if the first array is the beginning of second. For Array1=[1,2] Array2=[1,2] returns @true. For Array1=[1,2,...] Array2=[1,2] returns @true. For Array1=[1,3,...] Array2=[1,2] returns @false. If BothWays = True then also For Array1=[1] Array2=[1,2] returns @true. For Array1=[1] Array2=[2] returns @false. } function ArrBegins(const Array1, Array2: array of String; BothWays: Boolean): Boolean; function ArrayToString(const anArray: TDynamicStringArray; const Separator: Char = ' '): String; {en Compares length and contents of the arrays. If lengths differ or individual elements differ returns @false, otherwise @true. } function Compare(const Array1, Array2: array of String): Boolean; {en Copies open array to dynamic array. } function CopyArray(const anArray: array of String): TDynamicStringArray; function ContainsOneOf(const ArrayToSearch, StringsToSearch: array of String): Boolean; function Contains(const ArrayToSearch: array of String; const StringToSearch: String): Boolean; procedure DeleteString(var anArray: TDynamicStringArray; const Index: Integer); procedure DeleteString(var anArray: TDynamicStringArray; const sToDelete: String); function GetArrayFromStrings(Strings: TStrings): TDynamicStringArray; procedure SetStringsFromArray(Strings: TStrings; const anArray: TDynamicStringArray); {en Replaces old value of Key or adds a new Key=NewValue string to the array. } procedure SetValue(var anArray: TDynamicStringArray; Key, NewValue: String); procedure SetValue(var anArray: TDynamicStringArray; Key: String; NewValue: Boolean); function ShortcutsToText(const Shortcuts: TDynamicStringArray): String; function GetDateTimeInStrEZSortable(DateTime:TDateTime):string; function WrapTextSimple(const S: String; MaxCol: Integer = 100): String; {en Escapes characters to be inserted between single quotes (') and passed to shell command line. The resulting string is not enclosed with '', only escaped. For example needs to be escaped with this function: sh -c '' "" } function EscapeSingleQuotes(const Str: String): String; {en Escapes characters to be inserted between double quotes (") and passed to shell command line. The resulting string is not enclosed with "", only escaped. For example needs to be escaped with this function: sh -c '' "" } function EscapeDoubleQuotes(const Str: String): String; {en Escapes characters to be passed to shell command line when no quoting is used. For example needs to be escaped with this function: sh -c '' "" } function EscapeNoQuotes(const Str: String): String; {en Reads a line of text from a string @param(Value Input text string) @param(S Output text line) @param(N Current position in the input text string) @returns(@true if line-ending found, @false otherwise) } function GetNextLine(const Value: String; var S: String; var N: Integer): Boolean; implementation uses DCOSUtils, DCConvertEncoding, StrUtils; function ReplaceDirectorySeparator(const Path: String; const Separator : Char): String; const AllowPathDelimiters : set of char = ['\','/']; var I : LongInt; begin Result := Path; if (Separator in AllowPathDelimiters) then begin for I:= 1 to Length(Path) do if Path[I] in AllowPathDelimiters then Result[I]:= Separator end end; function NormalizePathDelimiters(const Path: String): String; {$IFDEF UNIX} begin Result:= Path; end; {$ELSE} const AllowPathDelimiters : set of char = ['\','/']; var I : LongInt; uriPos : Integer; begin Result:= Path; // If path is not URI uriPos := Pos('://', Result); if (uriPos = 0) {$IF DEFINED(MSWINDOWS)} or ( (uriPos = 2) and (Path[1] in ['A'..'z']) ) {$ENDIF} then begin for I:= 1 to Length(Path) do if Path[I] in AllowPathDelimiters then Result[I]:= DirectorySeparator; end; end; {$ENDIF} function GetLastDir(Path : String) : String; begin Result:= ExtractFileName(ExcludeTrailingPathDelimiter(Path)); if Result = '' then Result:= ExtractFileDrive(Path); if Result = '' then Result:= PathDelim; end; function GetRootDir(sPath : String) : String; begin {$IF DEFINED(MSWINDOWS)} Result := ExtractFileDrive(sPath); if Result <> '' then Result := Result + PathDelim; {$ELSEIF DEFINED(UNIX)} Result := PathDelim; // Hardcoded {$ELSE} Result := ''; {$ENDIF} end; function GetParentDir(sPath : String) : String; var i : Integer; begin Result := ''; sPath := ExcludeTrailingPathDelimiter(sPath); // Start from one character before last. for i := length(sPath) - 1 downto 1 do if sPath[i] = DirectorySeparator then begin Result := Copy(sPath, 1, i); Break; end; end; function GetDeepestExistingPath(const sPath : String) : String; begin Result := sPath; while Result <> EmptyStr do begin if not mbDirectoryExists(Result) then Result := GetParentDir(Result) else Break; end; end; function GetSplitFileName(var sFileName, sPath : String) : String; begin if Pos(PathDelim, sFileName) <> 0 then begin Result := sFileName; sPath := ExtractFilePath(sFileName); sFileName := ExtractFileName(sFileName); end else Result := sPath + sFileName; end; function MakeFileName(const sPath, sFileNameDef : String) : String; begin Result:= ExtractFileName(ExcludeTrailingBackslash(sPath)); if Result = EmptyStr then Result:= sFileNameDef; end; function GetDirs (DirName : String; var Dirs : TStringList) : Longint; var I : Longint; len : Integer; sDir : String; begin I:= 1; Result:= -1; len := Length(DirName); while I <= len do begin if DirName[I]=PathDelim then begin Inc(Result); sDir := Copy(DirName, 1, len - (len - I + 1)); if dirs.IndexOf(sDir) < 0 then dirs.Add(sDir); end; Inc(I); end; if Result > -1 then inc(Result); end; function GetAbsoluteFileName(const sPath, sRelativeFileName : String) : String; begin case GetPathType(sRelativeFileName) of ptNone: Result := sPath + sRelativeFileName; ptRelative: Result := ExpandAbsolutePath(sPath + sRelativeFileName); ptAbsolute: Result := sRelativeFileName; end; end; function GetPathType(const sPath : String): TPathType; begin if sPath <> EmptyStr then begin {$IFDEF MSWINDOWS} { Absolute path in Windows } if { X:\... [Disk] ":" is reserved otherwise } ( Pos( DriveDelim, sPath ) > 0 ) or { \\... [UNC] \... [Root of current drive] } ( sPath[1] = PathDelim ) then {$ENDIF MSWINDOWS} {$IFDEF UNIX} { UNIX absolute paths start with a slash } if (sPath[1] = PathDelim) then {$ENDIF UNIX} Result := ptAbsolute else if ( Pos( PathDelim, sPath ) > 0 ) then Result := ptRelative else if (sPath = '..') then Result := ptRelative else Result := ptNone; end else Result := ptNone; end; function ExtractFileDirEx(const FileName: String): String; var i : longint; begin I := Length(FileName); while (I > 0) and not CharInSet(FileName[I],AllowDirectorySeparators) do Dec(I); if (I > 1) and CharInSet(FileName[I],AllowDirectorySeparators) and not CharInSet(FileName[I - 1],AllowDirectorySeparators) then Dec(I); Result := Copy(FileName, 1, I); end; function ExtractFilePathEx(const FileName: String): String; var i : longint; begin i := Length(FileName); while (i > 0) and not CharInSet(FileName[i],AllowDirectorySeparators) do Dec(i); If I>0 then Result := Copy(FileName, 1, i) else Result:=''; end; function ExtractFileNameEx(const FileName: String): String; var i : longint; begin I := Length(FileName); while (I > 0) and not CharInSet(FileName[I],AllowDirectorySeparators) do Dec(I); Result := Copy(FileName, I + 1, MaxInt); end; function ExtractOnlyFileName(const FileName: string): string; var SOF : Boolean; I, Index : LongInt; EndSep : Set of Char; begin Index := MaxInt; // Find a dot index I := Length(FileName); EndSep:= AllowDirectorySeparators + AllowDriveSeparators + [ExtensionSeparator]; while (I > 0) and not (FileName[I] in EndSep) do Dec(I); if (I > 0) and (FileName[I] = ExtensionSeparator) then begin SOF:= (I = 1) or (FileName[I - 1] in AllowDirectorySeparators); if (not SOF) or FirstDotAtFileNameStartIsExtension then Index := I end; // Find file name index EndSep := EndSep - [ExtensionSeparator]; while (I > 0) and not (FileName[I] in EndSep) do Dec(I); Result := Copy(FileName, I + 1, Index - I - 1); end; function ExtractOnlyFileExt(const FileName: string): string; var I : LongInt; SOF : Boolean; EndSep : Set of Char; begin Result := EmptyStr; I := Length(FileName); EndSep:= AllowDirectorySeparators + AllowDriveSeparators + [ExtensionSeparator]; while (I > 0) and not (FileName[I] in EndSep) do Dec(I); if (I > 0) and (FileName[I] = ExtensionSeparator) then begin SOF:= (I = 1) or (FileName[I - 1] in AllowDirectorySeparators); if (not SOF) or FirstDotAtFileNameStartIsExtension then Result := Copy(FileName, I + 1, MaxInt) end; end; function RemoveFileExt(const FileName: String): String; var I : LongInt; SOF : Boolean; EndSep : Set of Char; begin Result := FileName; I := Length(FileName); EndSep:= AllowDirectorySeparators + AllowDriveSeparators + [ExtensionSeparator]; while (I > 0) and not (FileName[I] in EndSep) do Dec(I); if (I > 0) and (FileName[I] = ExtensionSeparator) then begin SOF:= (I = 1) or (FileName[I - 1] in AllowDirectorySeparators); if (not SOF) or FirstDotAtFileNameStartIsExtension then Result := Copy(FileName, 1, I - 1) end; end; function ContainsWildcards(const Path: String): Boolean; begin Result := ContainsOneOf(Path, '*?'); end; function ReplaceInvalidChars(const FileName: String): String; const {$IFDEF MSWINDOWS} ForbiddenChars : set of char = [#00..#31, '<','>',':','"','/','|','?','*']; {$ELSE} ForbiddenChars : set of char = [#0]; {$ENDIF} var I : LongInt; begin Result:= EmptyStr; for I:= 1 to Length(FileName) do begin if not (FileName[I] in ForbiddenChars) then Result:= Result + FileName[I] else Result+= '%' + HexStr(Ord(FileName[I]), 2); end; end; { RemoveInvalidCharsFromFileName } function RemoveInvalidCharsFromFileName(const FileName: String): String; const {$IFDEF MSWINDOWS} ForbiddenChars : set of char = [#00..#31, '<','>',':','"','/','\','|','?','*']; {$ELSE} ForbiddenChars : set of char = ['/']; {$ENDIF} var I : LongInt; begin Result:= ''; for I:= 1 to Length(FileName) do if not (FileName[I] in ForbiddenChars) then Result:=Result+FileName[I]; end; function ExpandAbsolutePath(const Path: String): String; const PATH_DELIM_POS = {$IFDEF MSWINDOWS}3{$ELSE}1{$ENDIF}; var I, J: Integer; begin Result := Path; // Remove all references to '\.\' I := Pos(DirectorySeparator + '.' + DirectorySeparator, Result); while I <> 0 do begin Delete(Result, I, 2); I := Pos(DirectorySeparator + '.' + DirectorySeparator, Result, I); end; // Remove all references to '\..\' I := Pos(DirectorySeparator + '..' + DirectorySeparator, Result); while I <> 0 do begin J := Pred(I); while (J > 0) and (Result[J] <> DirectorySeparator) do Dec (J); Delete(Result, J + 1, I - J + 3); I := Pos(DirectorySeparator + '..' + DirectorySeparator, Result); end; // Remove a reference to '\..' at the end of line if StrEnds(Result, DirectorySeparator + '..') then begin J := Length(Result) - 3; while (J > 0) and (Result[J] <> DirectorySeparator) do Dec(J); if (J = 0) then Result := EmptyStr else if (J > PATH_DELIM_POS) then Delete(Result, J, MaxInt) else Delete(Result, J + 1, MaxInt); end; // Remove a reference to '\.' at the end of line if Length(Result) = 1 then begin if Result[1] = '.' then Result := EmptyStr; end else if StrEnds(Result, DirectorySeparator + '.') then begin if Length(Result) = (PATH_DELIM_POS + 1) then Delete(Result, Length(Result), 1) else Delete(Result, Length(Result) - 1, 2); end; end; function HasPathInvalidCharacters(Path: String): Boolean; begin Result := ContainsOneOf(Path, '*?'); end; function IsInPath(sBasePath : String; sPathToCheck : String; AllowSubDirs : Boolean; AllowSame : Boolean) : Boolean; var BasePathLength, PathToCheckLength: Integer; DelimiterPos: Integer; begin if sBasePath = '' then Exit(False); sBasePath := IncludeTrailingPathDelimiter(sBasePath); BasePathLength := UTF8Length(sBasePath); PathToCheckLength := UTF8Length(sPathToCheck); if PathToCheckLength > BasePathLength then begin if mbCompareFileNames(UTF8Copy(sPathToCheck, 1, BasePathLength), sBasePath) then begin if AllowSubDirs then Result := True else begin // Additionally check if the remaining path is a relative path. // Look for a path delimiter in the middle of the filepath. sPathToCheck := UTF8Copy(sPathToCheck, 1 + BasePathLength, PathToCheckLength - BasePathLength); DelimiterPos := UTF8Pos(DirectorySeparator, sPathToCheck); // If no delimiter was found or it was found at then end (directories // may end with it), then the 'sPathToCheck' is in 'sBasePath'. Result := (DelimiterPos = 0) or (DelimiterPos = PathToCheckLength - BasePathLength); end; end else Result := False; end else Result := AllowSame and (((PathToCheckLength = BasePathLength) and (mbCompareFileNames(sPathToCheck, sBasePath))) or ((PathToCheckLength = BasePathLength - 1) and (mbCompareFileNames(UTF8Copy(sBasePath, 1, PathToCheckLength), sPathToCheck)))); end; function ExtractDirLevel(const sPrefix, sPath: String): String; var PrefixLength: Integer; begin if IsInPath(sPrefix, sPath, True, True) then begin PrefixLength := Length(sPrefix); Result := Copy(sPath, 1 + PrefixLength, Length(sPath) - PrefixLength) end else Result := sPath; end; function IncludeFrontPathDelimiter(s: String): String; begin if (Length(s) > 0) and (s[1] = PathDelim) then Result:= s else Result:= PathDelim + s; end; function ExcludeFrontPathDelimiter(s: String): String; begin if (Length(s) > 0) and (s[1] = PathDelim) then Result := Copy(s, 2, Length(s) - 1) else Result := s; end; function ExcludeBackPathDelimiter(const Path: String): String; var L: Integer; begin L:= Length(Path); if (L > 1) and (Path[L] in AllowDirectorySeparators) and (Path[L - 1] <> DriveSeparator) then Result:= Copy(Path, 1, L - 1) else Result:= Path; end; procedure DivFileName(const sFileName:String; out n,e:String); var i:Integer; begin for i:= length(sFileName) downto 1 do if sFileName[i]='.' then begin // if i>1 then // hidden files?? e:=Copy(sFileName,i,Length(sFileName)-i+1); n:=Copy(sFileName,1,i-1); Exit; end; e:=''; n:=sFileName; end; function SplitPath(const Path: String): TDynamicStringArray; const cDelta = {$IF DEFINED(UNIX)}1{$ELSE}2{$ENDIF}; cDelimiter = {$IF DEFINED(UNIX)}'/'{$ELSE}':'{$ENDIF}; var L, F: Integer; S: Integer = 1; begin L:= Length(Path); SetLength(Result, 0); for F:= 1 to L - cDelta do begin if (Path[F] = ';') and (Path[F + cDelta] = cDelimiter) then begin AddString(Result, Copy(Path, S, F - S)); S:= F + 1; end; end; if S <= L then begin AddString(Result, Copy(Path, S, L - S + 1)); end; end; procedure SplitFileMask(const DestMask: String; out DestNameMask: String; out DestExtMask: String); var iPos: LongInt; begin // Special case for mask that contains '*.*' ('*.*.old' for example) iPos:= Pos('*.*', DestMask); if (iPos = 0) then DivFileName(DestMask, DestNameMask, DestExtMask) else begin DestNameMask := Copy(DestMask, 1, iPos); DestExtMask := Copy(DestMask, iPos + 1, MaxInt); end; // Treat empty mask as '*.*'. if (DestNameMask = '') and (DestExtMask = '') then begin DestNameMask := '*'; DestExtMask := '.*'; end; end; function ApplyRenameMask(aFileName: String; NameMask: String; ExtMask: String): String; function ApplyMask(const TargetString, Mask: String): String; var I: Integer; ALen: Integer; begin Result:= EmptyStr; ALen:= UTF8Length(TargetString); for I:= 1 to Length(Mask) do begin if Mask[I] = '?' then begin if I <= ALen then Result:= Result + UTF8Copy(TargetString, I, 1) else Exit(TargetString); end else if Mask[I] = '*' then Result:= Result + UTF8Copy(TargetString, I, MaxInt) else Result:= Result + Mask[I]; end; end; var sDstExt: String; sDstName: String; begin if ((NameMask = '*') and (ExtMask = '.*')) then Result := aFileName else begin DivFileName(aFileName, sDstName, sDstExt); sDstName := ApplyMask(sDstName, NameMask); sDstExt := ApplyMask(sDstExt, ExtMask); Result := sDstName; if sDstExt <> '.' then Result := Result + sDstExt; end; end; function CharPos(C: Char; const S: string; StartPos: Integer = 1): Integer; var sNewStr : String; begin if StartPos <> 1 then begin sNewStr := Copy(S, StartPos, Length(S) - StartPos + 1); Result := Pos(C, sNewStr); if Result <> 0 then Result := Result + StartPos - 1; end else Result := Pos(C, S); end; function TagPos(T: string; const S: string; StartPos: Integer; SearchBackward: boolean): Integer; var ch: AnsiChar; i, cnt: Integer; begin Result:= 0; i:= StartPos; if i = 0 then i:= 1; cnt:= UTF8Length(S); if SearchBackward then begin while (i > 0) do begin ch:= S[UTF8CharToByteIndex(PAnsiChar(S), Length(S), i)]; if Pos(ch, T) = 0 then Dec(i) else Break; end; end else while (i <= cnt) do begin ch:= S[UTF8CharToByteIndex(PAnsiChar(S), Length(S), i)]; if Pos(ch, T) = 0 then Inc(i) else Break; end; Result:= i; end; function NumCountChars(const Char: char; const S: String): Integer; var I : Integer; begin Result := 0; if Length(S) > 0 then for I := 1 to Length(S) do if S[I] = Char then Inc(Result); end; function TrimPath(const Path: String): String; const WhiteSpace = [#0..' '{$IFDEF MSWINDOWS},'.'{$ENDIF}]; var Index: Integer; S: TStringArray; begin S:= TrimRightSet(Path, WhiteSpace).Split([PathDelim]); if Length(S) = 0 then Result:= EmptyStr else begin Result:= TrimRightSet(S[0], WhiteSpace); for Index := Low(S) + 1 to High(S) do begin Result+= PathDelim + TrimRightSet(S[Index], WhiteSpace); end; end; end; function TrimRightLineEnding(const sText: String; TextLineBreakStyle: TTextLineBreakStyle): String; const TextLineBreakArray: array[TTextLineBreakStyle] of Integer = (1, 2, 1); var I, L: Integer; begin L:= Length(sText); I:= TextLineBreakArray[TextLineBreakStyle]; Result:= Copy(sText, 1, L - I); // Copy without last line ending end; function mbCompareText(const s1, s2: String): PtrInt; inline; begin // From 0.9.31 LazUtils can be used but this package does not exist in 0.9.30. // Result := LazUTF8.UTF8CompareText(s1, s2); Result := WideCompareText(CeUtf8ToUtf16(s1), CeUtf8ToUtf16(s2)); end; function StrNewW(const mbString: String): PWideChar; var wsString: WideString; iLength: PtrInt; begin Result:= nil; wsString:= CeUtf8ToUtf16(mbString); iLength:= (Length(wsString) * SizeOf(WideChar)) + 1; Result:= GetMem(iLength); if Result <> nil then Move(PWideChar(wsString)^, Result^, iLength); end; procedure StrDisposeW(var pStr : PWideChar); begin FreeMem(pStr); pStr := nil; end; function StrLCopyW(Dest, Source: PWideChar; MaxLen: SizeInt): PWideChar; var I: SizeInt; begin Result := Dest; for I:= 0 to MaxLen - 1 do begin if Source^ = #0 then Break; Dest^ := Source^; Inc(Source); Inc(Dest); end; Dest^ := #0; end; function StrPCopyW(Dest: PWideChar; const Source: WideString): PWideChar; begin Result := StrLCopyW(Dest, PWideChar(Source), Length(Source)); end; function StrPLCopyW(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar; begin Result := StrLCopyW(Dest, PWideChar(Source), MaxLen); end; function RPos(const Substr: UnicodeString; const Source: UnicodeString): Integer; var c : WideChar; pc, pc2 : PWideChar; MaxLen, llen : Integer; begin Result:= 0; llen:= Length(SubStr); maxlen:= Length(Source); if (llen > 0) and (maxlen > 0) and (llen <= maxlen) then begin pc:= @Source[maxlen]; pc2:= @Source[llen - 1]; c:= Substr[llen]; while pc >= pc2 do begin if (c = pc^) and (CompareByte(Substr[1], PByte(pc - llen + 1)^, llen * SizeOf(WideChar)) = 0) then begin Result:= PWideChar(pc - llen + 1) - PWideChar(@source[1]) + 1; Exit; end; Dec(pc); end; end; end; function StrBegins(const StringToCheck, StringToMatch: String): Boolean; begin Result := (Length(StringToMatch) > 0) and (Length(StringToCheck) >= Length(StringToMatch)) and (CompareChar(StringToCheck[1], StringToMatch[1], Length(StringToMatch)) = 0); end; function StrEnds(const StringToCheck, StringToMatch: String): Boolean; begin Result := (Length(StringToMatch) > 0) and (Length(StringToCheck) >= Length(StringToMatch)) and (CompareChar(StringToCheck[1 + Length(StringToCheck) - Length(StringToMatch)], StringToMatch[1], Length(StringToMatch)) = 0); end; procedure AddStrWithSep(var SourceString: String; const StringToAdd: String; const Separator: Char); begin if (Length(SourceString) > 0) and (Length(StringToAdd) > 0) then SourceString := SourceString + Separator; SourceString := SourceString + StringToAdd; end; procedure AddStrWithSep(var SourceString: String; const StringToAdd: String; const Separator: String); begin if (Length(SourceString) > 0) and (Length(StringToAdd) > 0) then SourceString := SourceString + Separator; SourceString := SourceString + StringToAdd; end; procedure ParseLineToList(sLine: String; ssItems: TStrings); var xPos: Integer; begin ssItems.Clear; while sLine <> '' do begin xPos:= Pos(';', sLine); if xPos > 0 then begin ssItems.Add(Copy(sLine, 1, xPos - 1)); Delete(sLine, 1, xPos); end else begin ssItems.Add(sLine); Exit; end; end; end; function ParseLineToFileFilter(sFilterPair: array of string): string; var iPairIndex: integer; begin result:=''; for iPairIndex := 0 to pred(length(sFilterPair) div 2) do result := result + sFilterPair[iPairIndex*2] + '|' + sFilterPair[succ(iPairIndex*2)] + '|'; if length(result)>0 then result := LeftStr(result, pred(length(result))); end; function ContainsOneOf(StringToCheck: String; PossibleCharacters: String): Boolean; var i, j: SizeInt; pc : PChar; begin pc := Pointer(StringToCheck); for i := 1 to Length(StringToCheck) do begin for j := 1 to Length(PossibleCharacters) do if pc^ = PossibleCharacters[j] then Exit(True); Inc(pc); end; Result := False; end; function OctToDec(Value: String): LongInt; var I: Integer; begin Result:= 0; for I:= 1 to Length(Value) do Result:= Result * 8 + StrToInt(Copy(Value, I, 1)); end; function DecToOct(Value: LongInt): String; var iMod: Integer; begin Result := ''; while Value >= 8 do begin iMod:= Value mod 8; Value:= Value div 8; Result:= IntToStr(iMod) + Result; end; Result:= IntToStr(Value) + Result; end; procedure AddString(var anArray: TDynamicStringArray; const sToAdd: String); var Len: Integer; begin Len := Length(anArray); SetLength(anArray, Len + 1); anArray[Len] := sToAdd; end; function SplitString(const S: String; Delimiter: AnsiChar): TDynamicStringArray; var Start: Integer = 1; Len, Finish: Integer; begin Len:= Length(S); SetLength(Result, 0); for Finish:= 1 to Len do begin if S[Finish] = Delimiter then begin AddString(Result, Copy(S, Start, Finish - Start)); Start:= Finish + 1; end; end; if Start <= Len then begin AddString(Result, Copy(S, Start, Len - Start + 1)); end; end; function ArrBegins(const Array1, Array2: array of String; BothWays: Boolean): Boolean; var Len1, Len2: Integer; i: Integer; begin Len1 := Length(Array1); Len2 := Length(Array2); if not BothWays and (Len1 < Len2) then Result := False else begin if Len1 > Len2 then Len1 := Len2; for i := 0 to Len1 - 1 do if Array1[i] <> Array2[i] then Exit(False); Result := True; end; end; function ArrayToString(const anArray: TDynamicStringArray; const Separator: Char): String; var i: Integer; begin Result := ''; for i := Low(anArray) to High(anArray) do AddStrWithSep(Result, anArray[i], Separator); end; function Compare(const Array1, Array2: array of String): Boolean; var Len1, Len2: Integer; i: Integer; begin Len1 := Length(Array1); Len2 := Length(Array2); if Len1 <> Len2 then Result := False else begin for i := 0 to Len1 - 1 do if Array1[i] <> Array2[i] then Exit(False); Result := True; end; end; function CopyArray(const anArray: array of String): TDynamicStringArray; var i: Integer; begin SetLength(Result, Length(anArray)); for i := Low(anArray) to High(anArray) do Result[i] := anArray[i]; end; function ContainsOneOf(const ArrayToSearch, StringsToSearch: array of String): Boolean; var i: Integer; begin for i := Low(StringsToSearch) to High(StringsToSearch) do if Contains(ArrayToSearch, StringsToSearch[i]) then Exit(True); Result := False; end; function Contains(const ArrayToSearch: array of String; const StringToSearch: String): Boolean; var i: Integer; begin for i := Low(ArrayToSearch) to High(ArrayToSearch) do if ArrayToSearch[i] = StringToSearch then Exit(True); Result := False; end; procedure DeleteString(var anArray: TDynamicStringArray; const Index: Integer); var Len: Integer; i: Integer; begin Len := Length(anArray); for i := Index + 1 to Len - 1 do anArray[i - 1] := anArray[i]; SetLength(anArray, Len - 1); end; procedure DeleteString(var anArray: TDynamicStringArray; const sToDelete: String); var i: Integer; begin for i := Low(anArray) to High(anArray) do if anArray[i] = sToDelete then begin DeleteString(anArray, i); Exit; end; end; function GetArrayFromStrings(Strings: TStrings): TDynamicStringArray; var LinesCount: Integer; i: Integer; begin LinesCount := Strings.Count; if LinesCount > 0 then begin if Strings[LinesCount-1] = '' then Dec(LinesCount); SetLength(Result, LinesCount); for i := 0 to LinesCount - 1 do Result[i] := Strings[i]; end; end; procedure SetStringsFromArray(Strings: TStrings; const anArray: TDynamicStringArray); var s: String; begin Strings.Clear; for s in anArray do Strings.Add(s); end; procedure SetValue(var anArray: TDynamicStringArray; Key, NewValue: String); var i: Integer; begin Key := Key + '='; for i := Low(anArray) to High(anArray) do if StrBegins(anArray[i], Key) then begin anArray[i] := Key + NewValue; Exit; end; AddString(anArray, Key + NewValue); end; procedure SetValue(var anArray: TDynamicStringArray; Key: String; NewValue: Boolean); begin if NewValue then SetValue(anArray, Key, 'true') else SetValue(anArray, Key, 'false'); end; function ShortcutsToText(const Shortcuts: TDynamicStringArray): String; begin Result := ArrayToString(Shortcuts, ' '); end; { GetDateTimeInStrEZSortable: Return the date and time in string format with YYYY-MM-DD@HH-MM-SS so it can be integrate in a filename. Also, because of the order of the terms, it make it useful when things are sorted BECAUSE it will also sort by date/time at the same time} function GetDateTimeInStrEZSortable(DateTime:TDateTime):string; var MyYear, MyMonth, MyDay, MyHour, MyMin, MySec, MyMilSec: word; begin DecodeDate(DateTime, MyYear, MyMonth, MyDay); DecodeTime(DateTime, MyHour, MyMin, MySec, MyMilSec); result:=Format('%d-%2.2d-%2.2d@%2.2d-%2.2d-%2.2d', [MyYear, MyMonth, MyDay, MyHour, MyMin, MySec]); end; function WrapTextSimple(const S: String; MaxCol: Integer): String; var Len, Index: Integer; begin Index:= 1; Result:= EmptyStr; Len:= UTF8Length(S); while (Len > 0) do begin Result:= Result + UTF8Copy(S, Index, MaxCol) + LineEnding; Inc(Index, MaxCol); Dec(Len, MaxCol); end; SetLength(Result, Length(Result) - Length(LineEnding)); end; function EscapeString(const Str: String; const EscapeChars: TCharSet; const EscapeWith: String): String; var StartPos: Integer = 1; CurPos: Integer = 1; begin Result := ''; while CurPos <= Length(Str) do begin if Str[CurPos] in EscapeChars then begin Result := Result + Copy(Str, StartPos, CurPos - StartPos) + EscapeWith; // The character being quoted will be copied later. StartPos := CurPos; end; Inc(CurPos); end; Result := Result + Copy(Str, StartPos, CurPos - StartPos); end; function EscapeSingleQuotes(const Str: String): String; begin // Single quotes are strong quotes - no special characters are recognized // inside those quotes, so only ' needs to be escaped. Result := EscapeString(Str, [''''], '''\'''); end; function EscapeDoubleQuotes(const Str: String): String; begin // Double quotes are weak quotes and a few special characters are allowed // which need to be escaped. Result := EscapeString(Str, DoubleQuotesSpecialChars, '\'); end; function EscapeNoQuotes(const Str: String): String; begin // When neither single nor double quotes are used several special characters // need to be escaped with backslash (single character quote). Result := EscapeString(Str, NoQuotesSpecialChars, '\'); end; function GetNextLine(const Value: String; var S: String; var N: Integer): Boolean; var PS: PChar; IP, L, P, K: Integer; begin P:= N; S:= ''; Result:= False; L:= Length(Value); if ((L - P) < 0) then Exit; if ((L - P) = 0) and (not (Value[P] in [#10, #13])) then Exit; PS:= PChar(Value) + P - 1; IP:= P; while ((L - P) >= 0) and (not (PS^ in [#10, #13])) do begin P:= P + 1; Inc(PS); end; K:= P; // Point to character after #13 if (P <= L) and (Value[P] = #13) then begin Inc(P); Result:= True; end; // Point to character after #10 if (P <= L) and (Value[P] = #10) then begin Inc(P); Result:= True; end; if Result then begin N:= P; SetLength(S, K - IP); System.Move(Value[IP], Pointer(S)^, K - IP); end; end; end.