How to extract a string from the middle of a sentence

Problem/Question/Abstract:

I need to extract a string from the middle of a sentence. For example: An email will come in with the following subject: Order from the Web : a.dyble@ntlworld.com. My method is to start at the @ sign and work outwards using copy.

Answer:

Solve 1:

This may not be the most efficient, but

function MyWord(const Token: Char; const S: string): string;
var
  B, M, E: Integer;
  K: string;
begin
  Result := '';
  M := Pos(Token, S);
  if M > 0 then
  begin
    K := ' ' + S + ' '; {wrap in spaces cause I'm lazy}
    B := M + 1;
    repeat
      Dec(B);
    until
      K[B] in [' ', #9, #10];
    E := M;
    repeat
      Inc(E);
    until
      K[E] in [' ', #9, #13];
    Result := Copy(S, B, E - B - 1);
  end;
end;

Example of using:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := MyWord('@', Memo1.Text);
end;


Solve 2:

{Parse item}

procedure ParseItem(var Source, Item: string; Delimiter: Char);
var
  CurrentPosition: Integer;
begin
  CurrentPosition := Pos(Delimiter, Source);
  if CurrentPosition = 0 then
  begin
    {No delimeter - item is the remaining string}
    Item := Source;
    Source := '';
  end
  else
  begin
    {There is a delimeter}
    Item := Copy(Source, 1, CurrentPosition - 1);
    Delete(Source, 1, CurrentPosition);
  end;
end;

function GetEmailAddress(ASource: string): string;
var
  AWord: string;
begin
  Result := '';
  while ASource <> '' do
  begin
    ParseItem(ASource, AWord, ' ');
    if Pos('@', AWord) <> 0 then
    begin
      Result := AWord;
      Break;
    end;
  end;
end;

procedure TForm1.Button30Click(Sender: TObject);
begin
  ShowMessage(GetEmailAddress('Order from theWeb : a.dyble@ntlworld.com'));
end;


Solve 3:

Can we assume that you always have the colon / blank sequence? If so then this may be easier:

P := Pos(':', Subject) + 2; {Position following the colon / blank}
{Grab everything after}
EMailAddress := Copy(Subject, P, Length(Subject) - P - 1);


Solve 4:

If you can't count on the ' :' as Kurt suggests, perhaps the following will do:

function ExtractEMailAddress(const s: string): string;
const
  goodEMailChars = ['A'..'Z', 'a'..'z', '@', '.', '_', '-'];
var
  i, j, lth: integer;
begin
  i := pos('@', s);
  if i > 0 then
  begin
    j := i + 1;
    while (i > 0) and (s[i] in goodEMailChars) do
      dec(i);
    inc(i);
    lth := Length(s);
    while (j <= lth) and (s[j] in goodEMailChars) do
      inc(j);
    result := Copy(s, i, j - i);
  end
  else
    result := '';
end;


Solve 5:

You can use Pos to locate the substrings and Copy to copy the text to a new string. Something like:

function FindSubString(const S, Prefix, Suffix: string): string;
var
  P: Integer;
begin
  Result := EmptyStr;
  P := Pos(Prefix, S);
  if P > 0 then
  begin
    Result := Copy(S, P + Length(Prefix), Length(S));
    P := Pos(Suffix, Result);
    if P > 0 then
      SetLength(Result, P - 1)
    else
      Result := EmptyStr;
  end;
end;

The code isn't very efficient, but it should get you started.