1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

function FindNextWord (SStr : string; var start : integer) : string;
var wstart,wend,sl,fl : integer;
begin
Result := '';
l := Length (SStr);
wstart := start;
while (wstart <= l) and (SStr[wstart] = ' ') do wstart := wstart + 1;
wend := wstart;
while (wend <= l) and (SStr[wend] <> ' ') do wend := wend + 1;
fl := wend + 1 - wstart;
if fl > 0 then
  begin
  Result := Copy (SStr,wstart,f1);
  start := wend + 1;
  end
else start := 0;
end;

function FindDomain (DStr : string) : string;
var IsDomain : boolean;
    DStrPos,NWLength : integer;
    NextWord : string;
begin
Result := '';
IsDomain := false;
DStrPos := 1;
repeat
  NextWord := FindNextWord (DStr,DStrPos);
  NWLength := Length (NextWord);
  if NWLength > 0 then
    if Pos ('.',NextWord) < NWLength then IsDomain := true;
until IsDomain or DStrPos = 0;
if IsDomain then Result := NextWord;
end;