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.
Related
I've attempted to implement a merge sort for strings however I cannot perform the recursive part and I get the error "Invalid Pointer Operation"
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
var i : Integer;
const MyArray : array[1..5]of string = ('hi', 'zebra', 'apple', 'Xylophone', 'dog');
Procedure merge(result, left, right : array of string);
var i, i1, i2 : Integer;
begin
i1 := 0;
i2 := 0;
for i := 0 to Length(result) do
begin
if (i2 >= Length(right)) or (i1 < Length(left)) and (StrComp(PChar(left[i]), PChar(right[i2])) < 0) then
begin
result[i] := left[i1];
inc(i1);
end
else
begin
result[i] := right[i2];
inc(i2);
end;
end;
end;
Procedure mergeSort(OriginalList : array of string);
var left, right : array of string;
i : Integer;
begin
if (Length(OriginalList) >= 2) then
begin
setlength(left, length(OriginalList) div 2);
setlength(right, length(OriginalList) - (length(OriginalList) div 2));
for i := 0 to Length(left) do
begin
left[i] := OriginalList[i];
end;
for i := 0 to Length(right) do
begin
right[i] := OriginalList[i + Length(OriginalList) div 2];
end;
mergeSort(left);
mergeSort(right);
merge(OriginalList, left, right);
end;
end;
begin
writeln('The data before sorting: ');
for i := low(MyArray) to High(MyArray) do
begin
write(MyArray[i]+' ');
end;
writeln;
mergeSort(MyArray);
writeln('The data before sorting: ');
for i := low(MyArray) to High(MyArray) do
begin
write(MyArray[i]+' ');
end;
readln;
end.
On the line in the mereSort function where I recall the merge sort function on the arrays "left" and "right", I get the error message but I don't quite understand why?
There are many different things wrong with this, hopefully these points will help you in the right direction.
Problems with Array Indexes
You are indexing beyond the end of your arrays:
Dynamic arrays are indexed starting from zero so the line
for i := 0 to Length(left) do
should be
for i := 0 to Length(left) - 1 do
or you can use
for i := Low(left) to High(left) do
As you did later.
I would recommend you choose a standard form and use it consistently, and also that you avoid declaring constant arrays with non-zero based indexing unless you have good reason, this way you can use the same forms consistently or change the type of array later without running into trouble
This first fix will stop your program crashing, but you'll notice your sort code isn't changing anything...
Problems with parameter passing
Delphi has several different ways to pass parameters into procedures:
procedure doSomething(a : array of string);
procedure doSomething(var a : array of string);
procedure doSomething(out a : array of string);
procedure doSomething(const a : array of string);
These determine how what happens inside the procedure can affect the original variable passed
This is something you will need to understand, read up in the documentation:
http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Parameters_(Delphi)
There is IMO some very confusing behaviour and syntax relating to array parameters and a lot of stuff that seems intuitive is not allowed especially with XE/older version, its worth reading the documentation about the standard data types
In the current state, your merge procedure will have no effect because it only operates on a new copy of the array you pass in, which you have also declared as constant
Other
I would avoid the use of result as a procedure parameter since this is the name used for function return values, it seems like asking for trouble to use it like that.
PS: I haven't looked at the logic of the merging, just the basic language mistakes
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).
I'm adding strings with objects (also strings) to a TComboBox, but getting corrupted strings when trying to retrieve them later.
This is how I'm adding them:
var
i: Integer;
sl: TStringList;
c: Integer;
s: PChar;
begin
for i := 1 to tblCalls.FieldCount do
if tblCalls.Fields[i - 1].Tag = 1 then
ListBox1.Items.Append(tblCalls.Fields[i - 1].FieldName);
sl := TStringList.Create;
try
LoadStyles(TStrings(sl));
for c := 0 to sl.Count - 1 do
begin
s := PChar(sl.Values[sl.Names[c]]);
ComboBox1.Items.AddObject(sl.Names[c], TObject(s));
end;
finally
sl.Free;
end;
end;
procedure LoadStyles(var AStylesList: TStrings);
var
f, n: String;
filelist: TStringDynArray;
begin
f := ExtractFilePath(ParamStr(0)) + 'Styles';
if (not DirectoryExists(f)) then
Exit;
filelist := TDirectory.GetFiles(f);
for f in filelist do
begin
n := ChangeFileExt(ExtractFileName(f), EmptyStr);
AStylesList.Add(n + '=' + f);
end;
end;
..and this is where I'm trying to retrieve a string object:
procedure TfrmOptions.ComboBox1Change(Sender: TObject);
var
si: TStyleInfo;
i: Integer;
s: String;
begin
i := TComboBox(Sender).ItemIndex;
s := PChar(TComboBox(Sender).Items.Objects[i]);
Showmessage(s); // --> Mostly shows a corrupted string (gibberish chars)
if (TStyleManager.IsValidStyle(s, si)) then
begin
if (not MatchStr(s, TStyleManager.StyleNames)) then
TStyleManager.LoadFromFile(s);
TStyleManager.TrySetStyle(si.Name);
end;
end;
I suspect that its something with the way I'm adding them. Perhaps I need to allocate memory at:
s := PChar(sl.Values[sl.Names[c]]);
Not sure. Looking at the help on StrNew, NewStr and StrAlloc, it says that those functions are deprecated. Can you help point out whats wrong?
There's nothing to keep the string alive. When you write:
s := PChar(sl.Values[sl.Names[c]]);
an implicit local variable of type string is created to hold whatever sl.Values[sl.Names[c]] evaluates to. That local variable goes out of scope, as far as the compiler is aware, nothing references it, and the string object is destroyed.
In fact, it's even worse than that. Because the assignment above happens in a loop, there is only one implicit local variable. Each time round the loop, the string that you asked the combo box to remember is destroyed.
You need to find a way to extend the lifetime of the string. You could do it like this:
var
StrPtr: ^string;
....
for c := 0 to sl.Count - 1 do
begin
New(StrPtr);
StrPtr^ := sl.Values[sl.Names[c]];
ComboBox1.Items.AddObject(sl.Names[c], TObject(StrPtr));
end;
Then when you need to access the string you can do so like this:
var
StrPtr: ^string;
....
TObject(StrPtr) := TComboBox(Sender).Items.Objects[i];
// do something with StrPtr^
When you clear the combo box you must also run through each item and call Dispose on the pointer.
Having said that, it's going to be much easier not to do it that way. Stop trying to force strings into the TObject data associated with each item. Instead keep a parallel string list containing these strings. When you need to look up a name look it up in that list rather than in the combo box.
I know this is an old question but I came across this problem again and rather than use the separate string list I used an object with a string value (I think someone suggested it in a comment) as follows:
Declare a type as TObject with a string value:
TStringObject = class(TObject)
StringValue : string;
end;
Then when adding your items declare a local var of TStringObject and create a new instance for each item:
var
strObj : TStringObject
begin
...
for c := 0 to sl.Count - 1 do
begin
strObj := TStringObject.Create;
strObj.StringValue := sl.Values[sl.Names[c]];
ComboBox1.Items.AddObject(sl.Names[c], strObj);
end;
And when retrieving the values:
s := TStringObject(TComboBox(Sender).Items.Objects[i]).StringValue;
As #Dejan Dozet mentions in the comments - you should always free the data objects before freeing the TStringList!
How to call GetIDsOfNames for resolve Method ID for few methods? It works fine for resolve only one or first-one MethodID.
My code right now:
pDisp : IDispatch;
intResult : HResult;
NameCount : integer;
DispIDs : array [0..2] of Integer;
WideNames : array of WideString;
I : Integer;
Names, Src : PAnsiChar;
N : array [0..2] of PAnsiChar;
begin
pDisp := CreateOleObject (edtPrgID1.Text);
if VarIsNull (pDisp) or VarIsEmpty (pDisp) then
Exit;
//-=-
NameCount := 3;
Names := 'doF4' + #0 + 'doF5' + #0 + 'doF6' + #0;
//-=-
SetLength (WideNames, NameCount);
Src := Names;
for I := 0 to NameCount - 1 do
begin
if I = 0 then
WideNames [I] := UTF8ToWideString (Src)
else
WideNames [NameCount - I] := UTF8ToWideString (Src);
Inc (Src, StrLen (Src) + 1);
end;
intResult := pDisp.GetIDsOfNames (GUID_NULL, WideNames, NameCount, LOCALE_SYSTEM_DEFAULT, #DispIDs);
I am trying to work with my own ActiveX COM (DLL) component. All method 100% exists and valid.
I am not sure why, but in DispIDs I always get result only for first method (in my sample “doF4”), for all other methods I get -1.
So, DispIDs after execution pDisp.GetIDsOfNames looks like (205, -1, -1).
You have to call GetIDsOfNames() once for each method. The documentation explains why in its description of the output parameter:
The first element represents the member name. The subsequent elements represent each of the member's parameters.
So to get IDs of three members, rather than one member and two of its arguments, you need to call it three times.
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.