VPF::с модулем проблемы - Форум программистов

sssddd

Дата 28.3.2006, 22:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 28.3.2006

Репутация: нет
Всего: нет

пивет всем....
Girder ты как то выложил тут такой модуль

Код


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.

вот только у меня проблема почему то выскакивает
Project1.exe raised exception class EIDprotoolReplyErrorr with message 'Access from ip address 195.218.132.231 blocked.Visit http://wim.mail.ru/cgi-bin/support_bl?ip=195.218.132.231 Помогит пожалуйста никак не пойму в чем проблема(
Добавлено @ 22:46
только не говоричтоя в черном списке я там могу все чтозахочу делать)))и регистрировать почту и тд....
я не остановился на этом и пошел на рамлблер и там мне выдало все тоже самое тольоко после message было Must be local recipient ....
Так в чем проблема я так ине пойму((((

Демо

Дата 29.3.2006, 00:57 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 3
Всего: 50

Цитата(sssddd @ 28.3.2006, 22:38

)

только не говоричтоя в черном списке я там могу все чтозахочу делать)))и регистрировать почту и тд....

Регистрировать можешь. А вот SMTP не можешь использовать, так как в черном списке как спамер или зомби.

Цитата(sssddd @ 28.3.2006, 22:38

)

я не остановился на этом и пошел на рамлблер и там мне выдало все тоже самое тольоко после message было Must be local recipient ....

То же самое. И на Рамблере забанен.

На РОЛе вообще рассадник вирусов и спама.

--------------------

sssddd

Дата 30.3.2006, 22:02 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 28.3.2006

Репутация: нет
Всего: нет

т.е как я понял если я сижу на Роле я никак не смогу воспользоваться smtp....чем ж тогда рол лучше мту или там комстара...ели рол рассдник вирусов и спама то мту вообще плантации....т.е что получаеться ктосидит на модеме тот не может пользоваться SMTP...?не думаю....может что то в самой программе ошибка?

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »