Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdComponent, IdUDPBase, IdUDPClient, IdDNSResolver,
  IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze, IdSMTP, IdMessage;

  const
 MAX_HOSTNAME_LEN=128;
 MAX_DOMAIN_NAME_LEN=128;
 MAX_SCOPE_ID_LEN=256;
 type
 IP_ADDRESS_STRING =packed record
  S: array [0..15] of Char;
 end;
 IP_MASK_STRING=IP_ADDRESS_STRING;
 PIP_ADDR_STRING=^_IP_ADDR_STRING;
 _IP_ADDR_STRING=packed record
   Next:PIP_ADDR_STRING;
   IpAddress:IP_ADDRESS_STRING;
   IpMask:IP_MASK_STRING;
   Context:DWORD;
 end;
 IP_ADDR_STRING=_IP_ADDR_STRING;
 PFIXED_INFO=^FIXED_INFO;
 FIXED_INFO=packed record
  HostName:array [0..MAX_HOSTNAME_LEN+3] of Char;
  DomainName:array[0..MAX_DOMAIN_NAME_LEN+3] of Char;
  CurrentDnsServer:PIP_ADDR_STRING;
  DnsServerList:IP_ADDR_STRING;
  NodeType:UINT;
  ScopeId:array [0..MAX_SCOPE_ID_LEN+3] of Char;
  EnableRouting:UINT;
  EnableProxy:UINT;
  EnableDns:UINT;
 end;
type
  TForm1 = class(TForm)
    Button1: TButton;
    IdDNSResolver1: TIdDNSResolver;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  function GetNetworkParams(FixedInfo:PFIXED_INFO; var OutBufLen:DWord):DWORD; stdcall; external 'iphlpapi.dll';

implementation

{$R *.dfm}
 function GetMailServers(IPHostDNS,ADomain:string;RTimeOutDNS:integer;
                        var ResMailServers:TStrings; DNS:TIdDNSResolver):boolean;
{Ôóíêöèÿ îïðåäåëÿåò ñïèñîê Mail ñåðâåðîâ äëÿ äîìåíîãî àäðåñà ADomain.
PS: ADomain - åíòî äîìåí... íà êîòîðûé øëåø ïèñüìà(â òâîåì ñëó÷àè åíòî yandex.ru}
var i,x,n:integer;
    rb:Word;
    AHostMail:string;
begin
 Result:=true;
 with DNS do
  begin
   QueryResult.Clear;
   QueryRecords:=[qtMX];
   Host:=IPHostDNS;
   ReceiveTimeOut:=RTimeOutDNS;
   try
    Resolve(ADomain);
    i:=QueryResult.Count;
    if i>0 then
     begin
      try
       ResMailServers.Free;
      except
      end;
      ResMailServers:=TStringList.Create;
      repeat
       rb:=TMXRecord(QueryResult.Items[0]).Preference;
       n:=0;
       for x:=0 to QueryResult.Count-1 do
        if TMXRecord(QueryResult.Items[x]).Preference<=rb then
         begin
          rb:=TMXRecord(QueryResult.Items[x]).Preference;
          n:=x;
         end;
       try
        AHostMail:=trim(TMXRecord(QueryResult.Items[n]).ExchangeServer);
       except
        AHostMail:='';
       end;
       QueryResult.Delete(n);
       if AHostMail<>'' then
        begin
         ResMailServers.Append(AHostMail);
        end;
       dec(i);
      until (i=0);
      if ResMailServers.Count=0 then
       begin
        Result:=false;
        ResMailServers.Free;
       end; 
     end else Result:=false;
   except
    Result:=false;
   end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var FMailServers,IPHostDNS:TStrings;
    smtp:TIdSMTP;
    mes:TIdMessage;
    i:integer;
    FI:PFIXED_INFO;
    S:DWord;
    n:PIP_ADDR_STRING;
begin
 S:=0;;
 if GetNetworkParams(nil,S)<>ERROR_BUFFER_OVERFLOW then exit;
 GetMem(FI,S);
 IPHostDNS:=TStringList.Create;
 FMailServers:=TStringList.Create;
 if GetNetworkParams(FI,S)=ERROR_SUCCESS then
  begin
   n:=FI^.CurrentDnsServer;
   while n<>nil do
    begin
     IPHostDNS.Add(n^.IpAddress.S);
     n:=n^.Next;
    end;
   if FI^.DnsServerList.IpAddress.S[0]<>#0 then
    IPHostDNS.Add(FI^.DnsServerList.IpAddress.S);
   n:=FI^.DnsServerList.Next;
   while n<>nil do
    begin
     IPHostDNS.Add(n^.IpAddress.S);
     n:=n^.Next;
    end;
  end;
 FreeMem(FI,S);
 while IPHostDNS.Count>0 do
  begin
   if GetMailServers(IPHostDNS.Strings[IPHostDNS.Count-1],'mail.ru',5000,FMailServers,IdDNSResolver1) then
    begin
     smtp:=TIdSMTP.Create(nil);
     mes:=TIdMessage.Create(nil);
     smtp.Port := 25;
     smtp.AuthenticationType:=atNone;
     smtp.HeloName:='Info';
     mes.From.Text:='[email protected]';
     mes.Sender.Text:='[email protected]';
     mes.Recipients.EMailAddresses:='[email protected]'; //Ïîëó÷àòåëü
     mes.Subject:='al';
     mes.Body.Text:='Hello! Is test. If you see, hence all ok!!!';
     mes.MessageParts.Clear;
     for i:=0 to FMailServers.Count-1 do
      begin
       smtp.Host:=trim(FMailServers.Strings[i]);
       try
        smtp.Connect;
        smtp.Send(mes);
        IPHostDNS.Clear;
        break;
       except
       end;
       smtp.Disconnect;
      end;
     mes.Free;
     smtp.Free;
    end;
   if IPHostDNS.Count>0 then IPHostDNS.Delete(IPHostDNS.Count-1); 
  end;
 try
  IPHostDNS.Free;
  FMailServers.Free;
 except
 end;
end;




end.