Author: Jonas Bilinkevicius

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

1   function MyWord(const Token: Char; const S: string): string;
2   var
3     B, M, E: Integer;
4     K: string;
5   begin
6     Result := '';
7     M := Pos(Token, S);
8     if M > 0 then
9     begin
10      K := ' ' + S + ' '; {wrap in spaces cause I'm lazy}
11      B := M + 1;
12      repeat
13        Dec(B);
14      until
15        K[B] in [' ', #9, #10];
16      E := M;
17      repeat
18        Inc(E);
19      until
20        K[E] in [' ', #9, #13];
21      Result := Copy(S, B, E - B - 1);
22    end;
23  end;


Example of using:

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



Solve 2:

28  {Parse item}
29  
30  procedure ParseItem(var Source, Item: string; Delimiter: Char);
31  var
32    CurrentPosition: Integer;
33  begin
34    CurrentPosition := Pos(Delimiter, Source);
35    if CurrentPosition = 0 then
36    begin
37      {No delimeter - item is the remaining string}
38      Item := Source;
39      Source := '';
40    end
41    else
42    begin
43      {There is a delimeter}
44      Item := Copy(Source, 1, CurrentPosition - 1);
45      Delete(Source, 1, CurrentPosition);
46    end;
47  end;
48  
49  function GetEmailAddress(ASource: string): string;
50  var
51    AWord: string;
52  begin
53    Result := '';
54    while ASource <> '' do
55    begin
56      ParseItem(ASource, AWord, ' ');
57      if Pos('@', AWord) <> 0 then
58      begin
59        Result := AWord;
60        Break;
61      end;
62    end;
63  end;
64  
65  procedure TForm1.Button30Click(Sender: TObject);
66  begin
67    ShowMessage(GetEmailAddress('Order from theWeb : a.dyble@ntlworld.com'));
68  end;



Solve 3:

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

69  P := Pos(':', Subject) + 2; {Position following the colon / blank}
70  {Grab everything after}
71  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:

72  function ExtractEMailAddress(const s: string): string;
73  const
74    goodEMailChars = ['A'..'Z', 'a'..'z', '@', '.', '_', '-'];
75  var
76    i, j, lth: integer;
77  begin
78    i := pos('@', s);
79    if i > 0 then
80    begin
81      j := i + 1;
82      while (i > 0) and (s[i] in goodEMailChars) do
83        dec(i);
84      inc(i);
85      lth := Length(s);
86      while (j <= lth) and (s[j] in goodEMailChars) do
87        inc(j);
88      result := Copy(s, i, j - i);
89    end
90    else
91      result := '';
92  end;



Solve 5:

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

93  function FindSubString(const S, Prefix, Suffix: string): string;
94  var
95    P: Integer;
96  begin
97    Result := EmptyStr;
98    P := Pos(Prefix, S);
99    if P > 0 then
100   begin
101     Result := Copy(S, P + Length(Prefix), Length(S));
102     P := Pos(Suffix, Result);
103     if P > 0 then
104       SetLength(Result, P - 1)
105     else
106       Result := EmptyStr;
107   end;
108 end;


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