DELPHI字符串：从全名中提取姓氏

Question

我试图操作一个字符串，并从中提取特定的数据。我需要在从数据库中检索的记录上执行此操作，该记录给出了一个人的全名。我需要仅从字符串中提取姓氏并将其存储为变量。我能否做到这一点？

例如：SQL查询提取完整字段“Mary Ellen Jones”，我需要从字符串中提取Jones，以便将其存储在变量中以进行进一步处理。

我认为AnsiRightStr可能有效，但问题是需要给出一个整数来从右边提取。也许可以计算最后一个空格后面的字符数，使我能够使用AnsiRightStr(string,int)进行操作？非常感谢任何帮助。

另一个想法是：将空格替换为分隔符::，然后将该数据解析为Stringlist，接着允许我提取字符串列表的最后一个索引。这样可能行吗？

到目前为止，已经提出了几种有效的选项。但如果姓名类似于“John St. James, Jr.”，则这些方法都无法解决。这是否不可能？

- James West

---

当您使用字符串列表时，也可以按空格拆分字符串。但是无法确定姓氏是否仅由最后一个单词组成。如果要正确解决此问题，请将名字和姓氏保存在数据库的不同字段中。这样还可以提供更好的排序和搜索功能。 - GolezTrol

只要你的名字相对来说比较符合英语中心化，采用“名 中间名 姓”这种模式进行分割就可以了。那么对于有四个单词的人呢？是两个“中间名”还是两个“姓”，或者是没有连字符的双姓？在所有情况下，处理和解析名字都是很困难的。 - afrazier

@afraizer：随着这个问题和答案的发展，我看到了这一点。 - James West

@Golez：我所在的公司编写破产软件，过去只需要在几个地方注明共同债务人的信息。公司选择将共同债务人的全名列入单个记录，而将债务人拆分为多个记录。现在法院要求更加安全的数据，我们需要删除共同债务人的名字和中间名。但是现在更改这种情况并不可行，因为我们需要完成的任务不允许更改。 - James West

如果你深入探究这个问题，你会发现唯一真正的解决方案是修复你的数据库和数据输入方法，使用单独的字段进行存储，即使字段的内容可能不会立即显现（例如，使用“全名”和“称谓”字段来存储“Mary Ellen Jones”和“Jones女士”，而不是使用“名/中间名/姓”字段）。你可能可以特别处理足够多的后缀和姓氏连接符以适用于当前数据集，或者使迁移到新架构变得更加容易。 - afrazier

当然，在非经过消毒的输入数据的一般情况下是不可能的。 - Premature Optimization

Answer 1

您可以使用LastDelimiter函数获取最后一个空格位置，然后再使用Copy函数提取子字符串。

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;

或者使用一个函数。

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;

- RRUZ

---

你的方法似乎也是我需要做的事情非常有效的方法。有没有办法处理Andreas回答中提到的情况，以考虑前缀和后缀，例如姓名为“Bobby St Jones，Jr.”的情况？ - James West

@JamesW，这些情况可以通过构建更复杂的函数来处理，但在此之前，您必须定义其范围，并添加所有前缀，如“St”。 - RRUZ

@JamesW：唯一的方法是硬编码最常见的前缀，或使用一些启发式算法来猜测一个“单词”是否是标题或后缀。这并不难做到，但它可能永远无法达到100％的准确率，并且需要一些思考。 - Andreas Rejbrand

Answer 2

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;

如果字符串以一个意外的空格结尾，例如 'Andreas Rejbrand '，那么这种方法会失败。下面这个更健壮的版本可以处理这种情况：

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;

- Andreas Rejbrand

---

我正要发布那个！:-P - afrazier

太棒了，谢谢。这正是我所需要的。当SO允许时，我将在几分钟内接受答案。 - James West

@JamesW，赶紧点，否则Andreas就要跑了:-)。 - Johan

一个问题。如果姓氏是“St. James”，有什么解决办法吗？ - James West

@James: 这很困难。如果姓氏中包含一个没有明确句点的“前缀”，怎么办？这非常困难。 - Andreas Rejbrand

Answer 3

如果姓氏是“圣詹姆斯”，有没有办法解决呢？

以下是我的方法：

1. 制作一个姓氏标记列表。 2. 按照优先顺序搜索该列表。 3. 一旦找到匹配项，则将其标记为姓氏的起始位置。 4. 返回从该位置开始的子字符串。

代码如下：

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;

我还没有正确处理大小写，但我希望你能理解我的意思。

- Johan

---

ReplaceWith:= StringReplace(Suffix[i], ' ', '_',[]); 正在引发索引越界错误。 - James West

虽然我最终没有使用这段准确的代码，但我使用了非常类似的东西。我会将其作为回答发布以供审核。它实际上将这种逻辑（有点）与Andreas的答案中“获取最后一个单词”的代码结合在一起。 - James West

这个回答仍然非常以英语为中心。在真实的数据库系统中，我不会信任这样的系统。 - Warren P

@warren，当然不是，这只是一种拼凑破碎的数据库设计的绝望方法。我绝不会推荐这样做。我记得读过 Knuth 的论文，他的结论是这个问题没有解决方案。人类之所以能够做到这一点，是因为他们使用了大量的数据库高级模式匹配和启发式算法。 - Johan

即使是人类也会犯错。而且，有些文化中姓氏排在名字前面，个人的名字排在最后，这就更加复杂了。因此，“名字”本身也是一种以自我为中心的观念。 - Warren P

Answer 4

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;

这两个函数一起完成了我需要做的事情。还有一个 initlists 函数，它很笨拙丑陋，我需要继续努力改进，所以我没有在这里发布。

- James West

---

你没有考虑大小写。除此之外，这看起来还不错。我会使用 if AnsiContainsStr(lower(FullName), lower(SuffixFix[i])) then ... 来进行不区分大小写的比较。 - Johan

我可能会考虑那个选项，较低的部分已经被考虑在TStringlist中了，只是有些丑陋的代码我没有在这里展示。 - James West