unit RFIndyUtils;
{$IFNDEF INDY9}
{$IF RTLVersion > 18.0}
{$DEFINE INDY10}
{$IFEND}
{$ENDIF}
interface
uses
Classes, IdDNSResolver;
function RFGetMXServers(const ADNSServer: String; const ADomain: String;
AMXServers: TStrings; ATimeOutMS: Integer = 0): Boolean; overload;
function RFGetMXServers(ADNSResolverComp: TIdDNSResolver;
const ADNSServer: String; const ADomain: String; AMXServers: TStrings): Boolean; overload;
{ Liefert alle zu einer Domäne passenden Mailserver (MX) als StringList retour.
ADNSServer: Name des zu verwendenden DNS-Servers oder leer wenn e.root-servers.net
verwendet werden soll.
AResolveDomain: Domain-Name zu dem die Mailserver (MX) retour gegeben werden soll.
AMXServers: Stringliste in der die Mailserver retour geliefert werden. }
function RFResolveMailServer(const ADNSServer, AResolveDomain: String;
ATimeOutMS: Integer = 0): String;
{ Liefert die Mailserveradresse zu einer EMail zurück. Bsp: info@domain.com -> mail.domain.com
Mögliche Rückgabewerte:
Server gemäss DNS MX-Record oder leer wenn nichts gefunden.
Parameter:
ADNSServer: Name des zu verwendenden DNS-Servers oder leer zum Start bei einem root DNS-Server (empfohlen).
AResolveDomain: Domain-Name zu dem der eigentliche Server-Name retour gegeben werden soll
ATimeOutMS: Timeout in ms, die beim Lesen gewartet werden soll bevor ein Fehler kommt.
Wenn <= 0 wird der Standard verwendet }
implementation
uses
SysUtils;
function SortServers(List: TStringList; Index1, Index2: Integer): Integer;
{ RFGetMXServers StringList-Sortierungsroutine }
var
p1, p2: Word;
begin
p1 := Word(List.Objects[Index1]);
p2 := Word(List.Objects[Index2]);
if p1 < p2 then
Result := -1
else if p1 > p2 then
Result := 1
else
Result := 0;
end;
function InternalGetMXServers(ADNSResolverComp: TIdDNSResolver; const ADNSServer: String;
const ADomain: String; AMXServers, ASearchedNSServers: TStrings): Boolean;
var
i : Integer;
NSServers, MXServers: TStringList;
ServerARecord: String;
TmpQueryType: TQueryType;
begin
Result := False;
AMXServers.Clear;
if ADNSResolverComp = nil then
Exit;
if ADNSServer = '' then
ADNSResolverComp.Host := 'k.root-servers.net'
else
ADNSResolverComp.Host := ADNSServer;
try
ADNSResolverComp.Resolve(ADomain);
if ADNSResolverComp.QueryResult.Count = 0 then
begin
ADNSResolverComp.Host := 'i.root-servers.net';
ADNSResolverComp.Resolve(ADomain);
end;
except
Exit;
end;
MXServers := nil;
ServerARecord := '';
for i := 0 to ADNSResolverComp.QueryResult.Count - 1 do
begin
if ADNSResolverComp.QueryResult[i] is TMXRecord then
begin
if MXServers = nil then
MXServers := TStringList.Create;
with TMXRecord(ADNSResolverComp.QueryResult[i]) do
MXServers.AddObject(ExchangeServer,TObject(Integer(Preference)));
end;
if ADNSResolverComp.QueryResult[i] is TARecord then
ServerARecord := TARecord(ADNSResolverComp.QueryResult[i]).Name;
end;
if MXServers <> nil then
begin
MXServers.CustomSort(SortServers);
AMXServers.Assign(MXServers);
FreeAndNil(MXServers);
Result := True;
Exit;
end;
NSServers := nil;
try
for i := 0 to ADNSResolverComp.QueryResult.Count - 1 do
begin
if ADNSResolverComp.QueryResult[i] is TNSRecord then
begin
with TNSRecord(ADNSResolverComp.QueryResult[i]) do
begin
if HostName <> '' then
begin
if NSServers = nil then
NSServers := TStringList.Create;
NSServers.Add(HostName);
end;
end;
end;
end;
if NSServers <> nil then
begin
for i := 0 to NSServers.Count-1 do
begin
{ Bereits durchsuchte Subdomains sollen nicht mehr durchsucht werden }
if ASearchedNSServers.IndexOf(NSServers[i]) = -1 then
begin
Result := InternalGetMXServers(ADNSResolverComp, NSServers[i], ADomain,
AMXServers, ASearchedNSServers);
if Result then
Exit;
ASearchedNSServers.Add(NSServers[i]);
end;
end;
end
else if ServerARecord <> '' then
begin
{ Top Level no MX found, so we report the A record }
{$IFDEF INDY10}
TmpQueryType := ADNSResolverComp.QueryType;
ADNSResolverComp.QueryType := [qtA];
{$ELSE}
TmpQueryType := ADNSResolverComp.QueryRecords;
ADNSResolverComp.QueryRecords := [qtA];
{$ENDIF}
try
ADNSResolverComp.Resolve(ADomain);
if ADNSResolverComp.QueryResult.Count <> 0 then
begin
AMXServers.Add(ADomain);
Result := True;
end;
finally
{$IFDEF INDY10}
ADNSResolverComp.QueryType := TmpQueryType;
{$ELSE}
ADNSResolverComp.QueryRecords := TmpQueryType;
{$ENDIF}
end;
end;
finally
if NSServers <> nil then
NSServers.Free;
end;
end;
function RFGetMXServers(ADNSResolverComp: TIdDNSResolver; const ADNSServer: String;
const ADomain: String; AMXServers: TStrings): Boolean; overload;
var
SearchedNSServers: TStringList;
begin
SearchedNSServers := TStringList.Create;
try
Result := InternalGetMXServers(ADNSResolverComp, ADNSServer, ADomain,
AMXServers, SearchedNSServers);
finally
SearchedNSServers.Free;
end;
end;
function RFGetMXServers(const ADNSServer: String; const ADomain: String;
AMXServers: TStrings; ATimeOutMS: Integer = 0): Boolean;
var
DNSResolver: TIdDNSResolver;
begin
DNSResolver := TIdDNSResolver.Create(nil);
try
{$IFDEF INDY10}
if ATimeOutMS <> 0 then
DNSResolver.WaitingTime := ATimeOutMS
else
DNSResolver.WaitingTime := 3000;
DNSResolver.QueryType := [qtMX];
{$ELSE}
if ATimeOutMS <> 0 then
DNSResolver.ReceiveTimeout := ATimeOutMS
else
DNSResolver.ReceiveTimeout := 3000;
DNSResolver.QueryRecords := [qtMX];
{$ENDIF}
Result := RFGetMXServers(DNSResolver, ADNSServer, ADomain, AMXServers);
finally
DNSResolver.Free;
end;
end;
function RFResolveMailServer(const ADNSServer, AResolveDomain: String;
ATimeOutMS: Integer = 0): String;
var
MXServers: TStringList;
begin
Result := '';
MXServers := TStringList.Create;
try
if RFGetMXServers(ADNSServer, AResolveDomain, MXServers, ATimeOutMS) then
Result := Trim(MXServers[0]);
finally
MXServers.Free;
end;
end;
end.