[D2009] Online eMail-Adress Prüfung obs valide ist?

[Rolf Frei]

Eine 100%ige E-Mailüberprüfung kannst du nicht machen, wie dir hier ja schon mehrere geschrieben haben. Du kannst im Prinzip nur die Syntax und das Vorhandensein eines Mailsservers, der zur EMail-Domäne passt, überprüfen.

Die Syntaxprüfung kannst du mit einem RegEx machen und die Abfage, ob es einen MX-Record zu einer E-Mailadresse gibt, kannst du mit folgender Unit machen. Die Funktion RFResolveMailServer liefert dir das Gewünschte retour.

Beispiel:

Code:

s := RFResolveMailServer('8.8.8.8', 'meinefirma.de');  // Google DNS

// Wenn kein zur Domäne passender MX-Record über den Google DSN gefunden wurde, 
// durchsuchen wir nun vom Root-DNS Server aus nach unten durch die DNS-Serverlisten. 
if s = '' then  
  s := RFResolveMailServer('', 'meinefirma.de');

if (s <> '') then
  Mailserver := s
else
  Mailserver := 'E-Mail domäne ungültig';

Code:

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: [e-mail] -> 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.