dxdnsquery.pas

Well known and usefull component for delphi 7

unit DXDNSQuery;

interface

///////////////////////////////////////////////////////////////////////////////
// Component: TDXDNSQuery
//    Author: G.E. Ozz Nixon Jr. ([e-mail])
//            Federico "BackDream" Simonetti
// Copyright: All code is the property of Brain Patchwork DX (tm) and part of
//            the DXSock (r) product, which are (c) 1999 Brain Patchwork DX.
//   Version: 2.0 (2nd Generation Code)
// ==========================================================================
// Since this code has been designed to function on a server, and we want your
// products to excel because of cache techniques. All requestes are archived in
// a TList, redundant calls to a previously queried DNS server respond almost
// instantly. In your server you should call "FlushCache" once every couple of
// hours to make sure you are not reading old results. We allow you to control
// how often your ending application calls FlushCache.
//
// This component normally reads DNS entries from the registry, but if you want
// your code can use "AlternativeDNS" to override the DNS entries with your own
// list. For multiple DNS servers seperate with a space or comma, and you IP not
// domain! (grin).
///////////////////////////////////////////////////////////////////////////////

uses
   DXString,
   Classes;

{$I DXAddons.def}

const
   DX_Query_A=1; // Host Address
   DX_Query_NS=2; // Authoritative name server
   DX_Query_MD=3; // Mail Destination - USE MX!
   DX_Query_MF=4; // Mail Forwarder - USE MX!
   DX_Query_CNAME=5; // Cononical name for an alias
   DX_Query_SOA=6; // Start of Zone Authority
   DX_Query_MB=7; // Mailbox Domain Name
   DX_Query_MG=8; // Mailbox Member
   DX_Query_MR=9; // Mail rename domain
   DX_Query_NULL=10; // Null Resource Record
   DX_Query_WKS=11; // Well-known service
   DX_Query_PTR=12; // Domain name pointer
   DX_Query_HINFO=13; // Host Information (experimental)
   DX_Query_MINFO=14; // Mailbox/Mail-List Information
   DX_Query_MX=15; // Mail Exchange
   DX_Query_TXT=16; // Text Strings
   DX_Query_RP=17; // Responsible person (experimental)
   DX_Query_AFSDB=18; // Authority Format identifier-type server (experimental)
   DX_Query_X25=19; // X.25 Address, X.121 (experimental)
   DX_Query_ISDN=20; // ISDN Address, E.163/E.164 (experimental)
   DX_Query_RT=21; // Route through (experimental)
   DX_Query_OSINSAP=22;
      // OSI Network service access point address (experimental)
   DX_Query_NSAPPTR=23;
   DX_Query_SIG=24; //RFC-2065
   DX_Query_KEY=25; //RFC-2065
   DX_Query_PX=26;
   DX_Query_GPOS=27;
   DX_Query_AAAA=28; //IP6 Address                     [Susan Thomson]
   DX_Query_LOC=29; //RFC-1876
   DX_Query_NXT=30; //RFC-2065
   DX_Query_SRV=33; //RFC-2052
   DX_Query_NAPTR=35; //RFC-2168
   DX_Query_KX=36;
   DX_Query_AXFR=252; // Request an entire ZONE
   DX_Query_MAILB=253; // Request all mail relatest records (MB,MG,MR)
   DX_Query_MAILA=254; // Request all mail agents Resource Records - Use MX!
   DX_Query_ALL=255; // Request all records

type
   PDNSResultSet=^TDNSResultSet;
   TDNSResultSet=record
      Domain:string;
      DNSServer:string;
      QueryType:SmallInt;
      QueryClass:SmallInt;
      {$IFDEF VER90}
      Results:TMemoryStream;
      {$ELSE}
      Results:TStream;
      {$ENDIF}
   end;

   TDXDNSQuery=class(TDXComponent)
   private
      // Private declarations
      FDNSServers:TStrings;
      FQueryCache:TList;
      FUseUDP:Boolean;
      FAlternativeDNS:string;
      fQDCount:Integer;
      fANCount:Integer;
      fNSCount:Integer;
      fRRCount:Integer;
   protected
      // Protected declarations
      procedure SetFAlternativeDNS(value:string);
      procedure SetDNSServers(value:TStrings);
   public
      // Public declarations
      constructor Create(AOwner:TComponent); {$IFNDEF OBJECTS_ONLY}override;
         {$ENDIF}
      destructor Destroy; override;
      function Resolve(Domain:string; QueryType:Integer):string;
      procedure FlushCache;
      procedure FindDNSEntries(var DNSResultSet:PDNSResultSet);
      procedure LoadNameServers;
   published
      // Published declarations
      property UseUDP:Boolean read FUseUDP
         write FUseUDP;
      property AlternativeDNS:string read FAlternativeDNS
         write SetFAlternativeDNS;
      property QuestionCount:Integer read fQDCount;
      property AnswerCount:Integer read fANCount;
      property NameServerCount:Integer read fNSCount;
      property ResourceRecordsCount:Integer read fRRCount;
      property FoundDNSServers:TStrings read FDNSServers
         write SetDNSServers;
   end;

implementation

uses
{$IFNDEF LINUX}
   Windows,
{$ENDIF}
   DXSocket,
   DXSock,
   {$IFDEF IP_HELPER}
   Jedi_IPHLPAPI,
   IPTypes,
   {$ENDIF}
   SysUtils;

