Delphi 如何拆分非分隔电子邮件地址？

我有一个txt文件，其中包含大量的电子邮件，它们是没有空格分隔的。我想一行一行地整理这些电子邮件

所以，我的问题是：如何只获取分隔这些电子邮件的部分

例：（foo.txt）

brarabelalima@hotmail.comaracaesporteclube@terra.com.br

我想要这样：（new.txt）

brarabelalima@hotmail.com

aracaesporteclube@terra.com.br

这是我最后一次尝试：

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils,
  Windows,
  Classes;

procedure arrumarEmailsTXT;
var
 Linhas, Colunas:TStringList;
 i,j:integer;
 arq: TextFile;
begin
 Linhas := TStringList.Create;
 Colunas := TStringList.Create;
 AssignFile(arq, 'new.txt');
 Rewrite(arq);
 try
   Linhas.LoadFromFile('foo.txt');
   for i := 0 to Pred(Linhas.Count) do
   begin
     Colunas.text := StringReplace(Linhas.Strings[i],'',#13,[rfReplaceAll]);
     for j := 0 to Pred(Colunas.Count) do
     begin
      Writeln(arq, Colunas.Strings[j]);
     end;
   end;
 finally
   CloseFile(arq);
   Linhas.Free;
   Colunas.Free;
 end;
end;

begin
  arrumarEmailsTXT;
end.

---

首先浏览文本并创建一个列表，其中包含@-@

然后，从新列表的每个条目开始，将文本从开头一直剪切到第一个句点。这将为您提供这些电子邮件拥有的域的列表

然后，您需要填写域的最后一部分，并根据您的经验创建一个新的列表。 例如，对于每个“hotmail”，您都会有“hotmail.com”和“hotmail.co.uk”等

之后，您可以根据完整的域名提取每行的正确位置

然而，这可能会成为一项非常繁重的工作，需要花费大量的时间和资源。你的档案大吗？您可能需要线程来有效地运行作业

此外，了解电子邮件的来源可能有助于减少域名。

解决方案：

{$APPTYPE控制台}
{$R*.res}
使用
Winapi.Windows，
班级，
System.SysUtils；
函数ExtractEmails（const输入：String；out电子邮件：TStringList）：布尔值；
变量
I：整数；
缓冲区：字符串；
代币：TStringList；
开始
结果：=假；
令牌：=TStringList.Create；
电子邮件：=TStringList.Create；
尝试
标记。分隔符：=#32；
Tokens.DelimitedText:=输入；
对于I:=0的令牌。计数-1 Do
开始
缓冲区：=Tokens.Strings[I]；
如果长度（缓冲区）<5，则继续；
如果（位置（'@'，缓冲区）>1）和
（位置（''，缓冲器）>3）和
（位置（'.'，缓冲区）<长度（缓冲区）），然后
开始
电子邮件。添加（缓冲区）；
结束；
结束；
结果：=真；
最后
代币。免费；
结束；
结束；
程序外；
变量
Linhas，电子邮件：TStringList；
arq:TextFile；
开始
Linhas:=TStringList.Create；
电子邮件：=TStringList.Create；
尝试
Linhas.LoadFromFile（'foo.txt'）；
分配文件（arq，'emails.txt'）；
重写（arq）；
如果提取电子邮件（Linhas.Text，电子邮件），则
开始
Writeln（arq、email.Text）；
结束；
最后
关闭文件（arq）；
林哈斯。自由；
电子邮件。免费；
结束；
结束；
开始
额外的；
结束。

您需要找到一组规则来确定一个地址的结束位置和另一个地址的开始位置。信息不足。它们都是.com地址吗？它们都是简单的TLD吗？在

@

之后是否有多个句点，如

fred。smith@somewhere.mysite.com

？名称部分中的任何特殊字符，如

&

或

（

）如何处理？请更具体一些，并定义您要用于定义电子邮件地址开头和结尾的确切规则。您当前的尝试显然无效，因为您正在尝试替换空白（

'

）使用回车符，文本文件中不可能有任何空格。请定义电子邮件地址的规则。此外，我已删除了

分隔符

标记，因为如果文件被分隔，则不会出现问题，但根据您自己的文字和示例，没有分隔符。任意示例：

me@infour@在

是

.info

或印度

中的第一个域

？完全有效的地址是什么。smith@somewhere.mysite.com？那些只有两个字母域的地址，如

.ru

或

.sp

？那些包含特殊字符的完全合法的地址，如

&

或

（

？@Ken他们呢？那是他的问题——他不知道域名（或用户名）。当他没有预定义的规则时，你要求他定义规则。不，这是你不完整的答案没有解决的问题，这是非常真实的可能性。相反，你漫无目的地谈论一些关于非常繁重的工作和线程的废话。你应该等待，而不是发布一个细节不完整的问题的答案澄清要求。发布不充分或不完整的答案并不比发布错误的答案好。从开始到第一个阶段的文本切分不会给您提供域列表（如我的

fred.smith

示例所示）@Ken，好吧……如果他在文本文件中有10万行，for-loop会使应用程序崩溃。但无论如何，这不是问题的重点。如果我胡说八道，那么你的问题只会占用空间，因为你只问他不知道的问题。这就是为什么他需要想法如何获取电子邮件。如果他有你问题的答案，他将有能力回答我们e替换功能。无论如何，让我们等待授权。你没有任何信息表明这一点，就像你有关于文件中电子邮件地址类型的信息一样。问题的关键是，用户请求帮助解决尚未完全定义的问题，并推测可能的解决方案对这个未指明的问题的解释是没有好处的。是的，你首先应该做的是等待作者，而不是写你的文章。那么他们呢？这是他的问题，这是他的问题，在我们帮助解决它之前需要先定义它。没有解释的代码？如果你使用的是TStringLists在

ExtractEmails

中，你究竟为什么要使用AssignFile、Rewrite等来保存输出？@MartynA，将输出保存在新的txt文件中

 {$APPTYPE CONSOLE}

    {$R *.res}

    uses
      Winapi.Windows,
      Classes,
      System.SysUtils;

    function ExtractEmails(const Input: String; out Emails: TStringList): Boolean;
    var
      I : Integer;
      Buffer : String;
      Tokens : TStringList;
    begin
      Result := False;
      Tokens := TStringList.Create;
      Emails := TStringList.Create;
      Try
        Tokens.Delimiter := #32;
        Tokens.DelimitedText := Input;
        For I := 0 To Tokens.Count - 1 Do
          begin
          Buffer := Tokens.Strings[I];
          If Length(Buffer) < 5 Then Continue;
          If (Pos('@',Buffer) > 1) And
             (Pos('.',Buffer) > 3) And
             (Pos('.',Buffer) < Length(Buffer)) Then
             begin
             Emails.Add(Buffer);
          end;
        end;
        Result := True;
      Finally
        Tokens.Free;
      end;
    end;

    procedure Extrai;
     var
     Linhas,Emails:TStringList;
     arq: TextFile;
    begin
     Linhas := TStringList.Create;
     Emails := TStringList.Create;
     try
       Linhas.LoadFromFile('foo.txt');
       AssignFile(arq, 'emails.txt');
       Rewrite(arq);
          If ExtractEmails(Linhas.Text,Emails) Then
           begin
            Writeln(arq,Emails.Text);
           end;
     finally
       CloseFile(arq);
       Linhas.Free;
       Emails.Free;
     end;
    end;

    begin
       Extrai;
    end.