Is there a way that I can declare a variable with an absolute address that has some offset to the variable that it refers to. For instance, instead of:
function RefCount(const s: string): Integer;
begin
Result := PInteger(Integer(s) - 8)^;
end;
is there some way that I can do:
function RefCount(const s: string): Integer;
var
Count: PInteger absolute s {- 8 ?} ;
begin
Result := Count^;
end;
(The example is to illustrate only, it is not necessarily useful..)
No, I don't think there is an 'extended syntax' of the absolute keyword. The documentation is here, and, as far as I know, there are no undocumented features related to this keyword.
There is no syntax for what you ask.
What you can do, however, is use pointer arithmetic (if you are using a version that supports it), eg:
function RefCount(const s: string): Integer;
begin
if s <> '' then
Result := (PInteger(s) - 2)^;
else
Result := 0;
end;
A more reliably approach is to use the StrRec record type instead, which is what a String actually contains internally:
function RefCount(const s: string): Integer;
begin
if s <> '' then
Result := (PStrRec(s) - 1)^.refCnt
else
Result := 0;
end;
Or, the non pointer arithmetic version:
function RefCount(const s: string): Integer;
begin
if s <> '' then
Result := PStrRec(LongInt(s) - SizeOf(StrRec))^.refCnt
else
Result := 0;
end;
BTW, starting with D2009+, the System unit has its own StringRefCount() function that retreive a String's reference count.
Related
Consider:
function OuterFunc: integer;
function InnerFunc: integer;
begin
// Here I'd like to access the OuterFunc.Result variable
// for both reading and writing its value
OuterFunc.Result := OuterFunc.Result + 12;
end;
begin
end;
Is there a native syntax to access the OuterFunc Result variable inside InnerFunc? Or is the only way to do this to pass it like a parameter, as in the following?
function OuterFunc: integer;
function InnerFunc(var outerResult: integer): integer;
begin
end;
var
i: integer;
begin
i := InnerFunc(Result);
end;
You can assign result to functions by assigning to the function name, which actually was the original way in Pascal:
function MyFunc: integer;
begin
MyFunc := 2;
// is equal to the following
Result := 2;
end;
So in your case you can write
function OuterFunc: integer;
function InnerFunc: integer;
begin
OuterFunc := 12;
end;
begin
end;
Beware however, that using the function name in a statement block anyware else than on the left side of the assignment operator results in a recursive call, and is therefore different from how the predefined Result works.
In other words, you can not access a previously set value of OuterFunc from within InnerFunc. You would need to use e.g. a local variable in the outer scope defined before InnerFunc to be accessible also from InnerFunc:
function OuterFunc: integer;
var
OuterResult: integer;
function InnerFunc: integer;
begin
OuterResult := 0;
OuterResult := OuterResult + 12;
end;
begin
Result := OuterResult;
end;
For more details refer to Function Declarations in the documentation.
Another option, except for using the native Pascal syntax (as displayed by Tom Brunberg's answer), is converting the local function into a procedure.
function OuterFunc: integer;
procedure InnerFunc(out innerResult: integer);
begin
{OuterFunc's} Result := 0;
innerReuslt := -1;
end;
var
i: integer;
begin
InnerFunc( i );
end;
Since this is your INNER local function you would not break some external API/contract by this simple change.
Twice so since your original code has InnerFunc being the de facto procedure, making no use of its own Result neither by caller, nor by callee.
function OuterFunc: integer;
// function InnerFunc: integer;
procedure InnerFunc;
begin
// here i'd like to access OuterFunc.Result variable
// for both reading and writing its value
// OuterFunc.Result := OuterFunc.Result + 12;
Result := Result + 12;
end;
begin
InnerFunc();
end;
But okay, let's assume you just forgot using BOTH results of BOTH functions, but you did originally intend to.
Still there are few ways at your disposal to cut corners and to hack over the Delphi language intentions-limitations.
Starting with that procedure approach, you may add a function shorthand, if you want to use such a function in expressions.
Though it looks a bit ugly and adds a redirection call for the CPU (you can not inline local functions and if you could Delphi inline implementation is bogged with "register dances"), so slows things down somewhat (but depending on how much you call it w.r.t. other work - that extra work might be non-noticeable).
function OuterFunc: integer;
procedure InnerFunc(out innerResult: integer); overload;
begin
innerResult := +2;
// {OuterFunc's} Result := Result + innerResult;
Inc( Result, innerResult );
end;
function InnerFunc: integer; overload;
begin
InnerFunc( Result );
end;
var
i: integer;
begin
// InnerFunc( i );
i := InnerFunc();
end;
And yet another hack is declaring the variables overlapping.
function OuterFunc: integer;
var Outer_Result: integer absolute Result;
i: integer;
function InnerFunc: integer;
begin
Result := +2;
Inc( Outer_Result, Result );
end;
begin
i := InnerFunc();
end;
Now, this approach might kill the optimizations, like placing the "result" in the CPU registers, forcing using the RAM for it, which is slower.
Additionally, once you might wish to change the type of the OuterFunc and if you forget to change the type of the Outer_Result var accordingly - you screwed yourself.
function OuterFunc: double; // was - integer; Proved to be not enough since 2020
var Outer_Result: integer absolute Result; // and here we forgot to sync type changing.... ooooops!
i: integer;
function InnerFunc: integer;
....
So less hackish way to express that intention (at the price of allocating and accessing yet one more in-RAM variable) would be this:
function OuterFunc: integer;
{$T+} // we need to enable type checking: predictability is safety
var Outer_Result: ^integer;
i: integer;
function InnerFunc: integer;
begin
Result := +2;
Inc( Outer_Result^, Result );
end;
begin
Outer_Result := #Result;
i := InnerFunc();
end;
But all these options are hack-arounds, breaking conceptual clarity, thus hampering ability for people to read/understand the program in the future.
If you need the variable - then do declare the variable. That would be the most clear option here. Afterall programs are more written for the future programmers to read them than for the computers to compile them. :-)
function OuterFunc: integer;
var the_Outer_Result: integer;
function InnerFunc;
begin
Result := +2;
Inc( the_Outer_Result, Result );
end;
var
i: integer;
begin
the_Outer_Result := 0;
.....
I := InnerFunc();
.....
Result := the_Outer_Result;
end;
That way you would not fight with the language, but give up and use it as it was intended to use. Fighting and outsmarting the language is always fun, but in the long term, when you have to maintain the code any human being last read 5 years ago and port it to newer versions of Delphi/libraries/Windows - then such the non-natural smart tricks tend to become quite annoying.
I know, I can write
if C in ['#', ';'] then ...
if C is an AnsiChar.
But this
function CheckValid(C: Char; const Invalid: array of Char; OtherParams: TMyParams): Boolean;
begin
Result := C in Invalid; // <-- Error because Invalid is an array not a set
//maybe other tests...
//Result := Result and OtherTestsOn(OtherParams);
end;
yields E2015: Operator not applicable to this operand type.
Is there an easy way to check if a character is contained in an array of characters (other than iterate through the array)?
I know you don't want to, but this is one of those cases where iterating through the array really is your best option, for performance reasons:
function CheckValid(C: Char; const Invalid: array of Char): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(Invalid) to High(Invalid) do begin
if Invalid[I] = C then begin
Result = True;
Exit;
end;
end;
end;
Or:
function CheckValid(C: Char; const Invalid: array of Char): Boolean;
var
Ch: Char;
begin
Result := False;
for Ch in Invalid do begin
if Ch = C then begin
Result = True;
Exit;
end;
end;
end;
Converting the input data to strings just to search it can cause huge performance bottlenecks, especially if the function is called often, such as in a loop.
If one tries to avoid iterating through the array and if speed is of no concern then IndexOfAny can be helpful:
function CheckValid(C: Char; const Invalid: array of Char; OtherParams: TMyParams): Boolean;
begin
Result := string(C).IndexOfAny(Invalid) >= 0;
//maybe other test...
//....
end;
From the Delphi documentation:
[IndexOfAny r]eturns an integer indicating the position of the first given character found in the 0-based string. [It returns -1 if the character is not found.]
If speed is of concern, this should be avoided as #RemyLebeau explains in the comments:
Casting C to String to call IndexOfAny() will create 1 temp String. [...] if CheckValid() is called often, those conversions can be a BIG performance bottleneck, not to mention a waste of memory.
In this case #RemyLebeau's answer is the better solution.
How can I concat an array of strings with Move. I tried this but I just cannot figure how to get Move operation working correctly.
program Project2;
{$POINTERMATH ON}
procedure Concat(var S: String; const A: Array of String);
var
I, J: Integer;
Len: Integer;
begin
Len := 0;
for I := 0 to High(A) do
Len := Len + Length(A[I]);
SetLength(S, Length(S) + Len);
for I := 0 to High(A) do
Move(PWideChar(A[I])[0], S[High(S)], Length(A[I]) * SizeOf(WideChar));
end;
var
S: String;
begin
S := 'test';
Concat(S, ['test', 'test2', 'test3']);
end.
I'd write this function like so:
procedure Concat(var Dest: string; const Source: array of string);
var
i: Integer;
OriginalDestLen: Integer;
SourceLen: Integer;
TotalSourceLen: Integer;
DestPtr: PChar;
begin
TotalSourceLen := 0;
OriginalDestLen := Length(Dest);
for i := low(Source) to high(Source) do begin
inc(TotalSourceLen, Length(Source[i]));
end;
SetLength(Dest, OriginalDestLen + TotalSourceLen);
DestPtr := PChar(Pointer(Dest)) + OriginalDestLen;
for i := low(Source) to high(Source) do begin
SourceLen := Length(Source[i]);
Move(Pointer(Source[i])^, DestPtr^, SourceLen*SizeOf(Char));
inc(DestPtr, SourceLen);
end;
end;
It's fairly self-explanatory. The complications are caused by empty strings. Any attempt to index characters of an empty string will lead to exceptions when range checking is enabled.
To handle that complication, you can add if tests for the case where one of the strings involved in the Move call is empty. I prefer a different approach. I'd rather cast the string variable to be a pointer. That bypasses range checking but also allows the if statement to be omitted.
Move(Pointer(Source[i])^, DestPtr^, SourceLen*SizeOf(Char));
One might wonder what happens if Source[i] is empty. In that case Pointer(Source[i]) is nil and you might expect an access violation. In fact, there is no error because the length of the move as specified by the third argument is zero, and the nil pointer is never actually de-referenced.
The other line of note is here:
DestPtr := PChar(Pointer(Dest)) + OriginalDestLen;
We use PChar(Pointer(Dest)) rather than PChar(Dest). The latter invokes code to check whether or not Dest is empty, and if so yields a pointer to a single null-terminator. We want to avoid executing that code, and obtain the address held in Dest directly, even if it is nil.
In the second loop you forget that S already has the right size to get filled with all the elements so you have to use another variable to know the destination parameter of Move
procedure Concat(var S: String; const A: Array of String);
var
I, Len, Sum: Integer;
begin
Len := 0;
for I := 0 to High(A) do
Inc(Len, Length(A[I]));
Sum := Length(S);
SetLength(S, Sum + Len);
for I := 0 to High(A) do
begin
if Length(A[I]) > 0 then
Move(A[I][1], S[Sum+1], Length(A[I]) * SizeOf(Char));
Inc(Sum, Length(A[I]));
end;
end;
Casting the source parameter to PWideChar is totally superfluous since the Move function use a kind of old generic syntax that allows to pass everything you want (const Parameter without type).
With Delphi XE4, try the following code:
procedure TForm3.Button1Click(Sender: TObject);
var
myStr: string;
begin
Edit1.Text := TPerlRegEx.EscapeRegExChars('test');
end;
The result (Edit1.Text) is empty.
Is this a bug or I'm missing something? I previously had no problem with this TPerlRegEx.EscapeRegExChars function with the version from regular-expressions.info pre-DelphiXE.
Update 2: Just upgrading an app written in D2010 and encountering this bug, but just wondering how such an obvious bug can exist this long... now I'm seriously considering making my code compatible to Free Pascal, but I really like the antonymous method...
Update 1: I'm using Delphi XE4 Update 1.
It appears to be a bug. If that's the case, both the XE4 and XE5 versions contain it. I've opened a QC report to report it for XE4..XE6.
The problem appears to be with the last line of the function:
Result.Create(Tmp, 0, J);
Stepping through in the debugger shows that the Tmp (a TCharArray) correctly contains 't','e','s','t', #0, #0, #0, #0 at that point, yet Result contains '' when the function actually returns, as setting a breakpoint on the end; following that line indicates that result contains '' at that point (and when the function returns).
Providing a replacement version in a class helper with a minor change to actually store the return value from the call to Create fixes the problem:
type
TPerlRegExHelper = class helper for TPerlRegEx
public
class function EscapeRegExCharsEx(const S: string): string; static;
end;
class function TPerlRegExHelper.EscapeRegExCharsEx(const S: string): string;
var
I, J: Integer;
Tmp: TCharArray;
begin
SetLength(Tmp, S.Length * 2);
J := 0;
for I := Low(S) to High(S) do
begin
case S[I] of
'.', '[', ']', '(', ')', '?', '*', '+', '{', '}', '^', '$', '|', '\':
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := S[I];
end;
#0:
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := '0';
end;
else
Tmp[J] := S[I];
end;
Inc(J);
end;
{ Result.Create(Tmp, 0, J); } // The problem code from the original
Result := String.Create(Tmp, 0, J);
end;
The XE3 (and the open-source version you mention) implement the logic totally differently, using the more standard manipulation of Result beginning at the first line of the function with Result := S;, and then using System.Insert as needed to add room for the escape characters.
This is a bug introduced in the XE4 release that is still present in XE6. Previous versions were fine. It looks like the changes were made in readiness for some future switch to immutable strings.
Rather ironically the bug is caused by the string never being assigned a value at all. It's one thing to set out not to mutate a string, but quite another never to initialize it!
So to the analysis of the bug. The method in question in TPerlRegEx.EscapeRegExChars defined in the System.RegularExpressionsCore unit. This is a class function that returns a string. Its signature is:
class function EscapeRegExChars(const S: string): string;
The XE4 implementation makes but one reference to the result variable. As follows:
Result.Create(Tmp, 0, J);
Here, Tmp is an array of char containing the escaped text to be returned, and J is the length of that text.
So, it seems clear that the author intended for this code to assign to the function return variable Result. Sadly that does not occur. Why not? Well, the Create method being called is defined in the helper for string. This is TStringHelper defined in the System.SysUtils unit. There are three Create overloads and the one in play here is:
class function Create(const Value: array of Char; StartIndex: Integer;
Length: Integer): string; overload; static;
Note that this is a class static function. That means that it is not an instance method and has no Self pointer. So when called like this:
Result.Create(Tmp, 0, J);
It is simply a function call whose return value is ignored. It might appear that the result variable would be set but remember that this Create is a class static method. It therefore has no instance. The compiler simply uses the type of Result to resolve the method. The code is equivalent to:
string.Create(Tmp, 0, J);
Nothing more exciting than a call to a function whose return value is simply ignored. Defeated by the extended syntax that allows us to ignore function return values.
The fix to the code is simple enough. Replace that final line with
Result := string.Create(Tmp, 0, J);
You could apply the fix in a copy of the unit, and include that unit in your code. An alternative to that, my preferred option, is to use a code hook. Like this:
unit FixTPerlRegExEscapeRegExChars;
interface
implementation
uses
System.SysUtils, Winapi.Windows, System.RegularExpressionsCore;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, #OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
function EscapeRegExChars(Self: TPerlRegEx; const S: string): string;
var
I, J: Integer;
Tmp: TCharArray;
begin
SetLength(Tmp, S.Length * 2);
J := 0;
for I := Low(S) to High(S) do
begin
case S[I] of
'.', '[', ']', '(', ')', '?', '*', '+', '{', '}', '^', '$', '|', '\':
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := S[I];
end;
#0:
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := '0';
end;
else
Tmp[J] := S[I];
end;
Inc(J);
end;
Result := string.Create(Tmp, 0, J);
end;
initialization
RedirectProcedure(#TPerlRegEx.EscapeRegExChars, #EscapeRegExChars);
end.
Add this unit to your project and the calls to TPerlRegEx.EscapeRegExChars will start working again.
{$APPTYPE CONSOLE}
uses
System.RegularExpressionsCore,
FixTPerlRegExEscapeRegExChars in 'FixTPerlRegExEscapeRegExChars.pas';
begin
Writeln(TPerlRegEx.EscapeRegExChars('test'));
Readln;
end.
Output
test
QC#124091
I have some files in a directory. I try get these files with FindFirst and FindNext but I can't get same order on Windows 7.
C:\Test
SampleFile.0.png
SampleFile.1.png
SampleFile.2.png
SampleFile.3.png
SampleFile.4.png
SampleFile.5.png
SampleFile.6.png
SampleFile.7.png
SampleFile.8.png
SampleFile.9.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.20.png
SampleFile.21.png
SampleFile.22.png
When I try using my code I've got
SampleFile.0.png
SampleFile.1.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.2.png
SampleFile.20.png
SampleFile.21.png
.
.
.
How can I get file list on correct rank order?
Procedure Test;
var
sr : TSearchRec;
i : integer;
ListFiles : TStringList;
begin
ListFiles := TStringList.Create;
i := FindFirst('c:\test\*.png', faDirectory, sr);
while i = 0 do begin
ListFiles.Add(ExtractFileName(sr.FindData.cFileName));
i := FindNext(sr);
end;
FindClose(sr);
end;
Note : Result is still wrong, if I can use ListFiles.Sorted = True
I think I've a solution, created a function.
function SortFilesByName(List: TStringList; Index1, Index2: Integer): integer;
var
FileName1, FileName2: String;
i, FileNumber1, FileNumber2: Integer;
begin
FileName1 := ChangeFileExt(ExtractFileName(List[Index1]), '');
FileName2 := ChangeFileExt(ExtractFileName(List[Index2]), '');
i := POS('.', FileName1)+1;
FileNumber1 := StrToInt(Copy(FileName1, i, MaxInt));
i := POS('.', FileName2)+1;
FileNumber2 := StrToInt(Copy(FileName2, i, MaxInt));
Result := (FileNumber1 - FileNumber2);
end;
I've added another line
ListFiles.CustomSort(SortFilesByName); //(ListFiles,1,2):integer);
before
FindClose(sr);
As jachguate said, the sorting is done by Explorer.exe, not the filesystem. FindFirst/FindNext does not guarantee any specific sorting, including plain ASCII based, so you shouldn't rely on it. You don't, however, need to re-implement the numeric sort in Delphi. Windows exposes the one it uses as StrCmpLogicalW, which is in shlwapi.dll. The import looks like this:
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall;
external 'shlwapi.dll'
It is possible to disable that behavior in Windows. If you want to follow the order that Windows uses, you need to call SHRestricted with the REST_NOSTRCMPLOGICAL value. If it returns true you should use AnsiCompareStr instead.
const
// Use default CompareString instead of StrCmpLogical
REST_NOSTRCMPLOGICAL = $4000007E;
function SHRestricted(rest: DWORD): LongBool; stdcall; external 'shell32.dll';
So your final sort function should be something like this:
function CompareFilenames(const AFilename1, AFilename2: string): Integer;
begin
if SHRestricted(REST_NOSTRCMPLOGICAL) then
Result := AnsiCompareStr(AFilename1, AFilename2)
else
Result := StrCmpLogicalW(PWideChar(AFilename1), PWideChar(AFilename2));
end;
You can cache the result of the SHRestricted call, but if you do you need to watch for the WM_SETTINGSCHANGE broadcast message and re-read it when you get one.
The different orders you see in the windows explorer is implemented in explorer.exe and not in the file system.
The Numerical sort order is a new feature in windows 7, so if you sort by name and you have a bunch of files with a prefix followed by numbers, the explorer "identifies" that pattern and doesn't present a list sorted by name in the traditional way, but sorted by prefix and then by number (as if the string were a Integer number).
If you want to do the same in Delphi, you can do it by adding all the file names returned by FindFirst/FindNext to a TSlist and then sort the string list using this compare function:
var
FileNames: TList<string>;
begin
FileNames := TList<string>.Create;
try
SearchForFiles(FileNames); //here you add all the file names
//sort file names a la windows 7 explorer
FileNames.Sort(System.Generics.Defaults.TComparer<string>.Construct(
function (const s1, s2: string): Integer
procedure ProcessPrefix(const fn: string; var prefix, number: string);
var
I: Integer;
begin
for I := length(fn) downto 1 do
if not TCharacter.IsDigit(fn[I]) then
begin
Prefix := Copy(fn, 1, I);
number := Copy(fn, I+1, MaxInt);
Break;
end;
end;
var
prefix1, prefix2: string;
number1, number2: string;
fn1, fn2: string;
begin
//compare filenames a la windows 7 explorer
fn1 := TPath.GetFileNameWithoutExtension(s1);
fn2 := TPath.GetFileNameWithoutExtension(s2);
ProcessPrefix(fn1, prefix1, number1);
ProcessPrefix(fn2, prefix2, number2);
if (Number1 <> '') and (Number2 <> '') then
begin
Result := CompareText(prefix1, prefix2);
if Result = 0 then
Result := CompareValue(StrToInt(number1), StrToInt(Number2));
end
else
Result := CompareText(s1, s2);
end
));
UseYourSortedFileNames(FileNames);
finally
FileNames.Free;
end;
end;
By "rank", you mean sort order.
The files are sorting in the proper order (based on the ASCII value of the characters). 2 comes after 19 because the comparison is only made up to the same number of characters in both names, and '2' comes after 1.
If you want them to sort properly as numbers, you need to left-pad the numbers with zeros so they're all the same width (eg., instead of SampleFile.2.png, use SampleFile.02.png). This will cause '02' to come before 19 so they sort correctly numerically.
You can fix the numbering issue by using something like:
PngFileName := Format('SampleFile.%.2d.png', [Counter]);