///////////////////////////////////////////////////////////////////////////////
// DNS Message Header
//    +-----------------------------------------------+
//    |                    ID                         |
//    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
//    |QR|   Opcode  |AA|TC|RD|RA|   Z    |   RCODE   |
//    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
//    |                  QDCOUNT                      |
//    +-----------------------------------------------+
//    |                  ANCOUNT                      |
//    +-----------------------------------------------+
//    |                  NSCOUNT                      |
//    +-----------------------------------------------+
//    |                  ARCOUNT                      |
//    +-----------------------------------------------+
//    ID=16bits
//    QR=1bit
//    OPCODE=4bits(0=query, 1=inverse query, 2=server status, 3-15 reserved.}
//    AA=1bit     (Authoritative flag}
//    TC=1bit     (Truncation flag}
//    RD=1bit     (Recursion desired)
//    RA=1bit     (Recursion available)
//    Z=3bits     (reserved)
//    RCODE=4bites(0=no error, 1=format error, 2=server problem,
//                 3=server cant find it, 4=query not supported,
//                 6=not authorized to do this,6-15 reserved.)
//    QDCount=16bits (number of entries in question section)
//    ANCount=16bits (number of Resource Results in answer section)
//    NSCOUNT=16bits (number of records in the authority section)
//    ARCount=16bits (number of extra records to read)
///////////////////////////////////////////////////////////////////////////////

type
   TDNSMessageHeader=record
      ID:SmallInt;
      QR:Boolean;
      OpCode:Byte;
      AA:Boolean;
      TC:Boolean;
      RD:Boolean;
      RA:Boolean;
      Z:Byte;
      RCode:Byte;
      QDCount:SmallInt;
      ANCount:SmallInt;
      NSCount:SmallInt;
      ARCount:SmallInt;
   end;

   ///////////////////////////////////////////////////////////////////////////////
   // CREATE:
   //       Define the mode of optimization.
   ///////////////////////////////////////////////////////////////////////////////

constructor TDXDNSQuery.Create(AOwner:TComponent);
begin
   inherited create(AOwner);
   FQueryCache:=TList.Create;
   FDNSServers:=TStringList.Create;
   FUseUDP:=TRUE;
   FAlternativeDNS:='';
   fQDCount:=0;
   fANCount:=0;
   fNSCount:=0;
   fRRCount:=0;
end;

///////////////////////////////////////////////////////////////////////////////
// DESTROY:
//        Destory this object.
///////////////////////////////////////////////////////////////////////////////

destructor TDXDNSQuery.Destroy;
begin
   if Assigned(FQueryCache) then begin
      FlushCache;
      FQueryCache.Free;
      FQueryCache:=nil;
   end;
   if Assigned(FDNSServers) then begin
      FDNSServers.Free;
      FDNSServers:=nil;
   end;
   inherited Destroy;
end;

procedure TDXDNSQuery.FlushCache;
var
   StoredDNSResultSet:PDNSResultSet;

begin
   if Assigned(FQueryCache) then begin
      while FQueryCache.Count>0 do begin
         StoredDNSResultSet:=FQueryCache[0];
         TMemoryStream(StoredDNSResultSet.Results).Free;
         StoredDNSResultSet.Results:=nil;
         Dispose(StoredDNSResultSet);
         FQueryCache.Delete(0);
      end;
   end;
end;

procedure TDXDNSQuery.SetFAlternativeDNS(value:string);
begin
   if Value<>FAlternativeDNS then begin
      FAlternativeDNS:=Value;
      {$IFNDEF OBJECTS_ONLY}
      if (csDesigning in ComponentState) then Exit;
      {$ENDIF}
      LoadNameServers;
   end;
end;

procedure TDXDNSQuery.LoadNameServers;
var
   RegDNS:string;
   I:Integer;
   {$IFDEF IP_HELPER}
   Err, FixedInfoSize:DWORD;
   pFixedInfo:PFIXED_INFO;
   pAddrStr:PIP_ADDR_STRING;
   {$ENDIF}

begin
   {$IFNDEF OBJECTS_ONLY}
   if (csDesigning in ComponentState) then Exit;
   {$ENDIF}
   if FAlternativeDNS='' then begin
      {$IFNDEF LINUX}
         {$IFDEF VER100}
            ShowMessageWindow('Fatal DNS Error',
               'Older Delphi Requires "AlternativeDNS" to be set manually!');
            Exit;
         {$ELSE}
            REGDNS:=RegistryStringGet(HKEY_LOCAL_MACHINE,
               'SYSTEM\CurrentControlSet\Services\TCPIP\Parameters\NameServer');
            if RegDNS='' then
               REGDNS:=RegistryStringGet(HKEY_LOCAL_MACHINE,
                  'SYSTEM\CurrentControlSet\Services\TCPIP\Parameters\DhcpNameServer');
            if RegDNS='' then
               REGDNS:=RegistryStringGet(HKEY_LOCAL_MACHINE,
                  'SYSTEM\CurrentControlSet\Services\VxD\MSTCP\NameServer');
         {$ENDIF}
      {$ELSE}
         ShowMessageWindow('Fatal DNS Error',
            'Linux Requires "AlternativeDNS" to be set manually!');
         Exit;
      {$ENDIF}