{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is PIETTE
Description:  Component to query DNS records.
              Implement a subset of RFC 1035 (A and MX records).
Creation:     January 29, 1999
Version:      1.02
EMail:        http://users.swing.be/francois.piette  francois.piette@swing.be
              http://www.rtfm.be/fpiette             francois.piette@rtfm.be
              francois.piette@pophost.eunet.be
Support:      Use the mailing list twsocket@rtfm.be See website for details.
Legal issues: Copyright (C) 1999-2000 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
              <francois.piette@pophost.eunet.be>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

History:
Feb 14, 1999 V0.02 Indirectly call winsock functions using wsocket because
             wsocket provide runtime dynamic link instead of loadtime link.
             This allows a program to use DnsQuery if it discover that winsock
             is installed and still run if winsock is not installed.
Feb 24, 1999 V1.00 Added code for reverse lookup (PTR record).
Mar 07, 1999 V1.01 Adapted for Delphi 1
Aug 20, 1999 V1.02 Revise compile time option. Adapted for BCB4


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit DnsQuery;

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$R-}           { Disable range checking              }
{$IFNDEF VER80} { Not for Delphi 1                    }
    {$H+}       { Use long strings                    }
    {$J+}       { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0                    }
    {$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125} { C++ Builder V4.0                    }
    {$ObjExportAll On}
{$ENDIF}

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Winsock, WSocket;

const
  DnsQueryVersion    = 102;
  CopyRight : String = ' TDnsQuery  (c) 1999-2000 F. Piette V1.02 ';

  { Maximum answers (responses) count }
  MAX_ANCOUNT     = 50;
  { Maximum number of MX records taken into account in responses }
  MAX_MX_RECORDS  = 50;
  MAX_A_RECORDS   = 50;
  MAX_PTR_RECORDS = 10;

  { DNS Classes }
  DnsClassIN      = 1;   { The internet                                      }
  DnsClassCS      = 2;   { The CSNET class (obsolete, used only for examples)}
  DnsClassCH      = 3;   { The CHAOS class                                   }
  DnsClassHS      = 4;   { Hesiod name service                               }
  DnsClassALL     = 255; { Any class                                         }

  { Type of query/response a DNS can handle }
  DnsQueryA       = 1;  { A     HostAddress                                  }
  DnsQueryNS      = 2;  { NS    Authoritative name server                    }
  DnsQueryMD      = 3;  { MD    MailDestination, obsolete, use Mail Exchange }
  DnsQueryMF      = 4;  { MF    MailForwarder, obsolete, use Mail Exchange   }
  DnsQueryCNAME   = 5;  { CNAME CanonicalName                                }
  DnsQuerySOA     = 6;  { SOA   Start of a Zone of Authority                 }
  DnsQueryMB      = 7;  { MB    MailBox, experimental                        }
  DnsQueryMG      = 8;  { MG    MailGroup, experimental                      }
  DnsQueryMR      = 9;  { MR    MailRename, experimental                     }
  DnsQueryNULL    = 10; { NULL  Experimental                                 }
  DnsQueryWKS     = 11; { WKS   Well Known Service Description               }
  DnsQueryPTR     = 12; { PTR   Domain Name Pointer                          }
  DnsQueryHINFO   = 13; { HINFO Host Information                             }
  DnsQueryMINFO   = 14; { MINFO Mailbox information                          }
  DnsQueryMX      = 15; { MX    Mail Exchange                                }
  DnsQueryTXT     = 16; { TXT   Text Strings                                 }

  { Some additional type only allowed in queries }
  DnsQueryAXFR    = 252; { Transfer for an entire zone                       }
  DnsQueryMAILB   = 253; { Mailbox related records (MB, MG or MR)            }
  DnsQueryMAILA   = 254; { MailAgent, obsolete, use MX instead               }
  DnsQueryALL     = 255; { Request ALL records                               }

  { Opcode field in query flags }                                            
  DnsOpCodeQUERY  = 0;
  DnsOpCodeIQUERY = 1;
  DnsOpCodeSTATUS = 2;

type
  TDnsAnswerNameArray   = packed array [0..MAX_ANCOUNT - 1]     of String;
  TDnsAnswerTypeArray   = packed array [0..MAX_ANCOUNT - 1]     of Integer;
  TDnsAnswerClassArray  = packed array [0..MAX_ANCOUNT - 1]     of Integer;
  TDnsAnswerTTLArray    = packed array [0..MAX_ANCOUNT - 1]     of LongInt;
  TDnsAnswerTagArray    = packed array [0..MAX_ANCOUNT - 1]     of Integer;
  TDnsMXPreferenceArray = packed array [0..MAX_MX_RECORDS - 1]  of Integer;
  TDnsMXExchangeArray   = packed array [0..MAX_MX_RECORDS - 1]  of String;
  TDnsAddressArray      = packed array [0..MAX_A_RECORDS - 1]   of TInAddr;
  TDnsHostnameArray     = packed array [0..MAX_PTR_RECORDS - 1] of String;

  TDnsRequestDoneEvent = procedure (Sender : TObject; Error : WORD) of Object;
  TDnsRequestHeader = packed record
      ID      : WORD;
      Flags   : WORD;
      QDCount : WORD;
      ANCount : WORD;
      NSCount : WORD;
      ARCount : WORD;
  end;
  PDnsRequestHeader = ^TDnsRequestHeader;

  TDnsQuery = class(TComponent)
  private
    { D閏larations priv閑s }
  protected
    FWSocket                    : TWSocket;
    FPort                       : String;
    FAddr                       : String;
    FIDCount                    : WORD;
    FQueryBuf                   : array [0..511] of char;
    FQueryLen                   : Integer;
    FResponseBuf                : array [0..511] of char;
    FResponseLen                : Integer;
    FResponseID                 : Integer;
    FResponseCode               : Integer;
    FResponseOpCode             : Integer;
    FResponseAuthoritative      : Boolean;
    FResponseTruncation         : Boolean;
    FResponseRecursionAvailable : Boolean;
    FResponseQDCount            : Integer;
    FResponseANCount            : Integer;
    FResponseNSCount            : Integer;
    FResponseARCount            : Integer;
    FQuestionType               : Integer;
    FQuestionClass              : Integer;
    FQuestionName               : String;
    FAnswerNameArray            : TDnsAnswerNameArray;
    FAnswerTypeArray            : TDnsAnswerTypeArray;
    FAnswerClassArray           : TDnsAnswerClassArray;
    FAnswerTTLArray             : TDnsAnswerTTLArray;
    FAnswerTagArray             : TDnsAnswerTagArray;
    FMXRecordCount              : Integer;
    FMXPreferenceArray          : TDnsMXPreferenceArray; { For MX request  }
    FMXExchangeArray            : TDnsMXExchangeArray;   { For MX request  }
    FARecordCount               : Integer;
    FAddressArray               : TDnsAddressArray;      { For A request   }
    FPTRRecordCount             : Integer;
    FHostnameArray              : TDnsHostnameArray;     { For PTR request }
    FOnRequestDone              : TDnsRequestDoneEvent;
    function GetMXPreference(nIndex : Integer) : Integer;
    function GetMXExchange(nIndex : Integer)   : String;
    function GetAnswerName(nIndex : Integer)   : String;
    function GetAnswerType(nIndex : Integer)   : Integer;
    function GetAnswerClass(nIndex : Integer)  : Integer;
    function GetAnswerTTL(nIndex : Integer)    : LongInt;
    function GetAnswerTag(nIndex : Integer)    : Integer;
    function GetAddress(nIndex : Integer)      : TInAddr;
    function GetHostname(nIndex : Integer)     : String;
    procedure BuildRequestHeader(Dst       : PDnsRequestHeader;
                                 ID        : WORD;
                                 OPCode    : BYTE;
                                 Recursion : Boolean;
                                 QDCount   : WORD;
                                 ANCount   : WORD;
                                 NSCount   : WORD;
                                 ARCount   : WORD); virtual;
    function  BuildQuestionSection(Dst         : PChar;
                                   const QName : String;
                                   QType       : WORD;
                                   QClass      : WORD) : Integer; virtual;
    procedure WSocketDataAvailable(Sender: TObject; Error: WORD); virtual;
    procedure TriggerRequestDone(Error: WORD); virtual;
    function  GetResponseBuf : PChar;
    procedure SendQuery;
    function  ExtractName(Base       : PChar;
                          From       : PChar;
                          var Name   : String) : PChar;
    function  DecodeQuestion(Base       : PChar;
                             From       : PChar;
                             var Name   : String;
                             var QType  : Integer;
                             var QClass : Integer) : PChar;
    function DecodeAnswer(Base         : PChar;
                          From         : PChar;
                          var Name     : String;
                          var QType    : Integer;
                          var QClass   : Integer;
                          var TTL      : LongInt;
                          var RDataPtr : Pointer;
                          var RDataLen : Integer) : PChar;
    function DecodeMXData(Base           : PChar;
                          From           : PChar;
                          var Preference : Integer;
                          var Exchange   : String) : PChar;
    function DecodeAData(Base        : PChar;
                         From        : PChar;
                         var Address : TInAddr) : PChar;
    function DecodePTRData(Base         : PChar;
                           From         : PChar;
                           var Hostname : String) : PChar;
  public
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy; override;
    procedure   Notification(AComponent: TComponent; operation: TOperation); override;
    function    MXLookup(Domain : String) : Integer;
    function    ALookup(Host : String) : Integer;
    function    PTRLookup(IP : String) : Integer;
    property ResponseID                 : Integer read FResponseID;
    property ResponseCode               : Integer read FResponseCode;
    property ResponseOpCode             : Integer read FResponseOpCode;
    property ResponseAuthoritative      : Boolean read FResponseAuthoritative;
    property ResponseTruncation         : Boolean read FResponseTruncation;
    property ResponseRecursionAvailable : Boolean read FResponseRecursionAvailable;
    property ResponseQDCount            : Integer read FResponseQDCount;
    property ResponseANCount            : Integer read FResponseANCount;
    property ResponseNSCount            : Integer read FResponseNSCount;
    property ResponseARCount            : Integer read FResponseARCount;
    property ResponseBuf                : PChar   read GetResponseBuf;
    property ResponseLen                : Integer read FResponseLen;
    property QuestionType               : Integer read FQuestionType;
    property QuestionClass              : Integer read FQuestionClass;
    property QuestionName               : String  read FQuestionName;
    property AnswerName[nIndex : Integer]   : String  read GetAnswerName;
    property AnswerType[nIndex : Integer]   : Integer read GetAnswerType;
    property AnswerClass[nIndex : Integer]  : Integer read GetAnswerClass;
    property AnswerTTL[nIndex : Integer]    : LongInt read GetAnswerTTL;
    property AnswerTag[nIndex : Integer]    : Integer read GetAnswerTag;
    property MXPreference[nIndex : Integer] : Integer read GetMXPreference;
    property MXExchange[nIndex : Integer]   : String  read GetMXExchange;
    property Address[nIndex : Integer]      : TInAddr read GetAddress;
    property Hostname[nIndex : Integer]     : String  read GetHostname;
  published
    property Port    : String read  FPort write FPort;
    property Addr    : String read  FAddr write FAddr;
    property OnRequestDone : TDnsRequestDoneEvent read  FOnRequestDone
                                                  write FOnRequestDone;
  end;

function ReverseIP(const IP : String) : String;

procedure Register;

implementation

type
    PWORD  = ^WORD;
    PDWORD = ^DWORD;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function ReverseIP(const IP : String) : String;
var
    I, J : Integer;