This simply code is working fine to check if lines are different, already when i try check if are equals none element is found when have two files with the same string in same line index on both. What is missing here?
PS: SameStr() also was tested and not is working.
function compstr(s1, s2: string): boolean;
var
i: integer;
btemp: boolean;
begin
btemp := true;
if (length(s1) <> length(s2)) then
begin
btemp := false;
end
else
begin
for i := 1 to length(s1) do
begin
if (s1[i] <> s2[i]) then
begin
btemp := false;
exit;
end;
end;
end;
result := btemp;
end;
procedure compfile(filename1, filename2: string);
var
f1: system.textfile;
f2: system.textfile;
diff: system.textfile;
buf1: string;
buf2: string;
l: integer;
begin
assignfile(f1, filename1);
assignfile(f2, filename2);
assignfile(diff, 'C:\Equals.txt');
reset(f1);
reset(f2);
rewrite(diff);
l := 1;
while not eof(f1) do
begin
readln(f1, buf1);
readln(f2, buf2);
if {not} compstr(buf1, buf2) then
begin
writeln(diff, {extractfilename(filename1) + ' : ' +} inttostr(l) + ' - ' + buf1);
// writeln(diff, extractfilename(filename2) + ' : ' + inttostr(l) + ' - ' + buf2);
// writeln(diff, ' ');
end;
inc(l);
end;
closefile(f1);
closefile(f2);
closefile(diff);
end;
Your function compstr(s1, s2: string): boolean; has a couple of issues:
The btemp: boolean variable is unnecessary. You can set result directly as needed.
If the length of the two lines are equal, but the content differs (if (s1[i] <> s2[i])) you call exit which jumps to the end; of the function and result is never assigned the value of btemp. Thus, strings of equal length but different content are returning the value True, that you set at the beginning. Perhaps you were thinking about break which would exit the for loop and land on the result := btemp; line, which then would yield the correct value.
The whole function is a waste, you call it it in compfile() with:
...
if compstr(buf1, buf2) then
....
which can be replaced with direct comparison:
....
if buf1 = buf2 then
....
P.S. Your claim that SameStr() is not working is false. You probably did not use it correctly.
Related
I have a formatted text on a wordpad file(rtf). I'm trying to open it on a richedit on a delphi form. The problem is that the string is in cyrillic(Bulgarian) and it's saved with weird hieroglyphs or whatever those are "Âëåçå ïîòðåáèòåë". Is there a way to transfer/translate the hieroglyphs to the richedit, so they can appear as proper text?
This function I use to check if the file is empty so I can then enter the first rtf tag, or remove the closing tag, so I can add more text in there without breaking the file
function FileIsEmpty(const FileName: String): Boolean;
var
fad: TWin32FileAttributeData;
begin
Result := GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #fad) and
(fad.nFileSizeLow = 0) and (fad.nFileSizeHigh = 0);
end;
This is the code I use to format the text and also give it to the file:
procedure FormatLogAndAddToFile(richEditLog : TRichEdit; richEditTextColor : TRichEdit);
var
i : integer;
s, c, finalText : string;
sString : TStringList;
begin
with frmMain do
begin
sString := TStringList.Create;
sString.LoadFromFile('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
if Pos('{\rtf}', sString.Strings[0]) <> 0 then
begin
sString.Delete(0);
end
else
begin
sString.Delete(sString.Count - 1);
end;
sString.SaveToFile('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
sString.free;
AssignFile(logFile, 'C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
Append(logFile);
if FileIsEmpty('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf') = True then
begin
WriteLn(logFile, '{\rtf\ansi\ansicpg1252\deff0\nouicompat{\fonttbl{\f0\fnil\fcharset0 Calibri;}}');
end;
for i := 0 to richEditLog.Lines.Count do
begin
s := richEditLog.Lines[i];
c := richEditTextColor.Lines[i];
if c = 'blue' then
begin
finalText := '{\colortbl ;\red0\green128\blue255;\red255\green0\blue0;}' +
'\viewkind4\uc1 \pard\sa200\sl276\slmult1\cf1\f0\fs32\lang9 ' + s + '\cf2\par';
end
else if c = 'red' then
begin
finalText := '{\colortbl ;\red255\green0\blue0;}' +
'\viewkind4\uc1 \pard\sa200\sl276\slmult1\cf1\f0\fs32\lang9 ' + s + '\par';
end
else if c = 'green' then
begin
finalText := '{\colortbl ;\red0\green128\blue128;\red255\green0\blue0;}' +
'\viewkind4\uc1 \pard\sa200\sl276\slmult1\cf1\f0\fs32\lang9 ' + s + '\cf2\par';
end;
WriteLn(logFile, finalText);
end;
WriteLn(logFile, '}');
CloseFile(logFile);
end;
end;
This is the code I use to add the log lines to the file. I also have little bit of code that checks if the file has lines with a date that is entered on a TDateEdit, so I can only get log from the date I've entered.
procedure OpenLogInRichEdit(dateFilter : Boolean; searchDate : tDate);
var
sTime : string;
dateExists : Boolean;
I : integer;
begin
with frmMain do
begin
dateExists := false;
frmLogSearch.tLogRichEdit.Clear;
frmLogSearch.tLogRichEdit.Lines.LoadFromFile('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
sTime := DateTimeToStr(searchDate);
if dateFilter then
begin
for I := 0 to frmLogSearch.tLogRichEdit.Lines.Count do
begin
if Pos(sTime, frmLogSearch.tLogRichEdit.Lines[i]) <> 0 then
begin
frmLogSearch.tLogRichEdit.Lines.Delete(i);
dateExists := True;
end;
end;
if dateExists = false then
begin
ShowMessage('No log from this day!');
end;
end;
end;
end;
This is how I add the text to the richedits I use later for the procedure FormatLogAndAddToFile.
dateTimeNow := Now;
logText.Lines.Add('<' + DateTimeToStr(dateTimeNow) + '> Изтрита е поръчка');
logTextColor.Lines.Add('red');
And this is how I eventually call the procedures. First the procedure to get the formatted log to the richedits
OpenLogInRichEdit(tcxCheckBoxDate.Checked, tcxDate.Date);
And this is the procedure to format the text and give it to the file
LogFileUse.FormatLogAndAddToFile(logText, logTextColor);
Thanks to the comments I've managed to make it work. I've changed the code above. Instead of having 'fcharset0' as a tag, I now have 'fcharset1' and I also changed 'lang9' to 'lang1026' and now I save it properly to the file and it opens perfectly!
If all this scary code is here only to add colored lines to the file, than you should use TRichEdit.SelAttributes with friends: Colorful text in the same line in TRichEdit This way TRichEdit will be able to correctly handle encoding. And if you need some fancy file header or footer, that you do not want to create from code, than you can create empty rtf-file with required header/footer, and use it as a template.
I have a TClientDataSet in Delphi 7 and I'd like to apply a filter which I type into a simple TEdit, so it looks like this:
CDS.Filter:=Edit1.Text;
CDS.Filtered:=True;
Now I looked at the Helpfile for filtering records
and according to it I should be able to Filter DateTime-Fields as well.
But whenever I write something like this into my Edit:
DAY(EDATUM)=17
and apply the filter I get a "Type Mismatch in Expression"-Exception.
I have tried numerous different formats of the example above.
DATE(DAY(EDATUM))=DATE(DAY(17)) //Doesn't work
DAY(EDATUM)='17' //Doesn't work
DAY(EDATUM)=DAY(17) //Doesn't work
DAY(EDATUM)=DAY(DATE('17.09.2016'))
...
...
the only one that works is
EDATUM='17.09.2016' //Works
But I want to filter on Days months and years seperately and not have them together in a string.
Nothing I found online elsewhere worked either.
Any Idea what I'm doing wrong?
Edatum is a TimeStamp in a Firebird 1.5 Database.
If you want to use a Filter expression instead of an OnFilterRecord handler, it is worthwhile taking a look at the source of the TExprParser class, which is what TClientDataSet uses for textual filters. It is contained in the DBCommon.Pas unit file in your Delphi source. The D7 TExprParser supports the following functions:
function TExprParser.TokenSymbolIsFunc(const S: string) : Boolean;
begin
Result := (CompareText(S, 'UPPER') = 0) or
(CompareText(S, 'LOWER') = 0) or
[...]
(CompareText(S, 'YEAR') = 0) or
(CompareText(S, 'MONTH') = 0) or
(CompareText(S, 'DAY') = 0) or
[...]
end;
Btw, it is worthwhile looking through the rest of TExprParser's source because it reveals things like support for the IN construct found in SQL.
On my (UK) system, dates display in a DBGrid as dd/mm/yyyy. Given that, all of the filter expressions shown below work in D7 without producing an exception and return the expected results:
procedure TForm1.Button1Click(Sender: TObject);
begin
// ADate field of CDS is initialised by
// CDS1.FieldByName('ADate').AsDateTime := Now - random(365);
edFilter.Text := 'ADate = ''10/2/2017'''; // works, date format = dd/mm/yyyy
edFilter.Text := 'Month(ADate) = 2'; // works
edFilter.Text := 'Year(ADate) = 2017'; // works
edFilter.Text := '(Day(ADate) = 10) and (Year(ADate) = 2017)'; // works
CDS1.Filtered := False;
CDS1.Filter := edFilter.Text;
CDS1.Filtered := True;
end;
If you don't get similar results, I'd suggest you start by looking at your regional settings and how dates are displayed in a TDBGrid.
Filter expressions are not particularly efficient compared to the alternative method of filtering, namely to use the OnFilterRecord event.
In the event handler, you can use e.g. DecodeDateTime to decode it into its Year, Month, Day, etc components and apply whatever tests you like to their values. Then set Accept to True or False.
Update I gather from your comment to an answer here
Delphi: check if Record of DataSet is visible or filtered
that the problem you had with this was that the date functions supported by
TExprParser.TokenSymbolIsFunc() are not in your user's language.
You can use the code below to translate the date function names in the filter expression.
See the embedded comments for explanation of how it works
type
TForm1 = class(TForm)
[...]
public
NameLookUp : TStringList;
[...]
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
NameLookUp := TStringList.Create;
// Assume Y, M & C are the local-language names
NameLookUp.Add('Y=Year');
NameLookUp.Add('M=Month');
NameLookUp.Add('D=Day');
[...]
end;
procedure TForm1.Log(const Title, Msg : String);
begin
Memo1.Lines.Add(Title + ' : ' + Msg);
end;
function TForm1.TranslateExpression(const Input : String; ADataSet : TDataSet) : String;
var
SS : TStringStream;
TokenText : String;
LookUpText : String;
Parser : TParser;
CH : Char;
begin
SS := TStringStream.Create(Input);
Parser := TParser.Create(SS);
Result := '';
try
CH := Parser.Token;
// following translates Input by parsing it using TParser from Classes.Pas
while Parser.Token <> #0 do begin
TokenText := Parser.TokenString;
case CH of
toSymbol : begin
// The following will translate TokenText for symbols
// but only if TokenText is not a FieldName of ADataSet
if ADataSet.FindField(TokenText) = Nil then begin
LookUpText := NameLookUp.Values[TokenText];
if LookUpText <> '' then
Result := Result + LookUpText
else
Result := Result + TokenText;
end
else
Result := Result + TokenText;
end;
toString :
// SingleQuotes surrounding TokenText in Input and ones embedded in it
// will have been stripped, so reinstate the surrounding ones and
// double-up the embedded ones
Result := Result + '''' + StringReplace(TokenText, '''', '''''', [rfReplaceAll]) + '''';
else
Result := Result + TokenText;
end; { case }
if Result <> '' then
Result := Result + ' ';
CH := Parser.NextToken;
end;
finally
Parser.Free;
SS.Free;
end;
Log('TransResult', Result);
end;
procedure TForm1.btnSetFilterExprClick(Sender: TObject);
begin
// Following tested with e.g edFilter.Text =
// LastName = 'aaa' and Y(BirthDate) = 2000
UpdateFilter2;
end;
procedure TForm1.UpdateFilter2;
var
T1 : Integer;
begin
CDS1.OnFilterRecord := Nil;
T1 := GetTickCount;
CDS1.DisableControls;
try
CDS1.Filtered := False;
CDS1.Filter := TranslateExpression(edFilter.Text, CDS1);
if CDS1.Filter <> '' then begin
CDS1.Filtered := True;
end;
Log('Filter update time', IntToStr(GetTickCount - T1) + 'ms');
finally
CDS1.EnableControls;
end;
end;
I have a DB grid which is sorted (the user clicked a few radio buttons and checkboxes to influence the display).
I would like to export all of the data (not just what is visible in the grid), sorted identically, to CSV - how do I do so? The data - not the user settings, just to clarify.
Thanks in advance for any help
[Update] I build sqlQuery bit by bit, depending on the user's settings of checkboxes & radio groups, then, when one of them changes, I
ActivityADQuery.SQL.Clear();
ActivityADQuery.SQL.Add(sqlQuery);
ActivityADQuery.Open(sqlQuery);
That is to say that there isn't a hard coded query, it varies and I want to export the current settings.
I don't know enough if I want to export from the grid or the dataset (I am just not a db guy, this is my first DBgrid), but I suspect that I want the grid, because it has a subset of fields of he dataset.
I guess that TJvDBGridCSVExport is a Jedi component(?) I have tried to avoid them so far, great as they sound, because I prefer discreet, stand-alone, components to installing a huge collection. That may not be the cleverest thing to do, but it's how I feel - ymmv (and prolly does)
Another solution, works also with (multi)selected rows:
procedure TReportsForm.ExportToCSV(const aGrid : TDBGrid; const FileName : String);
Var
I, J : Integer;
SavePlace : TBookmark;
Table : TStrings;
HeadTable : String;
LineTable : String;
First : Boolean;
Begin
HeadTable := '';
LineTable := '';
Table := TStringList.Create;
First := True;
Try
For I := 0 To Pred(aGrid.Columns.Count) Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
// Use the text from the grid, in case it has been set programatically
// E.g., we prefer to show "Date/time" than "from_unixtime(activity.time_stamp, "%D %b %Y %l:%i:%S")"
// HeadTable := HeadTable + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ','; // Previous separated wth semi-colon, not comma! (global)
First := False;
End
Else
begin
// HeadTable := HeadTable + ';' + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ',';
end;
Delete(HeadTable, Length(HeadTable), 1); // Remove the superfluous trailing comma
Table.Add(HeadTable);
First := True;
// with selection of rows
If aGrid.SelectedRows.Count > 0 Then
Begin
For i := 0 To aGrid.SelectedRows.Count - 1 Do
Begin
aGrid.DataSource.Dataset.GotoBookmark(pointer(aGrid.SelectedRows.Items[i]));
For j := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[J].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[J].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[J].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
First := True;
End;
End
Else
//no selection
Begin
SavePlace := aGrid.DataSource.Dataset.GetBookmark;
aGrid.DataSource.Dataset.First;
Try
While Not aGrid.DataSource.Dataset.Eof Do
Begin
For I := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[I].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[I].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
aGrid.DataSource.Dataset.Next;
First := True;
End;
aGrid.DataSource.Dataset.GotoBookmark(SavePlace);
Finally
aGrid.DataSource.Dataset.FreeBookmark(SavePlace);
End;
End;
Table.SaveToFile(FileName);
Finally
Table.Free;
End;
End; // ExportToCSV()
You could use a own tiny procedure wich could be adapted to your needs
Procedure Dataset2SeparatedFile(ads: TDataset; const fn: String; const Separator: String = ';');
var
sl: TStringList;
s: String;
i: Integer;
bm: TBookmark;
Procedure ClipIt;
begin
s := Copy(s, 1, Length(s) - Length(Separator));
sl.Add(s);
s := '';
end;
Function FixIt(const s: String): String;
begin
// maybe changed
Result := StringReplace(StringReplace(StringReplace(s, Separator, '', [rfReplaceAll]), #13, '', [rfReplaceAll]), #10, '', [rfReplaceAll]);
// additional changes could be Quoting Strings
end;
begin
sl := TStringList.Create;
try
s := '';
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayLabel) + Separator;
end;
ClipIt;
bm := ads.GetBookmark;
ads.DisableControls;
try
ads.First;
while not ads.Eof do
begin
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayText) + Separator;
end;
ClipIt;
ads.Next;
end;
ads.GotoBookmark(bm);
finally
ads.EnableControls;
ads.FreeBookmark(bm);
end;
sl.SaveToFile(fn);
finally
sl.Free;
end;
end;
I am trying to find all files that have the extenstion .cbr or .cbz
If i set my mask to *.cb?
it finds *.cbproj files. How can i set the mask to only find .cbr and .cbz files?
here is code i am using.
I have two edit boxes EDIT1 is the location to search, EDIT2 is where i put my mask. A listbox to show what it found and a Search button.
edit1 := c:\
edit2 := mask (*.cb?)
space
procedure TFAutoSearch.FileSearch(const PathName, FileName : string; const InDir : boolean);
var Rec : TSearchRec;
Path : string;
begin
Path := IncludeTrailingBackslash(PathName);
if FindFirst(Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
try
repeat
ListBox1.Items.Add(Path + Rec.Name);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
If not InDir then Exit;
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
FileSearch(Path + Rec.Name, FileName, True);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end; //procedure FileSearch
procedure TFAutoSearch.Button1Click(Sender: TObject);
begin
FileSearch(Edit1.Text, Edit2.Text, CheckBox1.State in [cbChecked]);
end;
end.
The easiest way is to use ExtractFileExt against the current filename and check to see if it matches either of your desired extensions.
Here's a fully-rewritten version of your FileSearch routine which does exactly what you're trying to do (according to your question, anyway):
procedure TFAutoSearch.FileSearch(const ARoot: String);
var
LExt, LRoot: String;
LRec: TSearchRec;
begin
LRoot := IncludeTrailingPathDelimiter(ARoot);
if FindFirst(LRoot + '*.*', faAnyFile, LRec) = 0 then
begin
try
repeat
if (LRec.Attr and faDirectory <> 0) and (LRec.Name <> '.') and (LRec.Name <> '..') then
FileSearch(LRoot + LRec.Name)
else
begin
LExt := UpperCase(ExtractFileExt(LRoot + LRec.Name));
if (LExt = '.CBR') or (LExt = '.CBZ') then
ListBox1.Items.Add(LRoot + LRec.Name);
end;
until (FindNext(LRec) <> 0);
finally
FindClose(LRec);
end;
end;
end;
While the other answer suggesting the use of multiple extensions as a mask *.cbr;*.cbz should (in principal anyway) work, I've noted through bitter experience that the FindFirst and FindNext methods in Delphi tend not to accept multiple extensions in a mask!
The code I've provided should work just fine for your needs, so enjoy!
UPDATED: To allow the use of multiple extensions in a Mask dynamically at runtime (as indicated by the OP's first comment to this answer).
What we're going to do is take a String from your TEdit control (this String is one or more File Extensions as you would expect), "Explode" the String into an Array, and match each file against each Extension in the Array.
Sounds more complicated than it is:
type
TStringArray = Array of String; // String Dynamic Array type...
// Now let's provide a "Mask Container" inside the containing class...
TFAutoSearch = class(TForm)
// Normal stuff in here
private
FMask: TStringArray; // Our "Mask Container"
end;
This code will populate FMask with each individual mask extension separated by a ; such as .CBR;.CBZ.
Note this method will not accept Wildcard characters or any other Regex magic, but you can modify it as you require!
procedure TFAutoSearch.ExplodeMask(const AValue: String);
var
LTempVal: String;
I, LPos: Integer;
begin
LTempVal := AValue;
I := 0;
while Length(LTempVal) > 0 do
begin
Inc(I);
SetLength(FMask, I);
LPos := Pos(';', LTempVal);
if (LPos > 0) then
begin
FMask[I - 1] := UpperCase(Copy(LTempVal, 0, LPos - 1));
LTempVal := Copy(LTempVal, LPos + 1, Length(LTempVal));
end
else
begin
FMask[I - 1] := UpperCase(LTempVal);
LTempVal := EmptyStr;
end;
end;
end;
We now need a function to determine if the nominated file matches any of the defined Extensions:
function TFAutoSearch.MatchMask(const AFileName: String): Boolean;
var
I: Integer;
LExt: String;
begin
Result := False;
LExt := UpperCase(ExtractFileExt(LExt));
for I := Low(FMask) to High(FMask) do
if (LExt = FMask[I]) then
begin
Result := True;
Break;
end;
end;
Now here's the modified FileSearch procedure:
procedure TFAutoSearch.FileSearch(const ARoot: String);
var
LRoot: String;
LRec: TSearchRec;
begin
LRoot := IncludeTrailingPathDelimiter(ARoot);
if FindFirst(LRoot + '*.*', faAnyFile, LRec) = 0 then
begin
try
repeat
if (LRec.Attr and faDirectory <> 0) and (LRec.Name <> '.') and (LRec.Name <> '..') then
FileSearch(LRoot + LRec.Name)
else
begin
if (MatchMask(LRoot + LRec.Name)) then
ListBox1.Items.Add(LRoot + LRec.Name);
end;
until (FindNext(LRec) <> 0);
finally
FindClose(LRec);
end;
end;
end;
Finally, here's how you initiate your search:
procedure TFAutoSearch.btnSearchClick(Sender: TObject);
begin
ExplodeMask(edMask.Text);
FileSearch(edPath.Text);
end;
Where edMask is defined in your question as Edit2 and edPath is defined in your question as Edit1. Just remember that this method doesn't support the use of Wildcard or other Special Chars, so edMask.Text should be something like .CBR;.CBZ
If you use the Regex library for Delphi, you could easily modify this method to support all of the Expression Cases you could ever imagine!
Dorin's suggestion to replace your mask with *.cbr;*.cbz should work. That is, it won't match cbproj anymore. It would, however, still match cbzy or any other extension that starts with cbr or cbz. The reason for this is that FindFirst/FindNext match both the long form and the legacy short forms (8.3) of file names. So the short forms will always have truncated extensions where cbproj is shortened to cbp, and therefore matches cb?.
This is supposed to be avoidable by using FindFirstEx instead, but this requires a small rewrite of your search function and actually didn't work for me. So instead I just double checked all matches with the MatchesMask function.
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.