DNSMX.pas

   1 {
   2    Copyright (C) 2010-2014 MegaBrutal
   3
   4    This unit is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU Lesser General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This unit is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU Lesser General Public License for more details.
  13
  14    You should have received a copy of the GNU Lesser General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16 }
  17
  18
  19 {$MODE DELPHI}
  20 unit DNSMX;
  21
  22 (*
  23
  24    For reference, here are the C declarations of the used
  25    functions and structures:
  26
  27    DNS_STATUS WINAPI DnsQuery(
  28      __in         PCTSTR lpstrName,
  29      __in         WORD wType,
  30      __in         DWORD Options,
  31      __inout_opt  PVOID pExtra,
  32      __out_opt    PDNS_RECORD *ppQueryResultsSet,
  33      __out_opt    PVOID *pReserved
  34    );
  35
  36    void WINAPI DnsRecordListFree(
  37      __inout_opt  PDNS_RECORD pRecordList,
  38      __in         DNS_FREE_TYPE FreeType
  39    );
  40
  41    typedef struct _DnsRecord {
  42      DNS_RECORD *pNext;
  43      PWSTR      pName;
  44      WORD       wType;
  45      WORD       wDataLength;
  46      union {
  47        DWORD            DW;
  48        DNS_RECORD_FLAGS S;
  49      } Flags;
  50      DWORD      dwTtl;
  51      DWORD      dwReserved;
  52      union {
  53        DNS_MX_DATA     MX, Mx, AFSDB, Afsdb, RT, Rt;
  54      } Data;
  55    } DNS_RECORD, *PDNS_RECORD;
  56
  57    typedef struct {
  58      PWSTR pNameExchange;
  59      WORD  wPreference;
  60      WORD  Pad;
  61    } DNS_MX_DATA, *PDNS_MX_DATA;
  62
  63 *)
  64
  65 interface
  66 uses SysUtils, Classes;
  67
  68 const
  69
  70    DNS_TYPE_MX = $000F;
  71
  72 type
  73
  74    pWideChar = pChar;
  75
  76    DnsMXData = packed record
  77       pNameExchange: pWideChar;
  78       wPreference: word;
  79       Pad: word;
  80    end;
  81
  82    ppDnsRecord = ^pDnsRecord;
  83    pDnsRecord = ^DnsRecord;
  84    DnsRecord = packed record
  85       pNext: pDnsRecord;
  86       pName: pWideChar;
  87       wType: word;
  88       wDataLength: word;
  89       Flags: longword;
  90       dwTtl: longword;
  91       dwReserved: longword;
  92       Data: DnsMXData;
  93    end;
  94
  95    { Better to have a Pascal-format DnsMXData: }
  96    TDNSMXRecord = record
  97       Preference: word;
  98       HostName: string;
  99    end;
 100
 101    TDNSMXRecordArray = array of TDNSMXRecord;
 102
 103
 104    function DnsQuery(lsstrName: PChar; wType: word; Options: longword;
 105       pExtra: pointer; ppQueryResultsSet: ppDnsRecord; pReserved: pointer): longword; stdcall;
 106       external 'dnsapi.dll' name 'DnsQuery_A';
 107
 108    procedure DnsRecordListFree(pRecordList: pDnsRecord; FreeType: word); stdcall;
 109       external 'dnsapi.dll' name 'DnsRecordListFree';
 110
 111
 112    function GetMXRecordArray(HostName: string; var ResultArray: TDNSMXRecordArray): boolean;
 113    procedure SortMXRecordArray(var DNSMXRecordArray: TDNSMXRecordArray);
 114    function MakeMXRecordList(const DNSMXRecordArray: TDNSMXRecordArray): TStrings;
 115    function GetCorrectMXRecordList(HostName: string): TStrings;
 116
 117
 118
 119 implementation
 120
 121
 122 function GetMXRecordArray(HostName: string; var ResultArray: TDNSMXRecordArray): boolean;
 123 var P, N: pDnsRecord; DNSMXRecord: TDNSMXRecord; ap: integer;
 124 begin
 125    P:= nil;
 126    DnsQuery(PChar(HostName), DNS_TYPE_MX, 0, nil, @P, nil);
 127    N:= P;
 128    while N <> nil do begin
 129       if N^.wType = DNS_TYPE_MX then begin
 130          DNSMXRecord.Preference:= N^.Data.wPreference;
 131          DNSMXRecord.HostName:= N^.Data.pNameExchange;
 132          ap:= Length(ResultArray);
 133          SetLength(ResultArray, ap + 1);
 134          ResultArray[ap]:= DNSMXRecord;
 135       end;
 136       N:= N^.pNext;
 137    end;
 138    if P <> nil then DnsRecordListFree(P, 0);
 139    Result:= Length(ResultArray) <> 0;
 140 end;
 141
 142 procedure SortMXRecordArray(var DNSMXRecordArray: TDNSMXRecordArray);
 143 var i, j: integer; T: TDNSMXRecord;
 144 begin
 145    for i:= 1 to Length(DNSMXRecordArray) - 1 do begin
 146       T:= DNSMXRecordArray[i];
 147       j:= i;
 148       while (j > 0) and (DNSMXRecordArray[j-1].Preference > T.Preference) do begin
 149          DNSMXRecordArray[j]:= DNSMXRecordArray[j-1];
 150          Dec(j);
 151       end;
 152       DNSMXRecordArray[j]:= T;
 153    end;
 154 end;
 155
 156 function MakeMXRecordList(const DNSMXRecordArray: TDNSMXRecordArray): TStrings;
 157 var i: integer;
 158 begin
 159    Result:= TStringList.Create;
 160    for i:= 0 to Length(DNSMXRecordArray) - 1 do
 161       Result.Add(DNSMXRecordArray[i].HostName);
 162 end;
 163
 164 function GetCorrectMXRecordList(HostName: string): TStrings;
 165 var DNSMXRecordArray: TDNSMXRecordArray;
 166 begin
 167    SetLength(DNSMXRecordArray, 0);
 168    if GetMXRecordArray(HostName, DNSMXRecordArray) then begin
 169       SortMXRecordArray(DNSMXRecordArray);
 170       Result:= MakeMXRecordList(DNSMXRecordArray);
 171    end
 172    else begin
 173       { If the domain has no MX record, the A record shall be used. }
 174       Result:= TStringList.Create;
 175       Result.Add(HostName);
 176    end;
 177 end;
 178
 179
 180 end.