How can find the first two word in string [duplicate] - delphi

This question already has answers here:
Split a string into an array of strings based on a delimiter
(20 answers)
Closed 7 years ago.
Hy! What is the best way to find the first two Word in a string? For example, my string is an adress like : Cross Keys st 13. I need only 'Cross Keys' from it. Should I count the words in the string or there a better solution for that?
I can get the first and the last Word easily. I am new in Delphi. Thanks for the suggestions.
procedure SampleForm.ButtonClick(Sender: TObject);
var
st: string;
myString : string;
C: integer;
begin
st := Cross Keys st 13;
C:=LastDelimiter(' ',st);
myString := Copy(st,1,pos(' ',st)-1);
mystring:=Copy(st,C+1,length(st)-C);

The scope was delphi XE so string.split doesn't work. Instead you can use IStringTokenizer from HTTPUtil. Like this:
uses
HTTPUtil;
function GetFirstNWrods(const str: string; const delim: string; Numwords: Integer): string;
var
Tokenizer: IStringTokenizer;
begin
Result := '';
Tokenizer := StringTokenizer(str, delim);
while (Tokenizer.hasMoreTokens) and (Numwords > 0) do
begin
Result := Result + Tokenizer.nextToken + delim;
Dec(Numwords)
end;
System.Delete(Result, Length(Result) - Length(delim) + 1, Length(delim));
end;
Example of how to call the function:
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := GetFirstNWrods('1 2 3 4', ' ', 2);
end;

procedure TForm9.Button1Click(Sender: TObject);
begin
ShowMessage(someWord('first second and ...',1)); // show: first
ShowMessage(someWord('first second and ...',2)); //show: second
end;
function TForm9.someWord(sir: string; oneWord: integer): string;
var
myArray: TArray<string>;
begin
myArray := sir.Split([' ']); //myArray it's an Tstring of Words from sir
case oneWord of
1:
result := myArray[low(myArray)]; // result is first elemnt of myArray; low(myArray)=0
2:
begin
if high(myArray) > 0 then // high(myArray) index of last element of myArray
result := myArray[low(myArray) + 1] // result is second element of myArray
else
result := '';
end;
end;
end;

Related

Delphi (2006): how to Split by new line and break at the same time

I have this simple operation in Java, where the string is split by new line and break.
String i= "Holidays
Great.
Bye";
String []linesArray = i.split("\\r?\\n");
I would like to obtain the same result in Delphi 2006.
Is it valid to use the following steps?
charArray[0] := '\\r';
charArray[1] := '\\n';
strArray := strA.Split(charArray);
I interpret your request like this: "Split a string at both CR and LF." which implies that CR+LF gives an empty string element. For instance, 'alpha'#13'beta'#10'gamma'#13#10'delta' yields the five elements 'alpha', 'beta', 'gamma', '', and 'delta'.
If so, and if you are using a non-ancient version of Delphi, this is really simple:
var S := 'alpha'#13'beta'#10'gamma'#13#10'delta';
var Parts := S.Split([#13, #10]);
for var Part in Parts do
ShowMessage(Part);
For old Delphi versions
The code above requires TStringHelper (crucially) and also makes use of inline variable declarations, for in loops, and generics.
For old Delphi versions, you can do it manually:
type
TStringArray = array of string;
function Split(const S: string): TStringArray;
var
Count: Integer;
const
Delta = 512;
procedure Add(const Part: string);
begin
if Length(Result) = Count then
SetLength(Result, Length(Result) + Delta);
Result[Count] := Part;
Inc(Count);
end;
var
p, i: Integer;
begin
Result := nil;
Count := 0;
p := 0; // previous delim
for i := 1 to Length(S) do
if S[i] in [#13, #10] then
begin
Add(Copy(S, Succ(p), i - p - 1));
p := i;
end;
Add(Copy(S, Succ(p)));
SetLength(Result, Count);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
S: string;
Parts: TStringArray;
i: Integer;
begin
S := 'alpha'#13'beta'#10'gamma'#13#10'delta';
Parts := Split(S);
for i := 0 to High(Parts) do
ShowMessage(Parts[i]);
end;

How to count number of occurrences of a certain char in string?

How can I count the number of occurrences of a certain character in a string in Delphi?
For instance, assume that I have the following string and would like to count the number of commas in it:
S := '1,2,3';
Then I would like to obtain 2 as the result.
You can use this simple function:
function OccurrencesOfChar(const S: string; const C: char): integer;
var
i: Integer;
begin
result := 0;
for i := 1 to Length(S) do
if S[i] = C then
inc(result);
end;
Even though an answer has already been accepted, I'm posting the more general function below because I find it so elegant. This solution is for counting the occurrences of a string rather than a character.
{ Returns a count of the number of occurences of SubText in Text }
function CountOccurences( const SubText: string;
const Text: string): Integer;
begin
Result := Pos(SubText, Text);
if Result > 0 then
Result := (Length(Text) - Length(StringReplace(Text, SubText, '', [rfReplaceAll]))) div Length(subtext);
end; { CountOccurences }
And for those who prefer the enumerator loop in modern Delphi versions (not any better than the accepted solution by Andreas, just an alternative solution):
function OccurrencesOfChar(const ContentString: string;
const CharToCount: char): integer;
var
C: Char;
begin
result := 0;
for C in ContentString do
if C = CharToCount then
Inc(result);
end;
This one can do the work for if you're not handling large text
...
uses RegularExpressions;
...
function CountChar(const s: string; const c: char): integer;
begin
Result:= TRegEx.Matches(s, c).Count
end;
You can use the benefit of StringReplace function as:
function OccurencesOfChar(ContentString:string; CharToCount:char):integer;
begin
Result:= Length(ContentString)-Length(StringReplace(ContentString, CharToCount,'', [rfReplaceAll, rfIgnoreCase]));
end;
Simple solution and good performance (I wrote for Delphi 7, but should work for other versions as well):
function CountOccurences(const ASubString: string; const AString: string): Integer;
var
iOffset: Integer;
iSubStrLen: Integer;
begin
Result := 0;
if (ASubString = '') or (AString = '') then
Exit;
iOffset := 1;
iSubStrLen := Length(ASubString);
while (True) do
begin
iOffset := PosEx(ASubString, AString, iOffset);
if (iOffset = 0) then
Break;
Inc(Result);
Inc(iOffset, iSubStrLen);
end;
end;
Ummm... Am I missing something? Why not just...
kSepChar:=',';//to count commas
bLen:=length(sLineToCheck);
bCount:=0;//The numer of kSepChars seen so far.
bPosn:=1;//First character in string is at position 1
for bPosn:=1 to bLen do begin
if sLineToCheck[bPosn]=kSepChar then inc(bCount);
end;//

How do I read a row from a file that has both numbers and letters in Delphi 2010?

I have a text file that has, on any given row, data that are expressed both in text format and in numeric format. Something like this:
Dog 5 4 7
How do I write a file reading routine in Delphi that reads this row and assigns the read values into the correct variables ("Dog" into a string variable and "5", "4" and "7" into real or integer variables)?
You can use SplitString from StrUtils to split the string into pieces. And then use StrToInt to convert to integer.
uses
StrUtils;
....
var
Fields: TStringDynArray;
....
Fields := SplitString(Row, ' ');
StrVar := Fields[0];
IntVar1 := StrToInt(Fields[1]);
IntVar2 := StrToInt(Fields[2]);
IntVar3 := StrToInt(Fields[3]);
And obviously substitute StrToFloat if you have floating point values.
Take TJclStringList from Jedi Code Library.
On 1st step you take one list and do .LoadFromFile to split the file to rows.
On second step you iterated through those rows and set secondary stringlist by those lines with space as delimiter. Then you iterate through secondary string list and do what u want.
http://wiki.delphi-jedi.org/wiki/JCL_Help:IJclStringList.Split#string#string#Boolean
Split a string into an array of strings based on a delimiter
https://stackoverflow.com/search?q=%5Bdelphi%5D+string+split
Like that
var slF, slR: IJclStringList; ai: TList<integer>; s: string; i: integer;
action: procedure(const Name: string; Const Data: array of integer);
slF := TJclStringList.Create; slF.LoadFromFile('some.txt');
slR := TJclStringList.Create;
for s in slF do begin
slR.Split(s, ' ', true);
ai := TList<Integer>.Create;
try
for i := 1 to slR.Count - 1 do
ai.Add(StrToInt(slR[i]));
action(slR[0], ai.ToArray);
finally ai.Free; end;
end;
You can use File of TRecord, with TRecord. For example:
type TRecord = packed record
FName : String[30];
Val1: Integer;
Val2: Integer;
Val3: Integer;
end;
And simple procedure:
procedure TMainForm.Button1Click(Sender: TObject);
var
F: file of TRecord;
Rec : TRecord;
begin
AssignFile(F, 'file.dat');
try
Reset(F);
Read(F, Rec);
finally
CloseFile(F);
end;
end;

DELPHI STRING: Pull a last name from a full name

I am trying to manipulate a string and pull only certain data from it. I need to do this on a record pulled from a database that gives me the full name of a person. I need to pull only the last name from the string and store it as a variable. Is there a way that I can do this?
Example: SQL query pulls the full field "Mary Ellen Jones" I need to extract only the Jones from the string so I can store it in a variable for further processing.
I thought maybe AnsiRightStr would work but the problem is needing to give it a set integer to pull from the right. Maybe a way to count the characters after the final space allowing me to use AnsiRightStr(string,int) for this? Any help at all is appreciated.
Additional thought: Would replacing the spaces with a delimiter say :: and then parsing that data into a Stringlist followed by allowing me to pull the last index of the string list be possible?
Several valid options have been presented so far. None of them address the situation if say the name is Something like "John St. James, Jr." Is this impossible?
you can use the LastDelimiter function to get the last space position and then with the copy function extract the substring.
uses
SysUtils;
var
Name : string;
p : Integer;
ShortName : string;
begin
Name:='Mary Ellen Jones';
//You can call trim to avoid problems with ending spaces in this case is not necesary, just is a test
//Name:=Trim(Name);
//get the last space position
p:=LastDelimiter(' ',Name);
//get the name
ShortName:=Copy(Name,p+1,length(Name)-p);
end;
or using a function
function GetLast(const Name:string) : string;
var
p : Integer;
begin
Result:=Trim(Name);
p:=LastDelimiter(' ',Result);
Result:=Copy(Result,p+1,length(Result)-p);
end;
function GetLastWord(const Str: string): string;
var
p: integer;
i: Integer;
const
SPACE = #$20;
begin
p := 1;
for i := length(Str) downto 1 do
if Str[i] = SPACE then
begin
p := i + 1;
break;
end;
result := Copy(Str, p, MaxInt);
end;
This will fail if the string ends with (an accidental) space, as 'Andreas Rejbrand '. This more robust version will handle this case too:
function GetLastWord(const Str: string): string;
var
p: integer;
i: Integer;
FoundNonSpace: boolean;
const
SPACE = #$20;
begin
p := 1;
FoundNonSpace := false;
for i := length(Str) downto 1 do
if (Str[i] = SPACE) and FoundNonSpace then
begin
p := i + 1;
break
end
else if Str[i] <> SPACE then
FoundNonSpace := true;
result := TrimRight(Copy(Str, p, MaxInt));
end;
What if the last name is say "St. James" any way to account for that?
Here's my approach.
Make a list of lastname-markers
Search that list in order of preference
As soon as a match is found, mark that as the start of last name
Return substring starting from that pos.
var
LastNameMarkers: TStringList = nil;
SuffixFix: TStringList = nil;
procedure InitLists;
begin
LastNameMarkers:= TStringList.Create;
//LastNameMarkers.LoadFromFile('c:\markers.txt');
LastNameMarkers.Add(' St.');
LastnameMarkers.Add(' Mc');
LastNameMarkers.Add(' '); //Marker of last resort.
SuffixFix:= TStringList.Create;
SuffixFix.Add(' Jr.');
SuffixFix.Add(' Sr.');
end;
function GetLastName(FullName: string): string;
var
i: integer;
start: integer;
found: boolean;
ReplaceWith: string;
begin
if LastNameMarkers = nil then InitLists;
//Fix suffixes
i:= 0;
found:= false;
while (i < SuffixFix.Count) and not found do begin
start:= pos(lower(LastNameMarkers[i]),lower(Fullname));
found:= Start > 0;
Inc(i);
end; {while}
if Found then begin
Dec(i);
ReplaceWith:= StringReplace(Suffix[i], ' ', '_',[]);
FullName:= StringReplace(FullName, SuffixFix[i], ReplaceWith,[]);
end; {if}
//Look for lastnames
i:= 0;
found:= false;
while (i < LastNameMarkers.Count) and not found do begin
start:= pos(LastNameMarkers[i],Fullname);
found:= Start > 0;
Inc(i);
end; {while}
if found then Result:= RightStr(FullName, Length(FullName)- Start + 2)
else Result:= '';
StringReplace(Result, '_', ' ',[]);
end;
I haven't dealt with upper and lowercase properly, but I hope you get the idea.
function TfrmCal.GetLastName(FullName: string): string;
var
i: integer;
found: boolean;
suffix: string;
marker: string;
begin
// Build the lists for the compare.
InitLists;
// Look at Suffixes and attach them to the LastName
i := 0;
found := False;
while (i < SuffixFix.Count) do
begin
if AnsiContainsStr(FullName, SuffixFix[i]) then
begin
suffix := '::' + trim(SuffixFix[i]);
FullName := ReplaceStr(FullName, SuffixFix[i], suffix);
found := True;
end;
inc(i);
if found then
break;
end;
// Look for LastName Markers
i := 0;
found := False;
while (i < LastNameMarkers.Count) do
begin
if AnsiContainsStr(FullName, LastNameMarkers[i]) then
begin
marker := trimright(LastNameMarkers[i]) + '::';
FullName := ReplaceStr(FullName, LastNameMarkers[i], marker);
found := True;
end;
inc(i);
if found then
break;
end;
FullName := GetLastWord(FullName);
FullName := ReplaceStr(FullName, '::', ' ');
LastNameMarkers.Clear;
SuffixFix.Clear;
Result := FullName;
end;
function TfrmCal.GetLastWord(const Str: string): string;
var
p: integer;
i: integer;
const
SPACE = #$20;
begin
p := 1;
for i := Length(Str) downto 1 do
if Str[i] = SPACE then
begin
p := i + 1;
break;
end;
Result := Copy(Str, p, MaxInt);
end;
These two functions together pull off what I needed to do. There is also the initlists function which is clunky and ugly and I need to work on so I didn't post it here.

delphi scope of variables question

i fill a tdictionary , read from a file, to iterate over the key-value-pairs. iterating was solved in delphi dictionary iterating.
the problem is that the values in the dict are not kept, probably a scope-problem with variables. i am more used to java... the values do exist directly after assigning them to the dictionary in the procedure parsetextfile, then get lost:
program parsefile;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, StrUtils, Dialogs, Generics.collections;
var key : string;
dict: TDictionary<String, TStringlist>;
KeysList, Valuename: TStringList;
KeyName: string;
i: integer;
function DeleteSpaces(str: string): string;
var
i: Integer;
begin
i:=0;
while i<=Length(str) do
if str[i]=' ' then Delete(str, i, 1)
else Inc(i);
Result:=str;
end;
procedure HandleOneKey(KeyIndex:Integer; PrevKeys:string);
var L:TStringList;
i:Integer;
Part: string;
KeyName: string;
begin
KeyName := KeysList[KeyIndex];
L := dict[KeyName];
for i:=0 to L.Count-1 do
begin
writeln(L[i]);
Part := KeyName + '=' + L[i];
if KeyIndex = (KeysList.Count-1) then
WriteLn(PrevKeys + ' ' + Part)
else
HandleOneKey(KeyIndex+1, PrevKeys + ' ' + Part);
end;
end;
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure parsetestfile;
var testfile: Textfile;
text: string;
splitarray: TStringList;
subsplit1, subsplit2: TStringList;
begin
splitarray := TStringList.Create;
subsplit1:= TStringList.Create;
subsplit2:= TStringList.Create;
AssignFile(testfile, 'g:\testfile.txt') ;
Reset(testfile);
while not Eof(testfile) do
begin
ReadLn(testfile, text);
if AnsiContainsStr(text, '=') then
begin
Split('=', text, splitarray);
splitarray[0] := trim(splitarray[0]);
splitarray[1] := DeleteSpaces(splitarray[1]);
if AnsiStartsStr('data', splitarray[0]) then
begin
split(' ', splitarray[0], subsplit1);
splitarray[0]:=subsplit1[1];
split(',', splitarray[1], subsplit2);
dict.Add(splitarray[0], subsplit2);
for ValueName in dict.Values do
begin
for i := 0 to Valuename.Count - 1 do
write('Values are : '+ Valuename[i]);
writeln;
end;//for
end;//end-data-check
end;//end-=-check
end;//while
CloseFile(testfile);
splitarray.Free;
subsplit1.Free;
subsplit2.Free;
end;
begin
dict := TDictionary<String, TStringlist>.Create;
parsetestfile;
KeysList := TStringList.Create;
for KeyName in dict.Keys do
KeysList.Add(KeyName);
for i := 0 to Keyslist.Count - 1 do
begin
writeln('Keylist Items: ' + Keyslist[i]);
end;
if KeysList.Count > 0 then
begin
HandleOneKey(0, '');
end;
dict.Destroy;
Keyslist.Free;
WriteLn('Press ENTER to make the window go away');
ReadLn;
end.
Top Edit
I now saw you're more used to Java, that kind of explains your problem. Java uses an Garbage Collector: if you've got a reference to something, that one thing is valid. Delphi doesn't use a GC, you're responsible for freeing all the memory you allocate. This leads to the second problem: you can free memory you're holding a reference to, there's nothing stopping you from doing that. In your parsetestfile procedure you're adding subsplit2 to the dictionary, so you're keeping a copy of that reference. Later in the same procedure you're freeing subsplit2, so your dictionary now holds a reference to what Delphi considers to be "free memory"!
With Delphi you need to be very careful and deliberate with life cycle management. In this case you obviously can't free the subsplit2 in the parsetestfile procedure itself, but you do need to free it later. You'll need to free it when you free the Dict, look at my initial code for how to do that.
*Recom
Here's your code with lots of things fixed. Please read the comments, I inserted comments wherever I changed something.
It compiles and values survive the parse procedure, but I'm not sure what you want to achieve and you forgot to provide a sample text file: I had to "make one up".
program Project23;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, StrUtils, Dialogs, Generics.collections;
var deviceid, key, topmodule : string;
dict: TDictionary<String, TStringlist>;
KeysList: TStringList;
KeyName: string;
i: integer;
function DeleteSpaces(str: string): string;
var
i: Integer;
begin
i:=0;
while i<=Length(str) do
if str[i]=' ' then Delete(str, i, 1)
else Inc(i);
Result:=str;
end;
procedure HandleOneKey(KeyIndex:Integer; PrevKeys:string);
var L:TStringList;
i:Integer;
Part: string;
KeyName: string;
begin
KeyName := KeysList[KeyIndex];
L := dict[KeyName];
for i:=0 to L.Count-1 do
begin
writeln(L[i]);
Part := KeyName + '=' + L[i];
if KeyIndex = (KeysList.Count-1) then
WriteLn(PrevKeys + ' ' + Part)
else
HandleOneKey(KeyIndex+1, PrevKeys + ' ' + Part);
end;
end;
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure parsetestfile;
var testfile: Textfile;
text: string;
splitarray: TStringList;
subsplit1, subsplit2: TStringList;
ValueName:TStringList; // Never Ever ignore compiler warnings!
i: Integer; // Never Ever ignore compiler warnings!
begin
splitarray := TStringList.Create;
subsplit1:= TStringList.Create;
AssignFile(testfile, 'c:\temp\testfile.txt') ;
Reset(testfile);
while not Eof(testfile) do
begin
ReadLn(testfile, text);
if AnsiContainsStr(text, '=') then
begin
Split('=', text, splitarray);
splitarray[0] := trim(splitarray[0]);
splitarray[1] := DeleteSpaces(splitarray[1]);
if AnsiStartsStr('data', splitarray[0]) then
begin
subsplit2:= TStringList.Create; // Moved the creation of subsplit2 over here, because you need one fresh list for every line of text you read.
split(' ', splitarray[0], subsplit1); // can't split on SPACE because the previous split allready broke the text at "=" and at SPACE. That's how DelimitedText works!
// splitarray[0]:=subsplit1[1]; // splitarray[0] already contains the stuff before "="; And you should check the nubmer of lines in subsplit1!
split(',', splitarray[1], subsplit2);
dict.Add(splitarray[0], subsplit2);
for ValueName in dict.Values do
begin
for i := 0 to Valuename.Count - 1 do
writeLN('Values are : '+ Valuename[i]); // Only use Write when you intend to write the line terminator later
writeln;
end;//for
end;//end-data-check
end;//end-=-check
end;//while
CloseFile(testfile);
splitarray.Free;
subsplit1.Free;
// subsplit2.Free; // Ooops! You're freeing Subsplit2, after you added it as a value in the dict.
end;
begin
dict := TDictionary<String, TStringlist>.Create;
parsetestfile;
KeysList := TStringList.Create;
for KeyName in dict.Keys do
KeysList.Add(KeyName);
for i := 0 to Keyslist.Count - 1 do
begin
writeln('Keylist Items: ' + Keyslist[i]);
end;
if KeysList.Count > 0 then
begin
HandleOneKey(0, '');
end;
dict.Free; // dict.Destroy; // never call "Destroy" directly, call .Free.
Keyslist.Free;
WriteLn('Press ENTER to make the window go away');
ReadLn;
end.

Resources