I have a function inside an object that concatenates JSON text. The function result is a String - the resulting JSON text. The function simply appends text to the end of the result...
function TDestination.GetAsJSON: String;
procedure A(const Text: String);
begin
Result:= Result + Text + sLineBreak;
end;
begin
A(' {');
A(' "name":"'+EncodeStr(FName)+'",');
A(' "directory":"'+EncodeStr(FDirectory)+'",');
A(' "description":"'+EncodeStr(FDescription)+'"');
A(' }');
end;
This function is called repeatedly in a loop from within another parent object...
function TDestinations.GetAsJSON: String;
procedure A(const Text: String);
begin
Result:= Result + Text + sLineBreak;
end;
var
X: Integer;
begin
A(' [');
for X := 0 to Count - 1 do begin
if X > 0 then A(' ,');
Result:= Result + Items[X].AsJSON;
end;
A(' ]');
end;
In the second function, Items[X].AsJSON is calling the first function.
The problem is that the second (and all further) calls to TDestination.GetAsJSON still have the string sitting in the function result from the last time it was called.
The solution is to simply initialize the result with Result:= ''; at the beginning of the function. But the question is why should I have to? Why does this string get left behind?
What makes it puzzling is that each different call to this function is from within a completely separate instance of that object. I would understand if it was the exact same object instance, but it's not.
Guido Gybels in his article "Using Assembler in Delphi" denotes that functions with long string type result return it as implicit var-parameter. So compiler treats your function as:
(hidden)var
temp_s: String;
procedure GetAsJSON(var temps: String);
...
GetAsJSON(temp_s);
UsedResult1 := temp_s;
...
GetAsJSON(temp_s);
UsedResult2 := temp_s;
So hidden string can retain its value under certain conditions.
Anyway, you're not relying on the initialization of integer result by 0, right?
Edit: This behavior is documented: Delphi help link (section Handling Function Results)
Related
After looking at Delphi extract string between to 2 tags and trying the code given there by Andreas Rejbrand I realized that I needed a version that wouldn't stop after one tag - my goal is to write all the values that occur between two strings in several .xml files to a logfile.
<screen> xyz </screen> blah blah <screen> abc </screen>
-> giving a logfile with
xyz
abc
... and so on.
What I tried was to delete a portion of the text read by the function, so that when the function repeated, it would go to the next instance of the desired string and then write that to the logfile too until there were no matches left - the boolean function would be true and the function could stop - below the slightly modified function as based on the version in the link.
function ExtractText(const Tag, Text: string): string;
var
StartPos1, StartPos2, EndPos: integer;
i: Integer;
mytext : string;
bFinished : bool;
begin
bFinished := false;
mytext := text;
result := '';
while not bFinished do
begin
StartPos1 := Pos('<' + Tag, mytext);
if StartPos1 = 0 then bFinished := true;
EndPos := Pos('</' + Tag + '>', mytext);
StartPos2 := 0;
for i := StartPos1 + length(Tag) + 1 to EndPos do
if mytext[i] = '>' then
begin
StartPos2 := i + 1;
break;
end;
if (StartPos2 > 0) and (EndPos > StartPos2) then
begin
result := result + Copy(mytext, StartPos2, EndPos - StartPos2);
delete (mytext, StartPos1, 1);
end
So I create the form and assign a logfile.
procedure TTagtextextract0r.FormCreate(Sender: TObject);
begin
Edit2.Text:=(TDirectory.GetCurrentDirectory);
AssignFile(LogFile, 'Wordlist.txt');
ReWrite(LogFile);
CloseFile(Logfile);
end;
To then get the files in question, I click a button which then reads them.
procedure TTagtextextract0r.Button3Click(Sender: TObject);
begin
try
sD := TDirectory.GetCurrentDirectory;
Files:= TDirectory.GetFiles(sD, '*.xml');
except
exit
end;
j:=Length(Files);
for k := 0 to j-1 do
begin
Listbox2.Items.Add(Files[k]);
sA:= TFile.ReadAllText(Files[k]);
iL:= Length(sA);
AssignFile(LogFile, 'Wordlist.txt');
Append(LogFile);
WriteLn(LogFile, (ExtractText('screen', sA)));
CloseFile (LogFile);
end;
end;
end.
My problem is that without the boolean loop in the function, the application only writes the one line per file and then stops but with the boolean code the application gets stuck in an infinite loop - but I can't quite see where the loop doesn't end. Is it perhaps that the "WriteLn" command can't then output the result of the function? If it can't, I don't know how to get a new line for every run of the function - what am I doing wrong here?
First you need to get a grip on debugging
Look at this post for a briefing on how to pause and debug a program gone wild.
Also read Setting and modifying breakpoints to learn how to use breakpoints. If you would have stepped through your code, you would soon have seen where you go wrong.
Then to your problem:
In older Delphi versions (up to Delphi XE2) you could use the PosEx() function (as suggested in comments), which would simplify the code in ExtractText() function significantly. From Delphi XE3 the System.Pos() function has been expanded with the same functionality as PosEx(), that is, a third parameter Offset: integer
Since you are on Delphi 10 Seattle you can use interchangeably either System.StrUtils.PosEx() or System.Pos().
System.StrUtils.PosEx
PosEx() returns the index of SubStr in S, beginning the search at
Offset
function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer; inline; overload;
The implementation of ExtractText() could look like this (with PosEx()):
function ExtractText(const tag, text: string): string;
var
startPos, endPos: integer;
begin
result := '';
startPos := 1;
repeat
startPos := PosEx('<'+tag, text, startpos);
if startPos = 0 then exit;
startPos := PosEx('>', text, startPos)+1;
if startPos = 1 then exit;
endPos := PosEx('</'+tag+'>', text, startPos);
if endPos = 0 then exit;
result := result + Copy(text, startPos, endPos - startPos) + sLineBreak;
until false;
end;
I added sLineBreak (in unit System.Types) after each found text, otherwise it should work as you intended it (I believe).
Is it possible to call the same function definition with parameters by value and later in the run time, by reference?
something like:
function myfunc(a:string);
begin
a:='abc';
end;
...
later:
b:='cde';
myfunc(b);
caption:=b; //prints 'cde'
...
later:
myfunc(#b);
caption:=b; //prints 'abc'
??
Not the same function, no. You need to use overloaded functions instead, eg:
function myfunc(a: string); overload;
begin
// use a as needed, caller is not updated...
a := 'abc';
end;
function myfunc(a: PString); overload;
begin
// modify a^ as needed, caller is updated...
a^ := 'abc';
end;
b := 'cde';
myfunc(b);
Caption := b; //prints 'cde'
b := 'cde';
myfunc(#b);
Caption := b; //prints 'abc'
First note that your function cannot be called by reference because of the way it's declared.
function myfunc(a: string); overload;
You would have to change this to:
function myfunc(var a: string); overload;
But if you want to call the same function, you need to call the function with a discard variable that is a copy of the input.
b := 'cde';
discard := b;
myfunc(discard);
caption := b; //uses 'cde'
However you can create a second function that trivially wraps the first for you and discards the by ref change:
function myfunc2(s: string);
begin
Result := myfunc(s);
end;
//Now the earlier code becomes:
b := 'cde';
myfunc2(b);
caption := b; //uses 'cde'
Note, that unlike Remy's answer this uses a different function name and not an overload, because the compiler would be unable to detect which of the 2 functions to call. However, I would strongly argue that this is a good thing. One of the worst things you can do for the maintainability of your program is write identically named functions that are fundamentally different. It makes it very confusing to figure out what is happening on a particular line of code.
When compiling the following code:
procedure TMainWin.FormActivate(Sender: TObject);
var LineRaw : String;
LinesFile : TextFile;
i, i2 : integer;
tempChar : String;
CurTempCharPos : integer;
begin
AssignFile(LinesFile, 'Lines.txt');
Reset(LinesFile);
i := 0;
tempChar := '';
CurTempCharPos := 1;
while not EoF(LinesFile) do begin
i := i+1; //ticker
ReadLn(LinesFile, LineRaw);
for i2 := 0 to 4 do begin
tempChar := LineRaw[CurTempCharPos] + LineRaw[CurTempCharPos +1];
Lines[i,i2] := IntToStr(tempChar);
tempChar := '';
CurTempCharPos := CurTempCharPos + 3;
end;
end;
CloseFile(LinesFile);
end;
With Lines being defined in another form:
unit uGlobal;
interface
type
aLines = array[1..5] of integer;
aLinesFinal = array of aLines;
var
Lines : aLinesFinal;
implementation
end.
I get the following error: There is no overloaded version of 'IntToStr' that can be called with these arguments. The error points to the line:
Lines[i,i2] := IntToStr(tempChar);
Here is the declaration of tempChar:
tempChar : String;
It is a string. And here is the call that the compiler rejects:
Lines[i,i2] := IntToStr(tempChar);
The IntToStr function, which has various overloads, accepts integer input parameters and returns strings. You cannot pass a string to IntToStr. Perhaps you meant to write:
Lines[i,i2] := StrToInt(tempChar);
Some other comments:
I doesn't look like you initialised Lines. This means that whilst the code might compile, it will fail at runtime.
Since you declared aLines as array[1..5] of integer, the valid values for i2 are 1 to 5 inclusive. You use 0 to 4 inclusive. Again, that's going to bite at runtime.
You really should enable range checking as a matter of urgency, since when you start executing this code that setting will reveal the errors above, and no doubt more besides.
In my view tempChar is a poor name for something that can hold more than a single character.
As #TLama points out, OnActivate seems to be an unusual place to execute this code. This event will run multiple times. Perhaps you should be executing this code at start up. In any case, code like this should not be in an event handler and should be moved to a separate method which an event handler can call.
I have written a Delphi function that loads data from a .dat file into a string list. It then decodes the string list and assigns to a string variable. The contents of the string use the '#' symbol as a separator.
How can I then take the contents of this string and then assign its contents to local variables?
// Function loads data from a dat file and assigns to a String List.
function TfrmMain.LoadFromFile;
var
index, Count : integer;
profileFile, DecodedString : string;
begin
// Open a file and assign to a local variable.
OpenDialog1.Execute;
profileFile := OpenDialog1.FileName;
if profileFile = '' then
exit;
profileList := TStringList.Create;
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
Line := '';
Line := profileList[Index];
end;
end;
After its been decoded the var "Line" contains something that looks like this:
example:
Line '23#80#10#2#1#...255#'.
Not all of the values between the separators are the same length and the value of "Line" will vary each time the function LoadFromFile is called (e.g. sometimes a value may have only one number the next two or three etc so I cannot rely on the Copy function for strings or arrays).
I'm trying to figure out a way of looping through the contents of "Line", assigning it to a local variable called "buffer" and then if it encounters a '#' it then assigns the value of buffer to a local variable, re-initialises buffer to ''; and then moves onto the next value in "Line" repeating the process for the next parameter ignoring the '#' each time.
I think I have been scratching around with this problem for too long now and I cannot seem to make any progress and need a break from it. If anyone would care to have a look, I would welcome any suggestions on how this might be achieved.
Many Thanks
KD
You need a second TStringList:
lineLst := TStringList.Create;
try
lineLst.Delimiter := '#';
lineLst.DelimitedText := Line;
...
finally
lineLst.Free;
end;
Depending on your Delphi version you can set lineLst.StrictDelimiter := true in case the line contains spaces.
You can do something like this:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, StrUtils;
var
S : string;
D : string;
begin
S := '23#80#10#2#1#...255#';
for D in SplitString(S,'#') do //SplitString is in the StrUtils unit
writeln(D);
readln;
end.
You did not tag your Delphi version, so i don't know if it applies or not.
That IS version-specific. Please do!
In order of my personal preference:
1: Download Jedi CodeLib - http://jcl.sf.net. Then use TJclStringList. It has very nice split method. After that you would only have to iterate through.
function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList;
uses JclStringLists;
...
var s: string; js: IJclStringList.
begin
...
js := TJclStringList.Create().Split(input, '#', True);
for s in js do begin
.....
end;
...
end;
2: Delphi now has somewhat less featured StringSplit routine. http://docwiki.embarcadero.com/Libraries/en/System.StrUtils.SplitString
It has a misfeature that array of string type may be not assignment-compatible to itself. Hello, 1949 Pascal rules...
uses StrUtils;
...
var s: string;
a_s: TStringDynArray;
(* aka array-of-string aka TArray<string>. But you have to remember this term exactly*)
begin
...
a_s := SplitString(input, '#');
for s in a_s do begin
.....
end;
...
end;
3: Use TStringList. The main problem with it is that it was designed that spaces or new lines are built-in separators. In newer Delphi that can be suppressed. Overall the code should be tailored to your exact Delphi version. You can easily Google for something like "Using TStringlist for splitting string" and get a load of examples (like #Uwe's one).
But you may forget to suppress here or there. And you may be on old Delphi,, where that can not be done. And you may mis-apply example for different Delphi version. And... it is just boring :-) Though you can make your own function to generate such pre-tuned stringlists for you and carefully check Delphi version in it :-) But then You would have to carefully free that object after use.
I use a function I've written called Fetch. I think I stole the idea from the Indy library some time ago:
function Fetch(var VString: string; ASeperator: string = ','): string;
var LPos: integer;
begin
LPos := AnsiPos(ASeperator, VString);
if LPos > 0 then
begin
result := Trim(Copy(VString, 1, LPos - 1));
VString := Copy(VString, LPos + 1, MAXINT);
end
else
begin
result := VString;
VString := '';
end;
end;
Then I'd call it like this:
var
value: string;
line: string;
profileFile: string;
profileList: TStringList;
index: integer;
begin
if OpenDialog1.Execute then
begin
profileFile := OpenDialog1.FileName;
if (profileFile = '') or not FileExists(profileFile) then
exit;
profileList := TStringList.Create;
try
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
line := profileList[index];
Fetch(line, ''''); //discard "Line '"
value := Fetch(line, '#')
while (value <> '') and (value[1] <> '''') do //bail when we get to the quote at the end
begin
ProcessTheNumber(value); //do whatever you need to do with the number
value := Fetch(line, '#');
end;
end;
finally
profileList.Free;
end;
end;
end;
Note: this was typed into the browser, so I haven't checked it works.
I want to create a function that receive multiples strings as parameters.
Like the function printf("Hello %s",name); of C. but I don't want to pass a ready array, it wouldn't be readable.
Edit1.text:=lang('Hello');
Edit2.text:=lang('Welcome to {1} guest',place);
Edit3.text:=lang('Hi {1}, is your {2} time in {3}','Victor','first','Disney');
output should be:
Hello
Welcome to Disney guest
Hi Victor is your first time in Disney
how I create the function TForm1.lang(parameters:String):String;, I did a research, but I can't get it work.
I need to access the parameters[] and the parameters.length also.
I'm needing this to turn my App to multilang.
Here's an example function of how you can do this:
function TForm1.lang(s: String; params: array of String): String;
var
i: Integer;
begin
for i := 0 to High(params) do
begin
ShowMessage(params[i]);
end;
end;
Call it like this:
lang('My format string', ['this', 'that']);
or like this:
var
b: String;
begin
b := 'this';
lang('My format string', [b, 'that']);
end;
Not sure what you mean by not readable
DoSomething(['Param1','Param2']);
for
procedure DoSomething(args : Array of String);
Var
Index : Integer;
Begin
for index := Low(args) to High(args) Do
ShowMessage(args[Index]);
End;
Seems okay to me. Course if you want to call it from outside delphi then you have an issue.
Quick fix is just to pass in a delimited string and then user TStringList to split it.
You could write a wee function to do that, don't forget to free it when you are done.
All your three examples could be fixed by using SysUtils.Format:
Edit1.text := format('%s',['Hello']));
Edit1.text := format('Welcome to %s guest',[place]));
Edit1.text := format('Hi %s, is your %s time in %s',['Victor','first','Disney']));
Personally I think it's quite readable. If you can have what you need from a basic sysutils function, you should seriously consider doing that, rather than to write your own version. On the other hand, you may need more complex functionality that doesn't show in your question. If that's the case, I think paulsm4's suggestion of using a stringlist seems like a good way to go.
Delphi does not support CREATING functions withvararg-style parameters that work exactly like printf() does. It only supports CONSUMING such functions from external libraries. The closest Delphi comes to supporting the creation of functions with variable parameter lists is to use "open array" parameters, like what SysUtils.Format() uses.
As Tony mentions above, I also recommend using a deliminated string. Except, a little more than just deliminating, but using more of a parsing technique. If I understand right, this function you're making for formatting shall NOT include an array in the parameters, but technically, that doesn't mean we can't use arrays anywhere at all (arrays are very ideal to use for this scenario for fast performance).
This method will allow virtually anything to be passed in the parameters, including the deliminator, without affecting the output. The idea is to do A) Size of parameter string, B) Deliminator between size and parameter, and C) parameter string... And repeat...
const
MY_DELIM = '|'; //Define a deliminator
type
TStringArray = array of String;
/////////////////////////////////
//Convert an array of string to a single parsable string
// (Will be the first step before calling your format function)
function MakeParams(const Params: array of String): String;
var
X: Integer;
S: String;
begin
Result:= '';
for X:= 0 to Length(Params)-1 do begin
S:= Params[X];
Result:= Result + IntToStr(Length(S)) + MY_DELIM + S;
end;
end;
//Convert a single parsable string to an array of string
// (Will be called inside your format function to decode)
// This is more or less called parsing
function ExtractParams(const Params: String): TStringArray;
var
S: String; //Used for temporary parsing
T: String; //Used for copying temporary data from string
P: Integer; //Used for finding positions
C: Integer; //Used for keeping track of param count
Z: Integer; //Used for keeping track of parameter sizes
begin
S:= Params; //Because we'll be using 'Delete' command
C:= 0; //Set count to 0 to start
SetLength(Result, 0); //Prepare result array to 0 parameters
while Length(S) > 0 do begin //Do loop until nothing's left
P:= Pos(MY_DELIM, S); //Get position of next deliminator
if P > 1 then begin //If deliminator was found...
C:= C + 1; //We have a new parameter
SetLength(Result, C); //Set array length to new parameter count
T:= Copy(S, 1, P-1); //Get all text up to where deliminator was found
Delete(S, 1, P); //Delete what we just copied, including deliminator
Z:= StrToIntDef(T, 0); //Convert T:String to Z: Integer for size of parameter
T:= Copy(S, 1, Z); //Get all text up to 'Z' (size of parameter)
Delete(S, 1, Z); //Delete what we just copied
Result[C-1]:= T; //Assign the new parameter to end of array result
end else begin //If deliminator was NOT found...
S:= ''; //Clear S to exit loop (possible bad format if this happens)
end;
end;
end;
//Main formatting routine
function MyFormat(const Input: String; const Params: String): String;
var
A: TStringArray;
X: Integer;
S: String;
P: Integer;
R: String;
begin
R:= Input;
A:= ExtractParams(Params);
//At this point, A contains all the parameters parsed from 'Params'
for X:= 0 to Length(A)-1 do begin
S:= A[X];
P:= Pos('%s', R);
if P > 0 then begin
Delete(R, P, 2);
Insert(S, R, P);
end;
end;
Result:= R;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Pars: String;
begin
Pars:= MakeParams(['this', 'that', 'something else']);
Edit1.Text:= MyFormat('%s is %s but not %s', Pars);
end;
As you probably know, SysUtils.Format() implements "varargs" by using a set.
In your case, however, why not just pass a TStringList? The function will simply check "list.Count". Voila - you're done!