444 lines
13 KiB
ObjectPascal
444 lines
13 KiB
ObjectPascal
{** Provides various string-related functions.
|
|
*
|
|
* Last changed: $Date$ <br />
|
|
* Revision: $Rev$ <br />
|
|
* Author: $Author$ <br />
|
|
*}
|
|
unit X2UtStrings;
|
|
|
|
interface
|
|
uses
|
|
Types;
|
|
|
|
type
|
|
{** Backwards compatibility }
|
|
TSplitArray = TStringDynArray;
|
|
|
|
|
|
{** Formats the specified size.
|
|
*
|
|
* @param ABytes the size to format in bytes.
|
|
* @param AKeepBytes if true, only decimal separators will be added and
|
|
* the text 'bytes' appended. If False, a suitable unit
|
|
* will be chosen (KB, MB, GB).
|
|
* @param AFormat the format used for the output, see the Delphi Help for
|
|
* FormatFloat.
|
|
* @result the formatted size.
|
|
*}
|
|
function FormatSize(const ABytes: Int64; AKeepBytes: Boolean = False;
|
|
const AFormat: String = ',0.##'): String;
|
|
|
|
{** Compares two strings without case sensitivity.
|
|
*
|
|
* @param AMatch the string to match.
|
|
* @param AAgainst the string to match against.
|
|
* @param ALength the maximum length to compare.
|
|
* @result -1 if AMatch is lower by ordinal value than AAgainst,
|
|
* 0 if the two are equal, 1 if AMatch is higher.
|
|
*}
|
|
function CompareTextL(const AMatch, AAgainst: String;
|
|
const ALength: Integer): Integer;
|
|
|
|
{** Compares two strings without case sensitivity.
|
|
*
|
|
* @param AMatch the string to match.
|
|
* @param AAgainst the string to match against.
|
|
* @param ALength the maximum length to compare.
|
|
* @result True if the comparison is a match, False otherwise.
|
|
*}
|
|
function SameTextL(const AMatch, AAgainst: String;
|
|
const ALength: Integer): Boolean;
|
|
|
|
{** Compares two strings without case sensitivity.
|
|
*
|
|
* The length of AAgainst is used as the maximum length to check.
|
|
*
|
|
* @param AMatch the string to match
|
|
* @param AAgainst the string to match against
|
|
* @result -1 if AMatch is lower by ordinal value than AAgainst,
|
|
* 0 if the two are equal, 1 if AMatch is higher.
|
|
*}
|
|
function CompareTextS(const AMatch, AAgainst: String): Integer;
|
|
|
|
{** Compares two strings without case sensitivity.
|
|
*
|
|
* The length of AAgainst is used as the maximum length to check.
|
|
*
|
|
* @param AMatch the string to match.
|
|
* @param AAgainst the string to match against.
|
|
* @result True if the comparison is a match, False otherwise.
|
|
*}
|
|
function SameTextS(const AMatch, AAgainst: String): Boolean;
|
|
|
|
{** Splits a string on a specified delimiter.
|
|
*
|
|
* @param ASource the source string.
|
|
* @param ADelimiter the delimiter to split on.
|
|
* @param ADest the array which will receive the split parts.
|
|
* @todo though optimized, it now fails on #0 characters, need
|
|
* to determine the end by checking the AnsiString length.
|
|
*}
|
|
procedure Split(const ASource, ADelimiter: String; out ADest: TStringDynArray; ASkipEmptyItems: Boolean = False);
|
|
|
|
{** Appends string parts with a specified glue value.
|
|
*
|
|
* @param ASource the source parts
|
|
* @param AGlue the string added between the parts
|
|
* @param ASkipEmptyItems if True, include only items of Length > 0
|
|
* @result the composed parts
|
|
*}
|
|
function Join(ASource: array of string; const AGlue: String; ASkipEmptyItems: Boolean = False): String;
|
|
|
|
{** Determines if one path is the child of another path.
|
|
*
|
|
* Matches the start of two normalized paths. Either of the path may contain
|
|
* parent-references (ex. 'some\..\..\path\'). Note that the file system is
|
|
* not actually accessed, all checks are performed on the strings only.
|
|
*
|
|
* @param AChild the path to check
|
|
* @param AParent the path which is supposed to be the parent
|
|
* @param AFailIfSame if True, fails if the child path is the parent path
|
|
* @result True if the child is indeed a child of the parent,
|
|
* False otherwise.
|
|
*}
|
|
function ChildPath(const AChild, AParent: String;
|
|
const AFailIfSame: Boolean = False): Boolean;
|
|
|
|
{** Determines if one path is the child of another path.
|
|
*
|
|
* Matches the start of two normalized paths. Either of the path may contain
|
|
* parent-references (ex. 'some\..\..\path\'). Note that the file system is
|
|
* not actually accessed, all checks are performed on the strings only.
|
|
*
|
|
* The parameters are modified to return the expanded file names, stripped
|
|
* of any trailing path delimiter.
|
|
*
|
|
* @param AChild the path to check
|
|
* @param AParent the path which is supposed to be the parent
|
|
* @param AFailIfSame if True, fails if the child path is the parent path
|
|
* @result True if the child is indeed a child of the parent,
|
|
* False otherwise.
|
|
*}
|
|
function ChildPathEx(var AChild, AParent: String;
|
|
const AFailIfSame: Boolean = False): Boolean;
|
|
|
|
function ReplacePart(const ASource: String; const AStart, ALength: Integer;
|
|
const AReplace: String): String;
|
|
|
|
implementation
|
|
uses
|
|
SysUtils,
|
|
Windows;
|
|
|
|
function FormatSize(const ABytes: Int64; AKeepBytes: Boolean;
|
|
const AFormat: String): String;
|
|
const
|
|
KB = 1024;
|
|
MB = KB * 1024;
|
|
GB = MB * 1024;
|
|
|
|
var
|
|
dSize: Double;
|
|
sExt: String;
|
|
|
|
begin
|
|
sExt := ' bytes';
|
|
dSize := ABytes;
|
|
|
|
if (not AKeepBytes) and (ABytes >= KB) then
|
|
if (ABytes >= KB) and (ABytes < MB) then begin
|
|
// 1 kB ~ 1 MB
|
|
dSize := ABytes / KB;
|
|
sExt := ' KB';
|
|
end else if (ABytes >= MB) and (ABytes < GB) then begin
|
|
// 1 MB ~ 1 GB
|
|
dSize := ABytes / MB;
|
|
sExt := ' MB';
|
|
end else begin
|
|
// 1 GB ~ x
|
|
dSize := ABytes / GB;
|
|
sExt := ' GB';
|
|
end;
|
|
|
|
Result := FormatFloat(AFormat, dSize) + sExt;
|
|
end;
|
|
|
|
function CompareTextL(const AMatch, AAgainst: String;
|
|
const ALength: Integer): Integer;
|
|
var
|
|
sMatch: String;
|
|
sAgainst: String;
|
|
|
|
begin
|
|
// If there is no reason to copy; don't.
|
|
if Length(AMatch) <= ALength then
|
|
sMatch := AMatch
|
|
else
|
|
sMatch := Copy(AMatch, 1, ALength);
|
|
|
|
if Length(AAgainst) <= ALength then
|
|
sAgainst := AAgainst
|
|
else
|
|
sAgainst := Copy(AAgainst, 1, ALength);
|
|
|
|
Result := CompareText(sMatch, sAgainst);
|
|
end;
|
|
|
|
function SameTextL(const AMatch, AAgainst: String;
|
|
const ALength: Integer): Boolean;
|
|
begin
|
|
Result := (CompareTextL(AMatch, AAgainst, ALength) = 0);
|
|
end;
|
|
|
|
function CompareTextS(const AMatch, AAgainst: String): Integer;
|
|
begin
|
|
Result := CompareTextL(AMatch, AAgainst, Length(AAgainst));
|
|
end;
|
|
|
|
function SameTextS(const AMatch, AAgainst: String): Boolean;
|
|
begin
|
|
Result := SameTextL(AMatch, AAgainst, Length(AAgainst));
|
|
end;
|
|
|
|
|
|
procedure Split(const ASource, ADelimiter: String; out ADest: TStringDynArray; ASkipEmptyItems: Boolean);
|
|
// StrPos is slow. Sloooooow slow. This function may not be advanced or
|
|
// the fastest one around, but it sure kicks StrPos' ass.
|
|
// 11.5 vs 1.7 seconds on a 2.4 Ghz for 10.000 iterations, baby!
|
|
function StrPosEx(const ASource, ASearch: PChar): PChar;
|
|
var
|
|
pPos: PChar;
|
|
pSub: PChar;
|
|
|
|
begin
|
|
Result := nil;
|
|
|
|
// Search for the first character
|
|
pPos := ASource;
|
|
|
|
while pPos^ <> #0 do
|
|
begin
|
|
if pPos^ = ASearch^ then
|
|
begin
|
|
// Found the first character, match the rest
|
|
pSub := ASearch;
|
|
Result := pPos;
|
|
Inc(pSub);
|
|
Inc(pPos);
|
|
|
|
|
|
while pSub^ <> #0 do
|
|
begin
|
|
if pPos^ <> pSub^ then
|
|
begin
|
|
// No match, resume as normal
|
|
Result := nil;
|
|
break;
|
|
end;
|
|
|
|
Inc(pSub);
|
|
Inc(pPos);
|
|
end;
|
|
|
|
// If still assigned, all characters matched
|
|
if Assigned(Result) then
|
|
exit;
|
|
end else
|
|
Inc(pPos);
|
|
end;
|
|
end;
|
|
|
|
const
|
|
GrowStart = 32;
|
|
GrowMax = 256;
|
|
|
|
var
|
|
capacity: Integer;
|
|
count: Integer;
|
|
delimiterLength: Integer;
|
|
sourceLength: Integer;
|
|
position: Integer;
|
|
size: Integer;
|
|
delimiter: PChar;
|
|
lastPos: PChar;
|
|
currentPos: PChar;
|
|
|
|
begin
|
|
// Reserve some space
|
|
capacity := GrowStart;
|
|
count := 0;
|
|
SetLength(ADest, capacity);
|
|
|
|
delimiterLength := Length(ADelimiter);
|
|
sourceLength := Length(ASource);
|
|
position := 0;
|
|
delimiter := PChar(ADelimiter);
|
|
currentPos := PChar(ASource);
|
|
|
|
repeat
|
|
// Find delimiter
|
|
lastPos := currentPos;
|
|
currentPos := StrPosEx(currentPos, delimiter);
|
|
|
|
if currentPos <> nil then
|
|
begin
|
|
size := (Integer(currentPos) - Integer(lastPos)) div SizeOf(Char);
|
|
|
|
if (size > 0) or (not ASkipEmptyItems) then
|
|
begin
|
|
// Make space
|
|
Inc(count);
|
|
if count > capacity then
|
|
begin
|
|
if capacity < GrowMax then
|
|
Inc(capacity, capacity)
|
|
else
|
|
Inc(capacity, GrowMax);
|
|
|
|
SetLength(ADest, capacity);
|
|
end;
|
|
|
|
// Copy substring
|
|
SetString(ADest[count - 1], lastPos, size);
|
|
end;
|
|
|
|
// Move pointer
|
|
Inc(currentPos, delimiterLength);
|
|
Inc(position, size + delimiterLength);
|
|
end else
|
|
begin
|
|
if position < sourceLength then
|
|
begin
|
|
// Copy what's left
|
|
Inc(count);
|
|
if count > capacity then
|
|
SetLength(ADest, count);
|
|
|
|
ADest[count - 1] := lastPos;
|
|
end;
|
|
|
|
if count <> capacity then
|
|
// Shrink array
|
|
SetLength(ADest, count);
|
|
|
|
break;
|
|
end;
|
|
until False;
|
|
end;
|
|
|
|
|
|
function Join(ASource: array of string; const AGlue: string; ASkipEmptyItems: Boolean): string;
|
|
var
|
|
totalLength: Integer;
|
|
itemIndex: Integer;
|
|
itemLength: Integer;
|
|
itemCount: Integer;
|
|
glueLength: Integer;
|
|
resultPos: PChar;
|
|
firstItem: Boolean;
|
|
|
|
begin
|
|
if High(ASource) = -1 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
|
|
{ Om geheugen-reallocaties te verminderen, vantevoren even
|
|
uitrekenen hoe groot het resultaat gaat worden. }
|
|
itemCount := 0;
|
|
totalLength := 0;
|
|
|
|
for itemIndex := High(ASource) downto Low(ASource) do
|
|
begin
|
|
if (not ASkipEmptyItems) or (Length(ASource[itemIndex]) > 0) then
|
|
begin
|
|
Inc(totalLength, Length(ASource[itemIndex]));
|
|
Inc(itemCount);
|
|
end;
|
|
end;
|
|
|
|
glueLength := Length(AGlue);
|
|
Inc(totalLength, Pred(itemCount) * glueLength);
|
|
|
|
SetLength(Result, totalLength);
|
|
|
|
firstItem := True;
|
|
resultPos := PChar(Result);
|
|
|
|
for itemIndex := Low(ASource) to High(ASource) do
|
|
begin
|
|
itemLength := Length(ASource[itemIndex]);
|
|
|
|
if (not ASkipEmptyItems) or (itemLength > 0) then
|
|
begin
|
|
if not firstItem then
|
|
begin
|
|
Move(PChar(AGlue)^, resultPos^, glueLength * SizeOf(Char));
|
|
Inc(resultPos, glueLength);
|
|
end else
|
|
firstItem := False;
|
|
|
|
Move(PChar(ASource[itemIndex])^, resultPos^, itemLength * SizeOf(Char));
|
|
Inc(resultPos, itemLength);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
function ChildPath(const AChild, AParent: String;
|
|
const AFailIfSame: Boolean): Boolean;
|
|
var
|
|
sChild: String;
|
|
sParent: String;
|
|
|
|
begin
|
|
sChild := AChild;
|
|
sParent := AParent;
|
|
Result := ChildPathEx(sChild, sParent, AFailIfSame);
|
|
end;
|
|
|
|
function ChildPathEx(var AChild, AParent: String;
|
|
const AFailIfSame: Boolean): Boolean;
|
|
begin
|
|
AChild := ExcludeTrailingPathDelimiter(ExpandFileName(AChild));
|
|
AParent := ExcludeTrailingPathDelimiter(ExpandFileName(AParent));
|
|
Result := SameTextS(AChild, AParent) and
|
|
((not AFailIfSame) or
|
|
(Length(AChild) > Length(AParent)));
|
|
end;
|
|
|
|
|
|
function ReplacePart(const ASource: String; const AStart, ALength: Integer;
|
|
const AReplace: String): String;
|
|
var
|
|
iSrcLength: Integer;
|
|
iLength: Integer;
|
|
iDiff: Integer;
|
|
iDest: Integer;
|
|
|
|
begin
|
|
iSrcLength := Length(ASource) * SizeOf(Char);
|
|
iLength := Length(AReplace) * SizeOf(Char);
|
|
iDiff := iLength - ALength;
|
|
iDest := 1;
|
|
|
|
SetLength(Result, iSrcLength + iDiff);
|
|
|
|
// Write first part
|
|
CopyMemory(@Result[iDest], @ASource[1], AStart - 1);
|
|
Inc(iDest, AStart - 1);
|
|
|
|
// Write replacement
|
|
CopyMemory(@Result[iDest], @AReplace[1], iLength);
|
|
Inc(iDest, iLength);
|
|
|
|
// Write last part
|
|
CopyMemory(@Result[iDest], @ASource[AStart + ALength],
|
|
iSrcLength - AStart - (ALength - 1));
|
|
end;
|
|
|
|
end.
|
|
|