Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2003.08.21;
Скачать: [xml.tar.bz2];

Вниз

MX record look-up   Найти похожие ветки 

 
Иван   (2003-06-17 11:16) [0]

Народ, если есть у кого реализованный MX look-up, поделитесь, плиз. Шибко приперло, в инете поискал, кроме ICS (by F.Piette) компонент нифига не нашел. Тянуть их с собой нехочется.

Спасибо.


 
Andrey Klimov   (2003-06-17 19:12) [1]

Indy 9.0.13

function TfrmMain.GetMailServers: Boolean;
var
i,x : integer;
LDomainPart : String;
LMXRecord : TMXRecord;
begin
if not assigned(fmailServers) then fMailServers := TStringList.Create;
fmailServers.clear;

Result := true;
with IdDNSResolver do
begin
QueryResult.Clear;
QueryRecords := [qtMX];
//Msg("Setting up DNS query parameters");
Host := edtDNS.text; //Адрес твоего DNS сервера
ReceiveTimeout := StrToInt(edtTimeOut.text);
// Extract the domain part from recipient email address
LDomainPart := copy(edtRecipient.text,pos("@",edtRecipient.text)+1,length(edtRecipient.text)); // the domain name to resolve

try
//Msg("Resolving DNS");
Resolve(LDomainPart);

if QueryResult.Count > 0 then
begin
for i := 0 to QueryResult.Count - 1 do
begin
LMXRecord := TMXRecord(QueryResult.Items[i]);
fMailServers.Append(PadZero(IntToStr(LMXRecord.Preference)) + "=" + LMXRecord.ExchangeServer);
end;

// sort in order of priority and then remove extra data
fMailServers.Sorted := false;
for i := 0 to fMailServers.count - 1 do
begin
x := pos("=",fMailServers.Strings[i]);
if x > 0 then fMailServers.Strings[i] :=
copy(fMailServers.Strings[i],x+1,length(fMailServers.Strings[i]));
end;
fMailServers.Sorted := true;
fMailServers.Duplicates := dupIgnore;
Result := true;
end
else
begin
//Msg("No response from DNS server");
MessageDlg("There is no response from the DNS server !", mtInformation, [mbOK], 0);
Result := false;
end;
except
on E : Exception do
begin
//Msg("Error resolving domain");
( "Error resolving domain: " + e.message, mtInformation, [mbOK], 0) Indy 9.0.13

function TfrmMain.GetMailServers: Boolean;
var
i,x : integer;
LDomainPart : String;
LMXRecord : TMXRecord;
begin
if not assigned(fmailServers) then fMailServers := TStringList.Create;
fmailServers.clear;

Result := true;
with IdDNSResolver do
begin
QueryResult.Clear;
QueryRecords := [qtMX];
//Msg("Setting up DNS query parameters");
Host := edtDNS.text; //Адрес твоего DNS сервера
ReceiveTimeout := StrToInt(edtTimeOut.text);
// Extract the domain part from recipient email address
LDomainPart := copy(edtRecipient.text,pos("@",edtRecipient.text)+1,length(edtRecipient.text)); // the domain name to resolve

try
//Msg("Resolving DNS");
Resolve(LDomainPart);

if QueryResult.Count > 0 then
begin
for i := 0 to QueryResult.Count - 1 do
begin
LMXRecord := TMXRecord(QueryResult.Items[i]);
fMailServers.Append(PadZero(IntToStr(LMXRecord.Preference)) + "=" + LMXRecord.ExchangeServer);
end;

// sort in order of priority and then remove extra data
fMailServers.Sorted := false;
for i := 0 to fMailServers.count - 1 do
begin
x := pos("=",fMailServers.Strings[i]);
if x > 0 then fMailServers.Strings[i] :=
copy(fMailServers.Strings[i],x+1,length(fMailServers.Strings[i]));
end;
fMailServers.Sorted := true;
fMailServers.Duplicates := dupIgnore;
Result := true;
end
else
begin
//Msg("No response from DNS server");
MessageDlg("There is no response from the DNS server !", mtInformation, [mbOK], 0);
Result := false;
end;
except
on E : Exception do
begin
//Msg("Error resolving domain");
MessageDlg("Error resolving domain: " + e.message, mtInformation, [mbOK], 0);
Result := false;
end;
end;

end;
end;



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2003.08.21;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.008 c
3-68165
s_ser
2003-07-28 19:50
2003.08.21
Забрать данные из BLOB поля


1-68257
kull
2003-08-06 10:04
2003.08.21
Работа с интерфейсами...


14-68522
Дмитрий_Б
2003-08-05 13:33
2003.08.21
Установка w2k


3-68194
Magic&Wizard
2003-07-28 11:58
2003.08.21
API InterBase и FireBird


1-68402
Oleg
2003-08-06 18:39
2003.08.21
Разделитель целой и дробной части





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский