Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Сети > Отправка почты

Автор: Albinos_x 23.4.2005, 16:25

С сетью работаю первый раз. Вот возникла задача: Отправить письмо на E-mail при загрузке программы... Пробовал два способа взятых с этого форума Первый: Код ...    SMTP: TIdSMTP;     Mes: TIdMessage; ...   smtp.Host := 'localhost';   smtp.Port := 25;   mes.From.Text := 'xxxxxx@nihtmail.ru';   mes.Recipients.EMailAddresses := 'xxxxxxx@yandex.ru';   mes.Subject := 'Albinos';   mes.Body.Text := 'Test';   smtp.Connect(100000);   //<-  Ошибка Socket Error # 10061 Connection refused   smtp.Send(mes);   smtp.Disconnect; и второй Код ... function sendmail(const smtp, mail_from, mail_to, body: string): boolean; const ok = '250';            cl = #13#10;     var WSAData: TWSAData;        Host: TSockAddrIn;        Sock: TSocket;        res: integer;        hostEnt: PHostEnt;      { îòïðàâëÿåì äàííûå ÷åðåç ñîêåò }      procedure senddata(str: string);      var i: integer;      begin        for i := 1 to length(str) do          if send(sock, str[i], 1, 0) = SOCKET_ERROR then exit;      end;  { ïîëó÷àåì îòâåò îò êîìàíäû }      function recvdata(const accept: string): bool;      var buff: array[1..255] of char;      begin        res := recv(Sock, buff, 255, 0);        result := (res = SOCKET_ERROR) or (copy(buff, 1, 3) = accept);      end;     begin      result := false;      try        WSAStartUp($101, WSAData);        Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);        if Sock = INVALID_SOCKET then exit;        // ïîëó÷àåì IP àäðåñ SMTP-ñåðâåðà è ïåðåâîäèì åãî ÷åðåç inet_addr        hostEnt := gethostbyname(PChar(smtp));    if hostEnt = nil then exit;        res := inet_addr(PChar(inttostr(byte(hostEnt^.h_addr_list^[0]))+'.'+inttostr(byte(hostEnt^.h_addr_list^[1]))+'.'+                 inttostr(byte(hostEnt^.h_addr_list^[2]))+'.'+inttostr(byte(hostEnt^.h_addr_list^[3]))));        if res <= 0 then exit;        { óñòàíàâëèâàåì õîñò è ïîðò ñåðâåðà }        Host.sin_family := AF_INET;        Host.sin_port := htons(25); // ïîðò 25, ìîæåøü ïîìåíÿòü        Host.sin_addr.S_addr := res;        if connect(Sock, Host, SizeOf(Host)) > 0 then exit;        sleep(200);        if not recvdata('220') then exit; // ïðèâåòñòâèå ñåðâåðà        senddata('HELO SANTA' + cl); // ïîñëå HELO ìîæåøü íàïèñàòü ñâîå ïðèâåòñòâèå        sleep(200);        if not recvdata(ok) then exit;        senddata('MAIL FROM:' + '<'+mail_from+'>' + cl);        sleep(200);        if not recvdata(ok) then exit;    senddata('RCPT TO:' + '<'+mail_to+'>' + cl);        sleep(200);        if not recvdata(ok) then exit;        senddata('DATA' + cl);        sleep(200);        if not recvdata('354') then exit;        senddata(body + cl + '.' + cl); // îòïðàâëÿåì òåêñò ñîîáùåíèÿ        sleep(200);        if not recvdata(ok) then exit;        senddata('QUIT' + cl); // îòêëþ÷àåìñÿ îò ñåðâåðà        result := true;      finally        closesocket(sock);        WSACleanup      end; ... sendmail('smtp.yandex.ru', 'xxxxx@yandex.ru', 'xxxxxx@yandex.ru', 'hello there!'); в этом на почтовый ящик ничего не приходит... Помогите, пожалуйста, кто знает как решить задачку любым из способов... Заранее спасибо!

Автор: Albinos_x 24.4.2005, 14:47

Кто-нибудь делал это когда-либо?

Автор: Albinos_x 24.4.2005, 18:49

Благодаря Girder В первом способе ошибка ушла и даже индикатор в нижнем правом углу показывает что, что-то отсылается и в первом и во втором методе, но на мыло по прежнему ничего падать не хочет... Добавлено @ 18:55 Пробовал уже smtp.Host := 'smtp.yandex.ru'; и smtp.Host := 'smtp.nightmail.ru'; но всё без изменений

Автор: Albinos_x 24.4.2005, 22:07

теперь делаю так... Код procedure TForm1.Button1Click(Sender: TObject); begin smtp:=TIdSMTP.Create(nil);  mes:=TIdMessage.Create(nil);  smtp.Host := 'smtp.nightmail.ru';  smtp.Port := 25;  smtp.Password:='xxxxxx';  smtp.Username:='Albinos';  smtp.AuthenticationType:=atLogin; //Òèïî ïî ïàðîëþ è âñå òàêîå  smtp.HeloName:='Info';  mes.From.Text := 'xxxxx@nightmail.ru';  mes.Sender.Text:='xxxxx@nightmail.ru';  mes.Recipients.EMailAddresses:='xxxxxx@yandex.ru';  mes.Subject := 'al';  mes.Body.Text :='Hello! Is test. If you see, hence all ok!!!';  mes.MessageParts.Clear;  try   smtp.Connect;   smtp.Send(mes);  except  end;  smtp.Disconnect;  mes.Free;  smtp.Free; Label1.Caption:='Finished'; end; по прежнему ничего не приходит... Кто-нибудь знает, что не так?

Автор: RA 25.4.2005, 14:20

Не люблю я индейцев, поэтому кодом не помогу. Но есть предположение, что SMTP требует SSL аутентификации.

Автор: RA 25.4.2005, 14:32

---------

Автор: Albinos_x 25.4.2005, 16:15

Цитата Вот щас шлянул IdSMTP1.Socksinfo.Authentication := SaUsernamePasssword что-то не принимает делфя эту строчку... Не знает он что такое Socksinfo и SaUsernamePasssword Цитата Не люблю я индейцев, поэтому кодом не помогу. А есть другие способы, под 7 делфю?

Автор: RA 25.4.2005, 16:31

Блин сложно разбираться в компонентах к каторым нет описания и исходников. Вобщем давай тогда мануально, в свойсвах компонента IdSMTP1 найди SocksInfo в нём попробуй выставить в параметре Authentication - "saUsernamePassword"

Автор: RA 25.4.2005, 16:44

Цитата(Albinos_x @ 25.4.2005, 16:15) А есть другие способы, под 7 делфю? Есть нормальные компоненты ICS для этих и иных целей, http://www.overbyte.be (С исходниками и примерами) ICS - The Best

Автор: Albinos_x 25.4.2005, 16:50

Цитата Блин сложно разбираться в компонентах к каторым нет описания и исходников и не говори... Цитата Вобщем давай тогда мануально, в свойсвах компонента IdSMTP1 найди SocksInfo в нём попробуй выставить в параметре Authentication - "saUsernamePassword" У меня нет такого параметра в этом компоненте... ...?!?...

Автор: _hunter 25.4.2005, 17:36

есть к ним и описание и исходники -- на оффсайт сходите

Автор: Albinos_x 25.4.2005, 18:54

Цитата на оффсайт сходите английский, к сожалению, не знаю... Да и поиск там ничего не дал... Ни черта там понять не могу...

Автор: RA 25.4.2005, 19:42

Цитата(_hunter @ 25.4.2005, 17:36) есть к ним и описание и исходники  -- на оффсайт сходите Я то думал они платные. Цитата(Albinos_x @ 25.4.2005, 16:50) У меня нет такого параметра в этом компоненте... Мда, сейчас посмотрел на идейцев из D7 там и правда нет такого Но в D6 Indy v8.025 точно есть. Кароче дело обстаит так: для доступа к SSL кидай на форму из вкладки Indy I/0 Handlers компонент IdServerIOHandlerSSL1 (вот в этом компоненте нужно порыться и настроиться) , каторы подключи к IdSMTP1. Далее сам. Добавлено @ 19:45 А насчёт Socksinfo это я касяк выдал, как я толькочто заметил оно для соединения через Proxy.

Автор: Albinos_x 25.4.2005, 20:44

спасибо... будем разбираться... {но уже не сегодня, пора спать (время 0.56)}

Автор: Girder 26.4.2005, 01:50

1. У тебя должен быть доступен DNS сервер(ы); 2. Открой новое приложение... и брось на форму: - TIdAntiFreeze; - TIdDNSResolver; - TButton... 3. Не забудь подвесить на OnClick кнопки процедуру из кода... Типо сам... код(а точнее весь модуль): Код 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)     IdAntiFreeze1: TIdAntiFreeze;     IdDNSResolver1: TIdDNSResolver;     Button1: TButton;     procedure Button1Click(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],'yandex.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:='VasaPupkin@nightmail.ru';      mes.Sender.Text:='VasaPupkin@nightmail.ru';      mes.Recipients.EMailAddresses:='XXXX@yandex.ru'; //Получатель      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. PS: На yandex ентот код... не натравливал (на моих - работает) Удачи.

Автор: Albinos_x 26.4.2005, 18:23

Большущее СПАСИБО!!! Всё работает на ура..

Автор: WolfON 30.4.2005, 21:13

на indy 10 неработает ((( там ругается на [Error] Unit1.pas(73): Undeclared identifier: 'QueryRecords' мне кажеться в 10 версии это InternalQuery, но если заменить не него, то QueryRecords:=[qtMX]; ругается на несоответствие типов. Я немного на сайте Indy порылся, но так ничего и ненашел Добавлено @ 21:20 попытался так исправить: Код unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, IdComponent, IdUDPBase, IdUDPClient, IdDNSResolver, IdBaseComponent,   IdAntiFreezeBase, IdAntiFreeze, IdSMTP, IdMessage, StdCtrls,   IdTCPConnection; 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;     IdAntiFreeze1: TIdAntiFreeze;     IdDNSResolver1: TIdDNSResolver;     procedure Button1Click(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; var i,x,n:integer;     rb:Word;     AHostMail:string; begin  Result:=true;  with DNS do   begin    QueryResult.Clear;    QueryType:=[qtMX]; //   QueryRecords:=[qtMX];    Host:=IPHostDNS;    WaitingTime:=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.AuthType:=atNone;      smtp.HeloName:='Info';      mes.From.Text:='VasaPupkin@nightmail.ru';      mes.Sender.Text:='VasaPupkin@nightmail.ru';      mes.Recipients.EMailAddresses:='wolfon@inbox.ru';      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. Но на yandex.ru не проходит (((((

Автор: Girder 1.5.2005, 17:00

Цитата(WolfON @ 30.4.2005, 22:13) Я немного на сайте Indy порылся, но так ничего и ненашел А ты им... письмо напиши Во первых: Ты шлеш на wolfon @ inbox.ru Во вторых: Запрашиваеш Mail домены у mail.ru В третьих: Не удевительно... что у тебя ни куда не шлется. PS: Куда шлеш... у того и должен запрашивать!!! Т.е. если шлеш на XXX@inbox.ru то и запрашивай GetMailServers(..., 'inbox.ru'...) Ладно... вот переписал без использования IdDNSResolver: -Брось на новую форму TIdAntiFreeze, TButton и подцепи обработчик на OnClick Код unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, IdComponent, 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)     IdAntiFreeze1: TIdAntiFreeze;     Button1: TButton;     procedure Button1Click(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} uses WinSock; type  TSockClose = class(TThread)   private    Sock:TSocket;    milliseconds:cardinal;   protected     procedure Execute;override;   end; procedure TSockClose.Execute; begin  if milliseconds<100 then milliseconds:=500;  sleep(milliseconds);  CloseSocket(Sock); end; function GetMailServers(IPHostDNS,ADomain:string;RTimeOutDNS:integer; var ResMailServers:TStrings):boolean; var ID:Word;     IQStr,QStr:string;     i,j,n,l:integer;     Init:TWSAData;     Sock:TSocket;     Target:TSockAddrIn;     SockClose:TSockClose;     Buf:array [1..8192] of Char;     d:string; function GetName(var i:integer):string; var ti:integer;     b:Byte;     s:String; begin  Result:='';  if i>SizeOf(Buf) then exit;  ti:=0;  repeat   b:=ord(Buf[i]);   while (i<SizeOf(Buf))and((b and $c0)=$c0) do    begin     if ti=0 then ti:=i+1;     b:=b and $3F;     i:=((b shl 8) or ord(Buf[i+1]))+1;     b:=ord(Buf[i]);    end;   if i<SizeOf(Buf) then    begin     SetLength(s,b);     Move(Buf[i+1],S[1],b);     i:=i+b+1;     Result:=Result+s+'.';     SetLength(s,0);    end;  until (i>SizeOf(Buf))or(Buf[i]=#0);  if (Length(Result)>0)and(Result[Length(Result)]='.') then   Result:=Copy(Result,1,Length(Result)-1);  if ti>0 then i:=ti;  inc(i);  end; begin  Result:=false;  ADomain:=trim(ADomain);  if ADomain='' then exit;  j:=1;  QStr:='';  for i:=1 to Length(ADomain) do   if ADomain[i]='.' then    begin     n:=i-j;     if n>0 then      QStr:=QStr+Chr(n mod 256)+Copy(ADomain,j,n);     j:=i+1;    end;  n:=Length(ADomain)-j+1;  if n>0 then   QStr:=QStr+Chr(n mod 256)+Copy(ADomain,j,n);  QStr:=QStr+#0+#0+#15+#0+#1;   Randomize;  ID:=Random(65535);  IQStr:=Chr(ID div 256)+Chr(ID mod 256)+#1+#0+#0+#1+#0+#0+#0+#0+#0+#0+QStr;  if WSAStartup($101,Init)=0 then   begin    Sock:=Socket(PF_INET,SOCK_DGRAM,IPPROTO_UDP);    if Sock<>INVALID_SOCKET then     begin      Target.sin_port:=htons(53);      Target.sa_family:=PF_INET;      i:=0;      if (inet_addr(PChar(IPHostDNS))<>INADDR_NONE) then       Target.sin_addr.S_addr:=inet_addr(PChar(IPHostDNS)) else i:=1;      if ((i=1)or(Connect(Sock,Target,SizeOf(Target))=Socket_Error)) then       begin        CloseSocket(Sock);        WSACleanup;        exit;       end;      SockClose:=TSockClose.Create(True);      SockClose.FreeOnTerminate:=true;      SockClose.Priority:=tpIdle;      SockClose.Sock:=Sock;      SockClose.milliseconds:=RTimeOutDNS;      if Send(Sock,PChar(IQStr)^,Length(IQStr),0)<>Socket_Error then       begin        try         ResMailServers.Free;        except        end;        ResMailServers:=TStringList.Create;        FillChar(Buf,SizeOf(Buf),#0);        FillChar(Target.sin_zero,SizeOf(Target.sin_zero),#0);        SockClose.Resume;        repeat         i:=Recv(Sock,Buf,SizeOf(Buf),0);         if (i>=Length(IQStr))and((ord(Buf[1])shl 8)or ord(Buf[2])=ID)and(ord(Buf[4])and $F=0) then          begin           j:=(ord(Buf[5])shl 8)or ord(Buf[6])+(ord(Buf[7])shl 8)or ord(Buf[8])+              (ord(Buf[9])shl 8)or ord(Buf[10])+(ord(Buf[11])shl 8)or ord(Buf[12]);           if j>0 then            begin             n:=13;             GetName(n);             n:=n+4;             for j:=1 to j do              begin               l:=0;               ADomain:=trim(GetName(n));               if (ADomain<>'')and((n+9)<SizeOf(Buf)) then                begin                 l:=(ord(Buf[n+8])shl 8)or ord(Buf[n+9]);                 if (n+10+l)<=SizeOf(Buf) then                  begin                   d:=Copy(Buf,n+10,l);                   while (Length(d)>0)and(d[1]=#0) do d:=Copy(d,3,l);                   if Length(d)>2 then                    begin                     d:=Copy(d,2,Ord(d[1]))+'.'+ADomain;                     ResMailServers.Add(d);                    end;                   end;                end;               n:=n+l+10;               if n>SizeOf(Buf) then Break;              end;            end;          end;         until (i=SOCKET_ERROR)or(i<Length(Buf));        if ResMailServers.Count>0 then         Result:=true;       end;      CloseSocket(Sock);     end;    WSACleanup;   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],'yandex.ru',5000,FMailServers) then     begin      smtp:=TIdSMTP.Create(nil);      mes:=TIdMessage.Create(nil);      smtp.Port := 25;      smtp.AuthenticationType:=atNone;      smtp.HeloName:='Info';      mes.From.Text:='VasaPupkin@nightmail.ru';      mes.Sender.Text:='VasaPupkin@nightmail.ru';      mes.Recipients.EMailAddresses:='XXX@yandex.ru'; //Получатель      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. Удачи.

Автор: WolfON 1.5.2005, 17:17

Girder Как-то по левому получаеться, те если мне надо будет послать мыла, допустим, в начале на inbox, потом на gamil, а потом на hotmail, то получаеться, для них всех прийдеться запрашивать GetMailServers???? Код к стати рабочий

Автор: Logan 15.10.2005, 13:44

А можно ли к этому коду прикрутить ProgressBar Если можно то напишите пример как энто сделать Спасибо

Автор: splash666 30.12.2005, 14:27

Тут проскакивало, что в Indy можно отправлять через прокси. Как?? Можно пример??

Автор: Snowy 30.12.2005, 14:52

http://forum.vingrad.ru/index.php?showtopic=50670 http://forum.sources.ru/index.php?showtopic=85371&view=showall

Автор: ConstantinXXX 11.8.2006, 17:44

если не трудно подскажите откда взять TIdAntiFreeze; - Delphi 7 чет ненашол.

Автор: Yanis 11.8.2006, 17:57

ConstantinXXX Просто они не подключены  http://forum.vingrad.ru/index.php?showtopic=21501&hl=

Автор: ConstantinXXX 11.8.2006, 19:14

Yanis, спасибо за то, что дал ссылку на еще однуссылку котораяведет еще надругую ссылку. А поконкретний можно. ------------------- Как подключить их. -------- Зарание спасибо.

Автор: drkot 11.8.2006, 19:25

ConstantinXXX, а вам не кажется что это вопрос который можно и нужно решать самостоятельно. И гневных  Цитата(ConstantinXXX @  11.8.2006,  19:14 ) спасибо писать не обязательно. Большинство здесь заняты своей работой и писать для тебя код врядли будут.

Автор: Snowy 11.8.2006, 19:30

На закладке Indy Misc посмотри. Второй значёк.

Автор: ConstantinXXX 11.8.2006, 19:49

Snowy, вот за ето спасибо. Сразу нашол

Автор: Lence 2.9.2006, 10:11

Girder  получается в этом куске Код  if GetMailServers(IPHostDNS.Strings[IPHostDNS.Count-1],'yandex.ru',5000,FMailServers) then постоянно проверять DNS ???  или как ??? я чтото не совсем понял это както автоматом можно сделать ? например я отправил человеку на hotmail.com а второму на gmail.com - причем у gmail.com SSL включен ....   или брать мыло которое по списку отрезать то что собаки ... проверять на DNS и потом отправлять ?

Автор: Lence 3.9.2006, 00:29

Girder Я кое что добвил в тою процедуру, но только не знаю работает или нет ....  Добавил работу через Socks5  у меня локально носок не поднят 127,0,0,1  но все равно почему то пришло ... хотелось бы твой пример пустить через Socks ... правильно ли я дописал ?  Проверьте кто сможет, у кого есть поднятый Socks ???? Очень нужно....  и еще вопрос  Цитата if GetMailServers(IPHostDNS.Strings[IPHostDNS.Count-1],'yandex.ru',5000,FMailServers) then кажды раз надо надо добавлять Доменное имя ??? или можно автоматом определить от концовки ящика ? или всетаки приется брать ящик - вырезать все что после собаки - и потом подставлять ?  вот собственно пример.... все таже функция которая была написана вышел, только в процедуре добавлен сокс ....  Код procedure TForm1.Button1Click(Sender: TObject); var FMailServers,IPHostDNS:TStrings;     smtp:TIdSMTP;     mes:TIdMessage;     i:integer;     FI:PFIXED_INFO;     S:DWord;     n:PIP_ADDR_STRING;     socksInfo:TIdSocksInfo;     Socket: TIdIOHandlerSocket; 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],'yandex.ru',5000,FMailServers) then     begin      smtp:=TIdSMTP.Create(nil);      mes:=TIdMessage.Create(nil);      socksinfo := TIdSocksInfo.Create(nil);      Socket:= TIdIOHandlerSocket.Create(nil);      smtp.IOHandler:= Socket;      Socket.SocksInfo:= socksinfo;      SocksInfo.Host:='127.0.0.1';      SocksInfo.Version:= svSocks5;      SocksInfo.Port:= 1080;      smtp.Port := 25;      smtp.AuthenticationType:=atNone;      smtp.HeloName:='Info';      mes.From.Text:='me@gmail.com';      mes.Sender.Text:='me@gmail.com';      mes.Recipients.EMailAddresses:='me@yandex.ru'; //Ïîëó÷àòåëü      mes.Subject:='Ot Medveda';      mes.Body.Text:='Preved Medved';      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;         showmessage ('Send!!!');         break;        except on E:Exception do      begin       showmessage ('Error: ' + E.Message);       exit;       end;       end;        smtp.Disconnect;       end;      mes.Free;      smtp.Free;      SocksInfo.Free;      Socket.Free;     end;    if IPHostDNS.Count>0 then IPHostDNS.Delete(IPHostDNS.Count-1);   end;  try   IPHostDNS.Free;   FMailServers.Free;  except  end; end; end.

Автор: Ptica_Oz 6.4.2007, 09:15

ну не работает у мнеяяяя    а если серьёзно дела обстоят следующим образом: есть код Код     IdSMTP.Host := 'smtp.mail.ru';     //IdSMTP.Host := 'relay.ascon.ru';     Result := true;     IdMessage.CharSet := 'WINDOWS-1251';     IdMessage.Encoding := meMIME;     IdMessage.ContentType := 'text/plain';     IdMessage.ContentTransferEncoding := '8bit';     //IdMessage.Subject :='';  //текст темы сообщения     IdMessage.Recipients.EMailAddresses := pEMail; //указываем адрес получателя     IdMessage.From.Address := strCurrentEMail; //указываем автора письма     IdMessage.From.Name := strName ;     IdMessage.Body.Text := pText;   //размещаем текст сообщения     IdMessage.ReplyTo.EMailAddresses := strCurrentEMail;     //IdMessage.Date:=StrToDate('01.12.2004');  //дата отправки письма, может быть любой     try       IdSMTP.Connect;       try         IdSMTP.Send(IdMessage);       except on E:Exception do begin         // если соединение не прошло из-за необходимости авторизации         // вызываем диалог авторизации пробуем ещё раз подсоединиться         frmAuthForm := TfrmAuth.Create(Application);         frmAuthForm.ShowModal;         IdSMTP.Username := frmAuthForm.pEMail;         IdSMTP.Password := frmAuthForm.pPassword;         frmAuthForm.Free;         try           IdSMTP.Send(IdMessage);         except on E:Exception do begin           if MessageBox(0 ,'Письмо не было отправлено.'                         + #13 + #10                         + 'Сохранить вопрос в базе?',                         'Внимание!', MB_YESNO) = IDYES then Result := true           else Result := false;         end;         end;       end;       end;     except on E:Exception do begin       strError := E.Message;       ShowMessage(strError);       if MessageBox(0 ,'Письмо не было отправлено.'                         + #13 + #10                         + 'Сохранить вопрос в базе?',                         'Внимание!', MB_YESNO) = IDYES then Result := true       else Result := false;     end;     end;     if frmSetForm.IdSMTP.Connected then begin       frmSetForm.IdSMTP.Disconnect;       //ShowMessage('Соединение разорвано!');     end; в тот прекрасный день когда я написала этот код всё работало. происходило подключение, при отправке производилась авторизация при помощи диалогового окна, и письмо отправлялось и даже доходило и даже с нормальной кодировкой. но тот прекрасный день закончился и пришел пипец... на форме, как вы наверное уже догадались из Indy 10 только два компанента: IdSMTP и IdMessage. при попытке подконектица говорит "Connection Closed Gracefully". в свойстве компанента IdSMTP AuthType пробовала устанавливать разные значения, не помогло. пробовала при подключении сразу (в свойствах) задавать Username и Password, та же ерунда... я не могу со 100% знать каким SMTP сервером будет пользоваться конечный пользователь... Delphi Studio 2006 читала код в постах, ничего принципиального не обнаружила, хотя может и ошибаюсь, ткните носом...

Автор: Ptica_Oz 6.4.2007, 09:50

шайтан-бабай... в офисе некоторое время не было инета, ща появился. пробую ещё раз прогнать прогу, ничего не меняя. подключение происходит! =О при первой отправке сообщения отлавливается исключение и возникает форма авторизации. в общем все по коду. но при повторной отправке выдает следующее: Project raised exception class EIdSMTPReplyError with massege ''. ну и естественно ничего никуда не посылает... :(

Автор: drkot 6.4.2007, 11:07

версия инди какая? если 10 до выкинь и поставь 9.

Автор: Ptica_Oz 6.4.2007, 11:13

Цитата(drkot @  6.4.2007,  11:07 ) версия инди какая?если 10 до выкинь и поставь 9. приму к сведенью, но хотелось бы менее радикальные методы решения этой проблемы... если такие найдутся...

Автор: Ptica_Oz 9.4.2007, 10:05

вопрос снят. просто надо было внимательнее смотреть откуда посылаю (адрес был не mail-овский)

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)