Поиск адреса электронной почты в тектсовом файле

uses
  crt;
const
  limits = [#0..#32,',',':',';','!','?','"'];
  MaxWords = 100;
  MaxLimitWords =1000000;
type
  TWords = array[1..MaxWords] of string[80];
  AllWords = array[1..MaxLimitWords] of string[80];
var
  text : string[80];
  words : TWords;
  mywords:allwords;
  f : textfile;
  nwords:word;
  i,count:dword;
  ch:char;
 
 
function GetWords(s : string; var w : TWords) : Word;
var
  i,back,n : word;
begin
  i := 1;
  n := 0;
  while(i<=length(s)) do
    begin
      while(i<=length(s)) and (s[i] in limits) do
        inc(i);
      if i<=length(s) then
        begin
          back := i;
          while(i<=length(s)) and not(s[i] in limits) do
            inc(i);
         inc(n);
         w[n] := copy(s, back, i-back);
       end;
    end;
  GetWords := n;
end;
 
function CheckMail(s:string):boolean;
var
  isvalidmail:boolean;
  k,i:integer;
begin
  isvalidmail:=false;
  k:=0;
  {содержит недопустимые знаки}
  for i:=1 to length(s) do
    begin
      if (s[i] in ['а'..'я','А'..'Я']) then
        begin
          isvalidmail:=false;
          break;
        end;
      if (s[i] in ['0'..'9','a'..'z','_','.','@']) then
        isvalidmail:=true;
      if s[i]='@' then
        inc(k);
    end;
    {количество @ не равно одному}
  if k<>1 then
       isvalidmail:=false;
  { начинается со знака @ }
    if s[1]='@' then
      isvalidmail:=false;
 
  CheckMail:=isvalidmail;
end;
 
begin
  clrscr;
  assign(f,'example.txt');
  reset(f);
  count:=0;
  while not eof(f) do
    begin
      readln(f,text);
      nwords:=getwords(text,words);
      for i:=1 to nwords do
        mywords[i+count]:=words[i];
      count:=count+nwords;
    end;
  close(f);
  for i:=1 to count do
    if CheckMail(mywords[i]) then
      write((mywords[i]),' ');
  readln;
end.

var t:text;
i,l,c: integer;
s,s1: string;
begin
assign(t,'C:/123.txt');
reset(t);
s:=' ';
while s<>'' do
begin
readln(t,s);
 
repeat
begin
l:=pos('@',s);
if l<>0 then
begin
s1:='';
i:=l-1;
s[l]:='*';
while s[l]<>' ' do
begin
l:=l+1;
s1:=s1+s[l];
if l=length(s) then break;
end;
s1:='@'+s1;
while s[i]<>' ' do
begin
s1:=s[i]+s1;
i:=i-1;
if i=0 then break;
end;
writeln(s1);
end;
end;
until l=0;
 
end;
close(t);
end.