mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-24 00:08:52 -05:00
604 lines
19 KiB
ObjectPascal
604 lines
19 KiB
ObjectPascal
{==============================================================================|
|
|
| Project : Ararat Synapse | 002.007.006 |
|
|
|==============================================================================|
|
|
| Content: DNS client |
|
|
|==============================================================================|
|
|
| Copyright (c)1999-2010, Lukas Gebauer |
|
|
| All rights reserved. |
|
|
| |
|
|
| Redistribution and use in source and binary forms, with or without |
|
|
| modification, are permitted provided that the following conditions are met: |
|
|
| |
|
|
| Redistributions of source code must retain the above copyright notice, this |
|
|
| list of conditions and the following disclaimer. |
|
|
| |
|
|
| Redistributions in binary form must reproduce the above copyright notice, |
|
|
| this list of conditions and the following disclaimer in the documentation |
|
|
| and/or other materials provided with the distribution. |
|
|
| |
|
|
| Neither the name of Lukas Gebauer nor the names of its contributors may |
|
|
| be used to endorse or promote products derived from this software without |
|
|
| specific prior written permission. |
|
|
| |
|
|
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
|
|
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
|
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
|
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
|
|
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
|
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
|
|
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
|
|
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
|
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
|
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
|
|
| DAMAGE. |
|
|
|==============================================================================|
|
|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
|
| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
|
|
| All Rights Reserved. |
|
|
|==============================================================================|
|
|
| Contributor(s): |
|
|
|==============================================================================|
|
|
| History: see HISTORY.HTM from distribution package |
|
|
| (Found at URL: http://www.ararat.cz/synapse/) |
|
|
|==============================================================================}
|
|
{: @abstract(DNS client by UDP or TCP)
|
|
Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone
|
|
transfers too!
|
|
|
|
Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
|
|
}
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE DELPHI}
|
|
{$ENDIF}
|
|
{$Q-}
|
|
{$H+}
|
|
|
|
{$IFDEF UNICODE}
|
|
{$WARN IMPLICIT_STRING_CAST OFF}
|
|
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
|
|
{$ENDIF}
|
|
|
|
unit dnssend;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes,
|
|
blcksock, synautil, synaip, synsock;
|
|
|
|
const
|
|
cDnsProtocol = '53';
|
|
|
|
QTYPE_A = 1;
|
|
QTYPE_NS = 2;
|
|
QTYPE_MD = 3;
|
|
QTYPE_MF = 4;
|
|
QTYPE_CNAME = 5;
|
|
QTYPE_SOA = 6;
|
|
QTYPE_MB = 7;
|
|
QTYPE_MG = 8;
|
|
QTYPE_MR = 9;
|
|
QTYPE_NULL = 10;
|
|
QTYPE_WKS = 11; //
|
|
QTYPE_PTR = 12;
|
|
QTYPE_HINFO = 13;
|
|
QTYPE_MINFO = 14;
|
|
QTYPE_MX = 15;
|
|
QTYPE_TXT = 16;
|
|
|
|
QTYPE_RP = 17;
|
|
QTYPE_AFSDB = 18;
|
|
QTYPE_X25 = 19;
|
|
QTYPE_ISDN = 20;
|
|
QTYPE_RT = 21;
|
|
QTYPE_NSAP = 22;
|
|
QTYPE_NSAPPTR = 23;
|
|
QTYPE_SIG = 24; // RFC-2065
|
|
QTYPE_KEY = 25; // RFC-2065
|
|
QTYPE_PX = 26;
|
|
QTYPE_GPOS = 27;
|
|
QTYPE_AAAA = 28;
|
|
QTYPE_LOC = 29; // RFC-1876
|
|
QTYPE_NXT = 30; // RFC-2065
|
|
|
|
QTYPE_SRV = 33;
|
|
QTYPE_NAPTR = 35; // RFC-2168
|
|
QTYPE_KX = 36;
|
|
QTYPE_SPF = 99;
|
|
|
|
QTYPE_AXFR = 252;
|
|
QTYPE_MAILB = 253; //
|
|
QTYPE_MAILA = 254; //
|
|
QTYPE_ALL = 255;
|
|
|
|
type
|
|
{:@abstract(Implementation of DNS protocol by UDP or TCP protocol.)
|
|
|
|
Note: Are you missing properties for specify server address and port? Look to
|
|
parent @link(TSynaClient) too!}
|
|
TDNSSend = class(TSynaClient)
|
|
private
|
|
FID: Word;
|
|
FRCode: Integer;
|
|
FBuffer: AnsiString;
|
|
FSock: TUDPBlockSocket;
|
|
FTCPSock: TTCPBlockSocket;
|
|
FUseTCP: Boolean;
|
|
FAnswerInfo: TStringList;
|
|
FNameserverInfo: TStringList;
|
|
FAdditionalInfo: TStringList;
|
|
FAuthoritative: Boolean;
|
|
FTruncated: Boolean;
|
|
function CompressName(const Value: AnsiString): AnsiString;
|
|
function CodeHeader: AnsiString;
|
|
function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
|
|
function DecodeLabels(var From: Integer): AnsiString;
|
|
function DecodeString(var From: Integer): AnsiString;
|
|
function DecodeResource(var i: Integer; const Info: TStringList;
|
|
QType: Integer): AnsiString;
|
|
function RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
|
|
function DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
|
|
QType: Integer):boolean;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
{:Query a DNSHost for QType resources correspond to a name. Supported QType
|
|
values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA,
|
|
Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO,
|
|
Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25,
|
|
Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS,
|
|
Qtype_KX.
|
|
|
|
Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode!
|
|
|
|
"Name" is domain name or host name for queried resource. If "name" is
|
|
IP address, automatically convert to reverse domain form (.in-addr.arpa).
|
|
|
|
If result is @true, Reply contains resource records. One record on one line.
|
|
If Resource record have multiple fields, they are stored on line divided by
|
|
comma. (example: MX record contains value 'rs.cesnet.cz' with preference
|
|
number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address
|
|
in resource are converted to string form.}
|
|
function DNSQuery(Name: AnsiString; QType: Integer;
|
|
const Reply: TStrings): Boolean;
|
|
published
|
|
|
|
{:Socket object used for UDP operation. Good for seting OnStatus hook, etc.}
|
|
property Sock: TUDPBlockSocket read FSock;
|
|
|
|
{:Socket object used for TCP operation. Good for seting OnStatus hook, etc.}
|
|
property TCPSock: TTCPBlockSocket read FTCPSock;
|
|
|
|
{:if @true, then is used TCP protocol instead UDP. It is needed for zone
|
|
transfers, etc.}
|
|
property UseTCP: Boolean read FUseTCP Write FUseTCP;
|
|
|
|
{:After DNS operation contains ResultCode of DNS operation.
|
|
Values are: 0-no error, 1-format error, 2-server failure, 3-name error,
|
|
4-not implemented, 5-refused.}
|
|
property RCode: Integer read FRCode;
|
|
|
|
{:@True, if answer is authoritative.}
|
|
property Authoritative: Boolean read FAuthoritative;
|
|
|
|
{:@True, if answer is truncated to 512 bytes.}
|
|
property Truncated: Boolean read FTRuncated;
|
|
|
|
{:Detailed informations from name server reply. One record per line. Record
|
|
have comma delimited entries with type number, TTL and data filelds.
|
|
This information contains detailed information about query reply.}
|
|
property AnswerInfo: TStringList read FAnswerInfo;
|
|
|
|
{:Detailed informations from name server reply. One record per line. Record
|
|
have comma delimited entries with type number, TTL and data filelds.
|
|
This information contains detailed information about nameserver.}
|
|
property NameserverInfo: TStringList read FNameserverInfo;
|
|
|
|
{:Detailed informations from name server reply. One record per line. Record
|
|
have comma delimited entries with type number, TTL and data filelds.
|
|
This information contains detailed additional information.}
|
|
property AdditionalInfo: TStringList read FAdditionalInfo;
|
|
end;
|
|
|
|
{:A very useful function, and example of it's use is found in the TDNSSend object.
|
|
This function is used to get mail servers for a domain and sort them by
|
|
preference numbers. "Servers" contains only the domain names of the mail
|
|
servers in the right order (without preference number!). The first domain name
|
|
will always be the highest preferenced mail server. Returns boolean @TRUE if
|
|
all went well.}
|
|
function GetMailServers(const DNSHost, Domain: AnsiString;
|
|
const Servers: TStrings): Boolean;
|
|
|
|
implementation
|
|
|
|
constructor TDNSSend.Create;
|
|
begin
|
|
inherited Create;
|
|
FSock := TUDPBlockSocket.Create;
|
|
FSock.Owner := self;
|
|
FTCPSock := TTCPBlockSocket.Create;
|
|
FTCPSock.Owner := self;
|
|
FUseTCP := False;
|
|
FTimeout := 10000;
|
|
FTargetPort := cDnsProtocol;
|
|
FAnswerInfo := TStringList.Create;
|
|
FNameserverInfo := TStringList.Create;
|
|
FAdditionalInfo := TStringList.Create;
|
|
Randomize;
|
|
end;
|
|
|
|
destructor TDNSSend.Destroy;
|
|
begin
|
|
FAnswerInfo.Free;
|
|
FNameserverInfo.Free;
|
|
FAdditionalInfo.Free;
|
|
FTCPSock.Free;
|
|
FSock.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDNSSend.CompressName(const Value: AnsiString): AnsiString;
|
|
var
|
|
n: Integer;
|
|
s: AnsiString;
|
|
begin
|
|
Result := '';
|
|
if Value = '' then
|
|
Result := #0
|
|
else
|
|
begin
|
|
s := '';
|
|
for n := 1 to Length(Value) do
|
|
if Value[n] = '.' then
|
|
begin
|
|
Result := Result + AnsiChar(Length(s)) + s;
|
|
s := '';
|
|
end
|
|
else
|
|
s := s + Value[n];
|
|
if s <> '' then
|
|
Result := Result + AnsiChar(Length(s)) + s;
|
|
Result := Result + #0;
|
|
end;
|
|
end;
|
|
|
|
function TDNSSend.CodeHeader: AnsiString;
|
|
begin
|
|
FID := Random(32767);
|
|
Result := CodeInt(FID); // ID
|
|
Result := Result + CodeInt($0100); // flags
|
|
Result := Result + CodeInt(1); // QDCount
|
|
Result := Result + CodeInt(0); // ANCount
|
|
Result := Result + CodeInt(0); // NSCount
|
|
Result := Result + CodeInt(0); // ARCount
|
|
end;
|
|
|
|
function TDNSSend.CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
|
|
begin
|
|
Result := CompressName(Name);
|
|
Result := Result + CodeInt(QType);
|
|
Result := Result + CodeInt(1); // Type INTERNET
|
|
end;
|
|
|
|
function TDNSSend.DecodeString(var From: Integer): AnsiString;
|
|
var
|
|
Len: integer;
|
|
begin
|
|
Len := Ord(FBuffer[From]);
|
|
Inc(From);
|
|
Result := Copy(FBuffer, From, Len);
|
|
Inc(From, Len);
|
|
end;
|
|
|
|
function TDNSSend.DecodeLabels(var From: Integer): AnsiString;
|
|
var
|
|
l, f: Integer;
|
|
begin
|
|
Result := '';
|
|
while True do
|
|
begin
|
|
if From >= Length(FBuffer) then
|
|
Break;
|
|
l := Ord(FBuffer[From]);
|
|
Inc(From);
|
|
if l = 0 then
|
|
Break;
|
|
if Result <> '' then
|
|
Result := Result + '.';
|
|
if (l and $C0) = $C0 then
|
|
begin
|
|
f := l and $3F;
|
|
f := f * 256 + Ord(FBuffer[From]) + 1;
|
|
Inc(From);
|
|
Result := Result + DecodeLabels(f);
|
|
Break;
|
|
end
|
|
else
|
|
begin
|
|
Result := Result + Copy(FBuffer, From, l);
|
|
Inc(From, l);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDNSSend.DecodeResource(var i: Integer; const Info: TStringList;
|
|
QType: Integer): AnsiString;
|
|
var
|
|
Rname: AnsiString;
|
|
RType, Len, j, x, y, z, n: Integer;
|
|
R: AnsiString;
|
|
t1, t2, ttl: integer;
|
|
ip6: TIp6bytes;
|
|
begin
|
|
Result := '';
|
|
R := '';
|
|
Rname := DecodeLabels(i);
|
|
RType := DecodeInt(FBuffer, i);
|
|
Inc(i, 4);
|
|
t1 := DecodeInt(FBuffer, i);
|
|
Inc(i, 2);
|
|
t2 := DecodeInt(FBuffer, i);
|
|
Inc(i, 2);
|
|
ttl := t1 * 65536 + t2;
|
|
Len := DecodeInt(FBuffer, i);
|
|
Inc(i, 2); // i point to begin of data
|
|
j := i;
|
|
i := i + len; // i point to next record
|
|
if Length(FBuffer) >= (i - 1) then
|
|
case RType of
|
|
QTYPE_A:
|
|
begin
|
|
R := IntToStr(Ord(FBuffer[j]));
|
|
Inc(j);
|
|
R := R + '.' + IntToStr(Ord(FBuffer[j]));
|
|
Inc(j);
|
|
R := R + '.' + IntToStr(Ord(FBuffer[j]));
|
|
Inc(j);
|
|
R := R + '.' + IntToStr(Ord(FBuffer[j]));
|
|
end;
|
|
QTYPE_AAAA:
|
|
begin
|
|
for n := 0 to 15 do
|
|
ip6[n] := ord(FBuffer[j + n]);
|
|
R := IP6ToStr(ip6);
|
|
end;
|
|
QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
|
|
QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
|
|
QTYPE_NSAPPTR:
|
|
R := DecodeLabels(j);
|
|
QTYPE_SOA:
|
|
begin
|
|
R := DecodeLabels(j);
|
|
R := R + ',' + DecodeLabels(j);
|
|
for n := 1 to 5 do
|
|
begin
|
|
x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2);
|
|
Inc(j, 4);
|
|
R := R + ',' + IntToStr(x);
|
|
end;
|
|
end;
|
|
QTYPE_NULL:
|
|
begin
|
|
end;
|
|
QTYPE_WKS:
|
|
begin
|
|
end;
|
|
QTYPE_HINFO:
|
|
begin
|
|
R := DecodeString(j);
|
|
R := R + ',' + DecodeString(j);
|
|
end;
|
|
QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN:
|
|
begin
|
|
R := DecodeLabels(j);
|
|
R := R + ',' + DecodeLabels(j);
|
|
end;
|
|
QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX:
|
|
begin
|
|
x := DecodeInt(FBuffer, j);
|
|
Inc(j, 2);
|
|
R := IntToStr(x);
|
|
R := R + ',' + DecodeLabels(j);
|
|
end;
|
|
QTYPE_TXT, QTYPE_SPF:
|
|
begin
|
|
R := '';
|
|
while j < i do
|
|
R := R + DecodeString(j);
|
|
end;
|
|
QTYPE_GPOS:
|
|
begin
|
|
R := DecodeLabels(j);
|
|
R := R + ',' + DecodeLabels(j);
|
|
R := R + ',' + DecodeLabels(j);
|
|
end;
|
|
QTYPE_PX:
|
|
begin
|
|
x := DecodeInt(FBuffer, j);
|
|
Inc(j, 2);
|
|
R := IntToStr(x);
|
|
R := R + ',' + DecodeLabels(j);
|
|
R := R + ',' + DecodeLabels(j);
|
|
end;
|
|
QTYPE_SRV:
|
|
// Author: Dan <ml@mutox.org>
|
|
begin
|
|
x := DecodeInt(FBuffer, j);
|
|
Inc(j, 2);
|
|
y := DecodeInt(FBuffer, j);
|
|
Inc(j, 2);
|
|
z := DecodeInt(FBuffer, j);
|
|
Inc(j, 2);
|
|
R := IntToStr(x); // Priority
|
|
R := R + ',' + IntToStr(y); // Weight
|
|
R := R + ',' + IntToStr(z); // Port
|
|
R := R + ',' + DecodeLabels(j); // Server DNS Name
|
|
end;
|
|
end;
|
|
if R <> '' then
|
|
Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R);
|
|
if QType = RType then
|
|
Result := R;
|
|
end;
|
|
|
|
function TDNSSend.RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
|
|
var
|
|
l: integer;
|
|
begin
|
|
Result := '';
|
|
l := WorkSock.recvbyte(FTimeout) * 256 + WorkSock.recvbyte(FTimeout);
|
|
if l > 0 then
|
|
Result := WorkSock.RecvBufferStr(l, FTimeout);
|
|
end;
|
|
|
|
function TDNSSend.DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
|
|
QType: Integer):boolean;
|
|
var
|
|
n, i: Integer;
|
|
flag, qdcount, ancount, nscount, arcount: Integer;
|
|
s: AnsiString;
|
|
begin
|
|
Result := False;
|
|
Reply.Clear;
|
|
FAnswerInfo.Clear;
|
|
FNameserverInfo.Clear;
|
|
FAdditionalInfo.Clear;
|
|
FAuthoritative := False;
|
|
if (Length(Buf) > 13) and (FID = DecodeInt(Buf, 1)) then
|
|
begin
|
|
Result := True;
|
|
flag := DecodeInt(Buf, 3);
|
|
FRCode := Flag and $000F;
|
|
FAuthoritative := (Flag and $0400) > 0;
|
|
FTruncated := (Flag and $0200) > 0;
|
|
if FRCode = 0 then
|
|
begin
|
|
qdcount := DecodeInt(Buf, 5);
|
|
ancount := DecodeInt(Buf, 7);
|
|
nscount := DecodeInt(Buf, 9);
|
|
arcount := DecodeInt(Buf, 11);
|
|
i := 13; //begin of body
|
|
if (qdcount > 0) and (Length(Buf) > i) then //skip questions
|
|
for n := 1 to qdcount do
|
|
begin
|
|
while (Buf[i] <> #0) and ((Ord(Buf[i]) and $C0) <> $C0) do
|
|
Inc(i);
|
|
Inc(i, 5);
|
|
end;
|
|
if (ancount > 0) and (Length(Buf) > i) then // decode reply
|
|
for n := 1 to ancount do
|
|
begin
|
|
s := DecodeResource(i, FAnswerInfo, QType);
|
|
if s <> '' then
|
|
Reply.Add(s);
|
|
end;
|
|
if (nscount > 0) and (Length(Buf) > i) then // decode nameserver info
|
|
for n := 1 to nscount do
|
|
DecodeResource(i, FNameserverInfo, QType);
|
|
if (arcount > 0) and (Length(Buf) > i) then // decode additional info
|
|
for n := 1 to arcount do
|
|
DecodeResource(i, FAdditionalInfo, QType);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDNSSend.DNSQuery(Name: AnsiString; QType: Integer;
|
|
const Reply: TStrings): Boolean;
|
|
var
|
|
WorkSock: TBlockSocket;
|
|
t: TStringList;
|
|
b: boolean;
|
|
begin
|
|
Result := False;
|
|
if IsIP(Name) then
|
|
Name := ReverseIP(Name) + '.in-addr.arpa';
|
|
if IsIP6(Name) then
|
|
Name := ReverseIP6(Name) + '.ip6.arpa';
|
|
FBuffer := CodeHeader + CodeQuery(Name, QType);
|
|
if FUseTCP then
|
|
WorkSock := FTCPSock
|
|
else
|
|
WorkSock := FSock;
|
|
WorkSock.Bind(FIPInterface, cAnyPort);
|
|
WorkSock.Connect(FTargetHost, FTargetPort);
|
|
if FUseTCP then
|
|
FBuffer := Codeint(length(FBuffer)) + FBuffer;
|
|
WorkSock.SendString(FBuffer);
|
|
if FUseTCP then
|
|
FBuffer := RecvTCPResponse(WorkSock)
|
|
else
|
|
FBuffer := WorkSock.RecvPacket(FTimeout);
|
|
if FUseTCP and (QType = QTYPE_AXFR) then //zone transfer
|
|
begin
|
|
t := TStringList.Create;
|
|
try
|
|
repeat
|
|
b := DecodeResponse(FBuffer, Reply, QType);
|
|
if (t.Count > 1) and (AnswerInfo.Count > 0) then //find end of transfer
|
|
b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]);
|
|
if b then
|
|
begin
|
|
t.AddStrings(AnswerInfo);
|
|
FBuffer := RecvTCPResponse(WorkSock);
|
|
if FBuffer = '' then
|
|
Break;
|
|
if WorkSock.LastError <> 0 then
|
|
Break;
|
|
end;
|
|
until not b;
|
|
Reply.Assign(t);
|
|
Result := True;
|
|
finally
|
|
t.free;
|
|
end;
|
|
end
|
|
else //normal query
|
|
if WorkSock.LastError = 0 then
|
|
Result := DecodeResponse(FBuffer, Reply, QType);
|
|
end;
|
|
|
|
{==============================================================================}
|
|
|
|
function GetMailServers(const DNSHost, Domain: AnsiString;
|
|
const Servers: TStrings): Boolean;
|
|
var
|
|
DNS: TDNSSend;
|
|
t: TStringList;
|
|
n, m, x: Integer;
|
|
begin
|
|
Result := False;
|
|
Servers.Clear;
|
|
t := TStringList.Create;
|
|
DNS := TDNSSend.Create;
|
|
try
|
|
DNS.TargetHost := DNSHost;
|
|
if DNS.DNSQuery(Domain, QType_MX, t) then
|
|
begin
|
|
{ normalize preference number to 5 digits }
|
|
for n := 0 to t.Count - 1 do
|
|
begin
|
|
x := Pos(',', t[n]);
|
|
if x > 0 then
|
|
for m := 1 to 6 - x do
|
|
t[n] := '0' + t[n];
|
|
end;
|
|
{ sort server list }
|
|
t.Sorted := True;
|
|
{ result is sorted list without preference numbers }
|
|
for n := 0 to t.Count - 1 do
|
|
begin
|
|
x := Pos(',', t[n]);
|
|
Servers.Add(Copy(t[n], x + 1, Length(t[n]) - x));
|
|
end;
|
|
Result := True;
|
|
end;
|
|
finally
|
|
DNS.Free;
|
|
t.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|