procedure TIdSMTPRelay.ResolveMXServers(AAddress:
String);
var
IdDNSResolver1: TIdDNSResolver;
DnsResource: TResultRecord;
LMx: TMxRecord;
LDomain:
String;
i: Integer;
iPref: Word;
begin
{ Get the list of MX Servers for a given domain into FMXServerList }
if Pos('
@', AAddress) > 0
then
begin
LDomain := Copy(AAddress, IndyPos('
@', AAddress) + 1, Length(AAddress) - Pos('
@', AAddress))
end
else
begin
raise EIdDirectSMTPCannotResolveMX.Create(Sys.Format(RSDirSMTPInvalidEMailAddress, [AAddress]));
end;
IdDNSResolver1:=TIdDNSResolver.Create(Self);
FMXServerList.Clear;
try
try
IdDNSResolver1.AllowRecursiveQueries:=True;
if Assigned(IOHandler)
and (IOHandler.ReadTimeOut <> 0)
then
begin
// thirty seconds - maximum amount of time allowed for DNS query
IdDNSResolver1.WaitingTime := IOHandler.ReadTimeout;
// 30000;
end
else
begin
IdDNSResolver1.WaitingTime := 30000;
end;
IdDNSResolver1.QueryType := [qtMX];
IdDNSResolver1.Host := DNSServer;
IdDNSResolver1.Resolve(LDomain);
if IdDNSResolver1.QueryResult.Count > 0
then
begin
iPref := High(Word);
for i := 0
to IdDNSResolver1.QueryResult.Count - 1
do
begin
DnsResource := IdDNSResolver1.QueryResult[i];
if (DnsResource
is TMXRecord)
then
begin
LMx := TMXRecord(DnsResource);
// lower preference values at top of the list
// could use AddObject and CustomSort, or TIdBubbleSortStringList
// currently inserts lower values at top
if LMx.Preference < iPref
then
begin
iPref := LMx.Preference;
FMXServerList.Insert(0, LMx.ExchangeServer);
end
else
begin
FMXServerList.Add(LMx.ExchangeServer);
end;
end;
end;
end;
if FMXServerList.Count = 0
then
begin
raise EIdDirectSMTPCannotResolveMX.Create(Sys.Format(RSDirSMTPNoMXRecordsForDomain, [LDomain]));
end;
finally
IdDNSResolver1.Free;
end;
except
raise;
end;
end;