Indy/Lib/Protocols/IdDNSCommon.pas

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$

    Rev 1.29    1/31/2005 9:02:44 PM  JPMugaas
  Should compile again.  OOPS!!


    Rev 1.28    1/28/2005 8:06:08 PM  JPMugaas
  Bug with MINFO, it was not returning the responsible E-Mail address.


    Rev 1.27    1/28/2005 7:12:34 PM  JPMugaas
  Minor formatting adjustments.


    Rev 1.26    1/28/2005 3:46:18 PM  JPMugaas
  Should compile.


    Rev 1.25    2005/1/28 ¤U¤È 12:40:08  DChang
  Add a new method for TIdTextModeResourceRecord to clean the created FAnswer,
  then while the record updated, new data can be used in the FAnswer.


    Rev 1.23    2005/1/25 ¤U¤È 12:24:14  DChang
  For speeding up the query, one private variable is added into all TIdRR_
  series object, only first time query will generate the binary codes, the
  others will read the result form the first time generated.


    Rev 1.22    2004/12/15 ¤W¤È 11:12:18  DChang    Version: 1.22
  Fix all BinQueryRecord method of TIdRR_*,
  TIdRR_TXT.BinQueryRecord is completed,
  and remark the comment of TIdTextModeResourceRecord.BinQueryRecord,
  it's should be empty.


    Rev 1.21    10/26/2004 9:06:30 PM  JPMugaas
  Updated references.


    Rev 1.20    9/15/2004 4:59:34 PM  DSiders
  Added localization comments.


    Rev 1.19    2004/7/19 ¤U¤È 09:43:40  DChang
  1. Move the TIdTextModeResourceRecords which was defined in
  IdDNSServer.pas to here.
  2. Add a QueryType (DqtIXFR) in TDNSQueryRecordTypes.


    Rev 1.18    6/29/04 1:22:32 PM  RLebeau
  Updated NormalStrToDNSStr() to use CopyTIdBytes() instead of AppendBytes()


    Rev 1.17    2/11/2004 5:21:12 AM  JPMugaas
  Vladimir Vassiliev changes for removal of byte flipping.  Network conversion
  order conversion functions are used instead.
  IPv6 addresses are returned in the standard form.
  In WKS records, Address was changed to IPAddress to be consistant with other
  record types.  Address can also imply a hostname.


    Rev 1.16    2/7/2004 7:18:30 PM  JPMugaas
  Moved some functions out of IdDNSCommon so we can use them elsewhere.


    Rev 1.15    2004.02.07 5:45:10 PM  czhower
  Fixed compile error in D7.


    Rev 1.14    2004.02.07 5:03:26 PM  czhower
  .net fixes.


    Rev 1.13    2004.02.03 5:45:56 PM  czhower
  Name changes


    Rev 1.12    12/7/2003 8:07:24 PM  VVassiliev
  string -> TIdBytes


    Rev 1.11    11/15/2003 1:16:06 PM  VVassiliev
  Move AppendByte from IdDNSCommon to IdCoreGlobal


    Rev 1.10    11/13/2003 5:46:04 PM  VVassiliev
  DotNet


    Rev 1.9    10/25/2003 06:51:50 AM  JPMugaas
  Updated for new API changes and tried to restore some functionality.


    Rev 1.8    10/19/2003 11:56:12 AM  DSiders
  Added localization comments.


    Rev 1.7    2003.10.12 3:50:38 PM  czhower
  Compile todos


    Rev 1.6    2003/5/8 ¤U¤È 08:07:12  DChang
  Add several constants for IdDNSServer


    Rev 1.5    4/28/2003 03:34:56 PM  JPMugaas
  Illiminated constant for the service path.  IFDEF's for platforms are only
  allowed in designated units.  Besides, the location of the services file is
  different in Win9x operating systems than NT operating systems.


    Rev 1.4    4/28/2003 02:30:46 PM  JPMugaas
  reverted back to the old one as the new one checked will not compile, has
  problametic dependancies on Contrs and Dialogs (both not permitted).


    Rev 1.2    4/28/2003 07:00:04 AM  JPMugaas
  Should now compile.


    Rev 1.0    11/14/2002 02:18:20 PM  JPMugaas
    Rev 1.3    04/28/2003 01:15:20 AM  DenniesChang


    // Add iRCode mode constants in May 4, 2003.
    // Modify all DNS relative header in IdDNSCommon.pas
    // Apr. 28, 2003

    // Jun. 03, 2002.
    // Add AXFR function
    Duplicate some varible and constants in DNSCommon,
    because Indy change version very frequently, these
    varlibles and objects are isolated.

    I had added some methods into IdDNSResolver of Indy 9.02,
    for parsing DN record directly and skip some check actions
    from original query, but this modification will not relfect
    the action of DN Query.

    Original Programmer: Dennies Chang <[email protected]>
    No Copyright. Code is given to the Indy Pit Crew.

    Started: Jan. 20, 2002.
    Finished:
}

unit IdDNSCommon;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdContainers,
  IdException,
  IdGlobal,
  IdResourceStringsProtocols;

const
  IdDNSServerVersion = 'Indy DNSServer 20040121301'; {do not localize}
  cRCodeNoError   = 0;
  cRCodeFormatErr = 1;
  cRCodeServerErr = 2;
  cRCodeNameErr   = 3;
  cRCodeNotImplemented = 4;
  cRCodeRefused  = 5;

  iRCodeQueryNotImplement = 0;
  iRCodeQueryReturned = 1;
  iRCodeQueryOK = 2;
  iRCodeQueryNotFound = 3;

  iRCodeNoError = 0;
  iRCodeFormatError = 1;
  iRCodeServerFailure = 2;
  iRCodeNameError = 3;
  iRCodeNotImplemented = 4;
  iRCodeRefused = 5;

  iQr_Question = 0;
  iQr_Answer = 1;

  iAA_NotAuthoritative = 0;
  iAA_Authoritative = 1;

  cRCodeQueryNotImplement = 'NA'; {do not localize}
  cRCodeQueryReturned = 'RC'; // Return Completed.  {do not localize}
  cRCodeQueryOK = 'OK'; {do not localize}
  cRCodeQueryCacheOK = 'COK'; {do not localize}
  cRCodeQueryNotFound = 'NOTFOUND'; {do not localize}
  cRCodeQueryCacheFindError = 'CFoundError'; {do not localize}

  RSDNSServerAXFRError_QuerySequenceError = 'First record must be SOA!';  {do not localize}
  RSDNSServerSettingError_MappingHostError = 'Host must be an IP address'; {do not localize}

  cOrigin = '$ORIGIN';    {do not localize}
  cInclude = '$INCLUDE';  {do not localize}
  cAAAA    = 'AAAA';      {do not localize}
  cAt     = '@';          {do not localize}
  cA      = 'A';          {do not localize}
  cNS     = 'NS';         {do not localize}
  cMD     = 'MD';         {do not localize}
  cMF     = 'MF';         {do not localize}
  cCName  = 'CNAME';      {do not localize}
  cSOA    = 'SOA';        {do not localize}
  cMB     = 'MB';         {do not localize}
  cMG     = 'MG';         {do not localize}
  cMR     = 'MR';         {do not localize}
  cNULL   = 'NULL';       {do not localize}
  cWKS    = 'WKS';        {do not localize}
  cPTR    = 'PTR';        {do not localize}
  cHINFO  = 'HINFO';      {do not localize}
  cMINFO  = 'MINFO';      {do not localize}
  cMX     = 'MX';         {do not localize}
  cTXT    = 'TXT';        {do not localize}
  cNSAP   = 'NSAP';       {do not localize}
  cNSAP_PTR = 'NSAP-PTR'; {do not localize}
  cLOC      = 'LOC';      {do not localize}
  cAXFR     = 'AXFR';     {do not localize}
  cIXFR     = 'IXFR';     {do not localize}
  cSTAR     = 'STAR';     {do not localize}

  cRCodeStrs : Array[cRCodeNoError..cRCodeRefused] Of String =
    (RSCodeNoError,
     RSCodeQueryFormat,
     RSCodeQueryServer,
     RSCodeQueryName,
     RSCodeQueryNotImplemented,
     RSCodeQueryQueryRefused);

  Class_IN = 1;
  Class_CHAOS = 3;

  TypeCode_A            = 1;
  TypeCode_NS           = 2;
  TypeCode_MD           = 3;
  TypeCode_MF           = 4;
  TypeCode_CName        = 5;
  TypeCode_SOA          = 6;
  TypeCode_MB           = 7;
  TypeCode_MG           = 8;
  TypeCode_MR           = 9;
  TypeCode_NULL         = 10;
  TypeCode_WKS          = 11;
  TypeCode_PTR          = 12;
  TypeCode_HINFO        = 13;
  TypeCode_MINFO        = 14;
  TypeCode_MX           = 15;
  TypeCode_TXT          = 16;
  TypeCode_RP           = 17;
  TypeCode_AFSDB        = 18;
  TypeCode_X25          = 19;
  TypeCode_ISDN         = 20;
  TypeCode_RT           = 21;
  TypeCode_NSAP         = 22;
  TypeCode_NSAP_PTR     = 23;
  TypeCode_SIG          = 24;
  TypeCode_KEY          = 25;
  TypeCode_PX           = 26;
  TypeCode_QPOS         = 27;
  TypeCode_AAAA         = 28;
  TypeCode_LOC          = 29;
  TypeCode_NXT          = 30;
  TypeCode_R31          = 31;
  TypeCode_R32          = 32;
  TypeCode_Service      = 33;
  TypeCode_R34          = 34;
  TypeCode_NAPTR        = 35;
  TypeCode_KX           = 36;
  TypeCode_CERT         = 37;
  TypeCode_V6Addr       = 38;
  TypeCode_DNAME        = 39;
  TypeCode_R40          = 40;
  TypeCode_OPTIONAL     = 41;
  TypeCode_IXFR         = 251;
  TypeCode_AXFR         = 252;
  TypeCode_STAR         = 255;
  TypeCode_Error        = 0;

type
  {NormalTags = (cA, cNS, cMD, cMF, cCName, cSOA, cMB, cMG, cMR, cNULL, cWKS, cPTR,
                cHINFO, cMINFO, cMX, cTXT);  }
  TDNSQueryRecordTypes = (DqtA, DqtNS, DqtMD, DqtMF, DqtName, DqtSOA, DqtMB,
    DqtMG, DqtMR, DqtNull, DqtWKS, DqtPTR, DqtHINFO, DqtMINFO, DqtMX, DqtTXT,
    DqtNSAP, DqtNSAP_PTR, DqtLOC, DqtIXFR, DqtAXFR, DqtSTAR, DqtAAAA);

  TDNSServerTypes = (stPrimary, stSecondary);

  EIdDNSServerSyncException = class(EIdSilentException);
  EIdDNSServerSettingException = class(EIdSilentException);

  // TODO: enable AD and CD properties. Those fields are reserved in RFC 1035, but defined in RFC 6895
  TDNSHeader = class
  private
    FID: UInt16;
    FBitCode: UInt16;
    FQDCount: UInt16;
    FANCount: UInt16;
    FNSCount: UInt16;
    FARCount: UInt16;
    function GetAA: UInt16;
    //function GetAD: UInt16;
    //function GetCD: UInt16;
    function GetOpCode: UInt16;
    function GetQr: UInt16;
    function GetRA: UInt16;
    function GetRCode: UInt16;
    function GetRD: UInt16;
    function GetTC: UInt16;
    procedure SetAA(const Value: UInt16);
    //procedure SetAD(const Value: UInt16);
    //procedure SetCD(const Value: UInt16);
    procedure SetOpCode(const Value: UInt16);
    procedure SetQr(const Value: UInt16);
    procedure SetRA(const Value: UInt16);
    procedure SetRCode(const Value: UInt16);
    procedure SetRD(const Value: UInt16);
    procedure SetTC(const Value: UInt16);
    procedure SetBitCode(const Value: UInt16);
  public
    constructor Create;
    procedure ClearByteCode;
    function ParseQuery(Data : TIdBytes) : integer;
    function GenerateBinaryHeader : TIdBytes;

    property ID: UInt16 read FID write FID;
    property Qr: UInt16 read GetQr write SetQr;
    property OpCode: UInt16 read GetOpCode write SetOpCode;
    property AA: UInt16 read GetAA write SetAA;
    //property AD: UInt16 get GetAD write SetAD;
    //property CD: UInt16 get GetCD write SetCD;
    property TC: UInt16 read GetTC write SetTC;
    property RD: UInt16 read GetRD write SetRD;
    property RA: UInt16 read GetRA write SetRA;
    property RCode: UInt16 read GetRCode write SetRCode;
    property BitCode: UInt16 read FBitCode write SetBitCode;
    property QDCount: UInt16 read FQDCount write FQDCount;
    property ANCount: UInt16 read FANCount write FANCount;
    property NSCount: UInt16 read FNSCount write FNSCount;
    property ARCount: UInt16 read FARCount write FARCount;
  end;

  TIdTextModeResourceRecord = class(TObject)
  protected
    FAnswer : TIdBytes;
    FRRName: string;
    FRRDatas: TStrings;  //TODO Should not be TIdStrings
    FTTL: Int32;
    FTypeCode: Integer;
    FTimeOut: string;
    function FormatQName(const AFullName: string): string; overload;
    function FormatQName(const AName, AFullName: string): string; overload;
    function FormatQNameFull(const AFullName: string): string;
    function FormatRecord(const AFullName: String; const ARRData: TIdBytes): TIdBytes;
    procedure SetRRDatas(const Value: TStrings);
    procedure SetTTL(const Value: Int32);
  public
    constructor CreateInit(const ARRName: String; ATypeCode: Integer);
    destructor Destroy; override;
    property TypeCode : Integer read FTypeCode;
    property RRName : string read FRRName write FRRName;
    property RRDatas : TStrings read FRRDatas write SetRRDatas;
    property TTL : integer read FTTL write SetTTL;
    property TimeOut : string read FTimeOut write FTimeOut;
    function ifAddFullName(AFullName: string; AGivenName: string = ''): boolean;
    function GetValue(const AName: String): String;
    procedure SetValue(const AName: String; const AValue: String);
    function ItemCount : Integer;
    function BinQueryRecord(AFullName: string): TIdBytes; virtual;
    function TextRecord(AFullName: string): string; virtual;
    procedure ClearAnswer;
  end;

  TIdTextModeRRs = class(TIdObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdTextModeResourceRecord>{$ENDIF})
  private
    FItemNames : TStrings;
    {$IFNDEF HAS_GENERICS_TObjectList}
    function GetItem(Index: Integer): TIdTextModeResourceRecord;
    procedure SetItem(Index: Integer; const Value: TIdTextModeResourceRecord);
    {$ENDIF}
    procedure SetItemNames(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;

    property ItemNames : TStrings read FItemNames write SetItemNames;
    {$IFNDEF HAS_GENERICS_TObjectList}
    property Items[Index: Integer]: TIdTextModeResourceRecord read GetItem write SetItem; default;
    {$ENDIF}
  end;


  TIdRR_CName = class(TIdTextModeResourceRecord)
  protected
    function GetCName: String;
    procedure SetCName(const Value: String);
  public
    constructor Create;
    property CName : String read GetCName write SetCName;
    function BinQueryRecord(AFullName: string): TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_HINFO = class(TIdTextModeResourceRecord)
  protected
    procedure SetCPU(const Value: String);
    function GetCPU: String;
    function GetOS: String;
    procedure SetOS(const Value: String);
  public
    constructor Create;
    property CPU : String read GetCPU write SetCPU;
    property OS : String read GetOS write SetOS;
    function BinQueryRecord(AFullName : string): TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_MB = class(TIdTextModeResourceRecord)
  protected
    function GetMADName: String;
    procedure SetMADName(const Value: String);
  public
    constructor Create;
    property MADName : String read GetMADName write SetMADName;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_MG = class(TIdTextModeResourceRecord)
  protected
    function GetMGMName: String;
    procedure SetMGMName(const Value: String);
  public
    constructor Create;
    property MGMName : String read GetMGMName write SetMGMName;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_MINFO = class(TIdTextModeResourceRecord)
  protected
    procedure SetErrorHandle_Mail(const Value: String);
    procedure SetResponsible_Mail(const Value: String);
    function GetEMail: String;
    function GetRMail: String;
  public
    constructor Create;
    property Responsible_Mail : String read GetRMail write SetResponsible_Mail;
    property ErrorHandle_Mail : String read GetEMail write SetErrorHandle_Mail;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_MR = class(TIdTextModeResourceRecord)
  protected
    function GetNewName: String;
    procedure SetNewName(const Value: String);
  public
    constructor Create;
    property NewName : String read GetNewName write SetNewName;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_MX = class(TIdTextModeResourceRecord)
  protected
    function GetExchang: String;
    procedure SetExchange(const Value: String);
    function GetPref: String;
    procedure SetPref(const Value: String);
  public
    constructor Create;
    property Exchange : String read GetExchang write SetExchange;
    property Preference : String read GetPref write SetPref;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_NS = class(TIdTextModeResourceRecord)
  protected
    function GetNS: String;
    procedure SetNS(const Value: String);
  public
    constructor Create;
    property NSDName : String read GetNS write SetNS;
    function BinQueryRecord(AFullName : string): TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_PTR = class(TIdTextModeResourceRecord)
  protected
    function GetPTRName: String;
    procedure SetPTRName(const Value: String);
  public
    constructor Create;
    property PTRDName : String read GetPTRName write SetPTRName;
    function BinQueryRecord(AFullName : string): TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_SOA = class(TIdTextModeResourceRecord)
  protected
    function GetName(const CLabel : String): String;
    procedure SetName(const CLabel: String; const Value : String);
    function GetMName: String;
    function GetRName: String;
    procedure SetMName(const Value: String);
    procedure SetRName(const Value: String);
    function GetMin: String;
    function GetRefresh: String;
    function GetRetry: String;
    function GetSerial: String;
    procedure SetMin(const Value: String);
    procedure SetRefresh(const Value: String);
    procedure SetRetry(const Value: String);
    procedure SetSerial(const Value: String);
    function GetExpire: String;
    procedure SetExpire(const Value: String);
  public
    constructor Create;
    property MName : String read GetMName write SetMName;
    property RName : String read GetRName write SetRName;
    property Serial : String read GetSerial write SetSerial;
    property Refresh : String read GetRefresh write SetRefresh;
    property Retry : String read GetRetry write SetRetry;
    property Expire : String read GetExpire write SetExpire;
    property Minimum : String read GetMin write SetMin;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;


  TIdRR_A = class(TIdTextModeResourceRecord)
  protected
    function GetA: String;
    procedure SetA(const Value: String);
  public
    constructor Create;
    property Address : String read GetA write SetA;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;

  TIdRR_AAAA = class(TIdTextModeResourceRecord)
  protected
    function GetA: String;
    procedure SetA(const Value: String);
  public
     constructor Create;
     property Address : String read GetA write SetA;
     function BinQueryRecord(AFullName : string) : TIdBytes; override;
     function TextRecord(AFullName : string) : string; override;
  end;

     { TODO : implement WKS record class }
  TIdRR_WKS = class(TIdTextModeResourceRecord)
  public
    constructor Create;
  end;

  TIdRR_TXT = class(TIdTextModeResourceRecord)
  protected
    function GetTXT: String;
    procedure SetTXT(const Value: String);
  public
    constructor Create;
    property TXT : String read GetTXT write SetTXT;
    function BinQueryRecord(AFullName : string) : TIdBytes; override;
    function TextRecord(AFullName : string) : string; override;
  end;

  TIdRR_Error = class(TIdTextModeResourceRecord)
  public
    constructor Create;
  end;

function DomainNameToDNSStr(const ADomain : String): TIdBytes;
function NormalStrToDNSStr(const Str : String): TIdBytes;
function IPAddrToDNSStr(const IPAddress : String): TIdBytes;
function IsValidIPv6(const v6Address : String): Boolean;
function ConvertToValidv6IP(const OrgIP : String) : string;
function ConvertToCanonical6IP(const OrgIP : String) : string;
function IPv6AAAAToDNSStr(const AIPv6Address : String): TIdBytes;
function GetErrorStr(const Code, Id: Integer): String;
function GetRCodeStr(RCode : Integer): String;
function ReplaceSpecString(Source, Target, NewString : string; ReplaceAll : boolean = True) : string;
function IsBig5(ch1, ch2: Char) : Boolean;

implementation

uses
  {$IFDEF VCL_XE3_OR_ABOVE}
    {$IFNDEF NEXTGEN}
  System.Contnrs,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF HAS_UNIT_DateUtils}
  DateUtils,
  {$ENDIF}
  IdGlobalProtocols,
  IdStack, SysUtils;

const
  ValidHexChars = '0123456789ABCDEFabcdef';

procedure IdBytesCopyBytes(const ASource: TIdBytes; var VDest: TIdBytes; var VDestIndex: Integer);
begin
  CopyTIdBytes(ASource, 0, VDest, VDestIndex, Length(ASource));
  Inc(VDestIndex, Length(ASource));
end;

procedure IdBytesCopyUInt16(const ASource: UInt16; var VDest: TIdBytes; var VDestIndex: Integer);
begin
  CopyTIdUInt16(ASource, VDest, VDestIndex);
  Inc(VDestIndex, SizeOf(UInt16));
end;

procedure IdBytesCopyUInt32(const ASource: UInt32; var VDest: TIdBytes; var VDestIndex: Integer);
begin
  CopyTIdUInt32(ASource, VDest, VDestIndex);
  Inc(VDestIndex, SizeOf(UInt32));
end;

function DomainNameToDNSStr(const ADomain : string): TIdBytes;
var
  BufStr, LDomain : String;
  LIdx : Integer;
  LLen: Byte;
begin
  if Length(ADomain) = 0 then begin
    SetLength(Result, 0);
  end else begin
    // TODO: ned to re-write this...
    SetLength(Result, Length(ADomain)+1);
    LIdx := 0;
    LDomain := ADomain;
    repeat
      BufStr := Fetch(LDomain, '.');
      LLen := Length(BufStr);
      Result[LIdx] := LLen;
      CopyTIdString(BufStr, Result, LIdx+1, LLen);
      Inc(LIdx, LLen+1);
    until LDomain = '';
    Result[LIdx] := 0;
    SetLength(Result, LIdx+1);
  end;
end;

function NormalStrToDNSStr(const Str : String): TIdBytes;
var
  LLen: Byte;
  LStr: TIdBytes;
begin
  LStr := ToBytes(Str);
  LLen := IndyMin(Length(LStr), $FF);
  SetLength(Result, 1 + LLen);
  Result[0] := LLen;
  CopyTIdBytes(LStr, 0, Result, 1, LLen);
end;

function IPAddrToDNSStr(const IPAddress : String): TIdBytes;
Var
  j, i: Integer;
  s : string;
begin
  SetLength(Result, 0);
  if IsValidIP(IPAddress) then begin
    s := Trim(IPAddress);
    SetLength(Result, 4);
    for i := 0 to 3 do begin
      j := IndyStrToInt(Fetch(s, '.'), -1); {do not localize}
      if (j < 0) or (j > 255) then begin
        Result := ToBytes('Error IP'); {do not localize}
        Exit;
      end;
      Result[I] := Byte(j);
    end;
  end else begin
    Result := ToBytes('Error IP'); {do not localize}
  end;
end;

procedure IdHexToBin(const AText: TIdBytes; var Buffer: TIdBytes; const BufSize: Integer);
const
  Convert: array['0'..'f'] of Int16 =                   {do not localize}
    ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
     -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
     -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
     -1,10,11,12,13,14,15);
var
  BufferPos, TextPos: Integer;
  ValidChars: TIdBytes;
begin
  ValidChars := ToBytes(ValidHexChars);
  BufferPos := 0;
  TextPos := 0;
  repeat
    if (not ByteIsInSet(AText, TextPos, ValidChars)) or
      (not ByteIsInSet(AText, TextPos+1, ValidChars)) then
    begin
      Break;
    end;
    Buffer[BufferPos] := (Convert[Char(AText[TextPos])] shl 4) + Convert[Char(AText[TextPos + 1])];
    Inc(BufferPos);
    Inc(TextPos, 2);
  until False;
end;

function IPv6AAAAToDNSStr(const AIPv6Address : String): TIdBytes;
var
  LAddr : TIdIPv6Address;
begin
  IPv6ToIdIPv6Address(AIPv6Address, LAddr);
  SetLength(Result, 16);
  CopyTIdIPV6Address(LAddr, Result, 0);
end;

function IsValidIPv6(const v6Address : String): boolean;
var
  Temps : TStrings;
  Apart, All: String;
  Count, Loc, Goal : integer;
begin
  All := v6Address;
  Temps := TStringList.Create;
  try
    // Check Double Colon existence, but only single.
    Count := 0;

    repeat
      Loc := IndyPos('::', All);               {do not localize}
      if Loc > 0 then begin
        Count := Count + 1;
        IdDelete(All, Loc, 2);
      end;
    until Loc = 0;

    if Count <= 1 then begin
      // Convert Double colon into compatible format.
      All := ReplaceSpecString(v6Address, '::', ':Multi:'); {do not localize}
      repeat
        Apart := Fetch(All, ':');                     {do not localize}
        Temps.Add(Apart);
      until All = '';                               {do not localize}

      Loc := Temps.IndexOf('Multi');  {do not localize}
      if Loc > -1 then begin
        Goal := 8 - Temps.Count;
        Temps.Strings[Loc] := '0000';  {do not localize}
        for Count := 0 to Goal -1 do begin
          Temps.Insert(Loc, '0000'); {do not localize}
        end;
        if Temps.Strings[0] = '' then begin {do not localize}
          Temps.Strings[0] := '0000';  {do not localize}
        end;
      end;

      All := ReplaceSpecString(Temps.CommaText, ',', ':');      {do not localize}
      Result := True;
      Temps.Clear;

      repeat
        Apart := Trim(Fetch(All, ':'));             {do not localize}
        if Length(Apart) <= 4 then begin
          Apart := '0000' + Apart;  {do not localize}
          Apart := Copy(Apart, Length(Apart)-3, 4);
          Temps.Add(Apart);
        end else begin
          Result := False;
        end;
      until (All = '') or (not Result);            {do not localize}

      if (not Result) or (Temps.Count > 8) then begin
        Result := False;
      end else begin
        for Count := 0 to Temps.Count -1 do begin
          All := All + Temps.Strings[Count];
        end;
        Result := Length(All) > 0;
        for Count := 1 to Length(All) do begin
          Result := CharIsInSet(All, Count, ValidHexChars);
          if not Result then begin
            Break;
          end;
        end;
      end;
    end else begin
       // mulitple Double colon, it's an incorrect IPv6 address.
      Result := False;
    end;
  finally
    FreeAndNil(Temps);
  end;
end;

function ConvertToValidv6IP(const OrgIP : String) : string;
var
  All, Apart : string;
  Temps : TStrings;
  Count, Loc, Goal : integer;
begin
  Result := '';
  All := OrgIP;
  Temps := TStringList.Create;
  try
    // Check Double Colon existence, but only single.
    // Count := 0;

    repeat
      Loc := IndyPos('::', All);    {do not localize}
      if Loc > 0 then begin
        //    Count := Count + 1;
        IdDelete(All, Loc, 2);
      end;
    until Loc = 0;

    // Convert Double colon into compatible format.
    All := ReplaceSpecString(OrgIP, '::', ':Multi:');  {do not localize}
    repeat
      Apart := Fetch(All, ':');  {do not localize}
      Temps.Add(Apart);
    until All = '';             {do not localize}

    Loc := Temps.IndexOf('Multi'); {do not localize}
    if Loc > -1 then begin
      Goal := 8 - Temps.Count;
      Temps.Strings[Loc] := '0000'; {do not localize}
      for Count := 0 to Goal -1 do begin
        Temps.Insert(Loc, '0000');  {do not localize}
      end;
      if Temps.Strings[0] = '' then begin
        Temps.Strings[0] := '0000'; {do not localize}
      end;
    end;
    Result := ReplaceSpecString(Temps.CommaText, ',', ':'); {do not localize}
  finally
    FreeAndNil(Temps);
  end;
end;

function ConvertToCanonical6IP(const OrgIP : String) : string;
var
  All, Apart: string;
begin
  {Supposed OrgIP is valid IPV6 string}
  Result := '';                      {do not localize}
  All := ConvertToValidv6IP(OrgIP);
  repeat
    Apart := Trim(Fetch(All, ':'));  {do not localize}
    if Length(Apart) < 4 then
    begin
      Apart := '0000' + Apart;  {do not localize}
      Apart := Copy(Apart, Length(Apart)-3, 4);
    end;
    Result := Result + Apart + ':'; {do not localize}
  until (All = '');                 {do not localize}
  SetLength(Result, Length(Result) - 1); //Remove last :
end;

{ TODO : Move these to member }
function GetErrorStr(const Code, Id: Integer): String;
begin
  case Code of
    1 : Result := IndyFormat(RSQueryInvalidQueryCount, [Id]);
    2 : Result := IndyFormat(RSQueryInvalidPacketSize, [Id]);
    3 : Result := IndyFormat(RSQueryLessThanFour, [Id]);
    4 : Result := IndyFormat(RSQueryInvalidHeaderID, [Id] );
    5 : Result := IndyFormat(RSQueryLessThanTwelve, [Id]);
    6 : Result := IndyFormat(RSQueryPackReceivedTooSmall, [Id]);
    else
        Result := IndyFormat(RSQueryUnknownError, [Code, Id]);
  end;  //case code Of
end;

function GetRCodeStr(RCode : Integer): String;
begin
  if Rcode in [cRCodeNoError..cRCodeRefused] then begin
    Result :=  cRCodeStrs[Rcode];
  end else begin // if Rcode in [cRCodeNoError..cRCodeRefused] then
    Result := RSCodeQueryUnknownError;
  end; //else.. if Rcode in [cRCodeNoError..cRCodeRefused] then
end;


{ TDNSHeader }

procedure TDNSHeader.ClearByteCode;
begin
  FBitCode := 0;
end;

constructor TDNSHeader.Create;
begin
  inherited Create;
  Randomize;
  FId := Random(65535);
end;

function TDNSHeader.GenerateBinaryHeader: TIdBytes;
{


The header contains the following fields:

                                    1  1  1  1  1  1
      0  1  2  3  4  5  6  7  8  9  0  1  2  3  4  5
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                      ID                       |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |QR|   Opcode  |AA|TC|RD|RA| Z|AD|CD|   RCODE   |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                QDCOUNT/ZOCOUNT                |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                ANCOUNT/PRCOUNT                |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                NSCOUNT/UPCOUNT                |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    |                    ARCOUNT                    |
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+

where:

ID              A 16 bit identifier assigned by the program that
                generates any kind of query.  This identifier is copied
                the corresponding reply and can be used by the requester
                to match up replies to outstanding queries.

QR              A one bit field that specifies whether this message is a
                query (0), or a response (1).

OPCODE          A four bit field that specifies kind of query in this
                message.  This value is set by the originator of a query
                and copied into the response.  The values are:

                0               a standard query (QUERY)

                1               an inverse query (IQUERY)

                2               a server status request (STATUS)

                3-15            reserved for future use

AA              Authoritative Answer - this bit is valid in responses,
                and specifies that the responding name server is an
                authority for the domain name in question section.

                Note that the contents of the answer section may have
                multiple owner names because of aliases.  The AA bit

                corresponds to the name which matches the query name, or
                the first owner name in the answer section.

TC              TrunCation - specifies that this message was truncated
                due to length greater than that permitted on the
                transmission channel.

RD              Recursion Desired - this bit may be set in a query and
                is copied into the response.  If RD is set, it directs
                the name server to pursue the query recursively.
                Recursive query support is optional.

RA              Recursion Available - this be is set or cleared in a
                response, and denotes whether recursive query support is
                available in the name server.

Z               Reserved for future use.  Must be zero in all queries
                and responses.

AD              Authentic Data - signal indicating that the requester
                understands and is interested in the value of the AD bit
                in the response.  This allows a requester to indicate that
                it understands the AD bit without also requesting DNSSEC
                data via the DO bit.

CD              Checking Disabled

RCODE           Response code - this 4 bit field is set as part of
                responses.  The values have the following
                interpretation:

                0               No error condition

                1               Format error - The name server was
                                unable to interpret the query.

                2               Server failure - The name server was
                                unable to process this query due to a
                                problem with the name server.

                3               Name Error - Meaningful only for
                                responses from an authoritative name
                                server, this code signifies that the
                                domain name referenced in the query does
                                not exist.

                4               Not Implemented - The name server does
                                not support the requested kind of query.

                5               Refused - The name server refuses to
                                perform the specified operation for
                                policy reasons.  For example, a name
                                server may not wish to provide the
                                information to the particular requester,
                                or a name server may not wish to perform
                                a particular operation (e.g., zone

                                transfer) for particular data.

                6-15            Reserved for future use.

QDCOUNT         an unsigned 16 bit integer specifying the number of
                entries in the question section.

ANCOUNT         an unsigned 16 bit integer specifying the number of
                resource records in the answer section.

NSCOUNT         an unsigned 16 bit integer specifying the number of name
                server resource records in the authority records
                section.

ARCOUNT         an unsigned 16 bit integer specifying the number of
                resource records in the additional records section.
}
begin
  SetLength(Result, 12);
  UInt16ToTwoBytes(GStack.HostToNetwork(ID), Result, 0);
  UInt16ToTwoBytes(GStack.HostToNetwork(BitCode), Result, 2);
  UInt16ToTwoBytes(GStack.HostToNetwork(QDCount), Result, 4);
  UInt16ToTwoBytes(GStack.HostToNetwork(ANCount), Result, 6);
  UInt16ToTwoBytes(GStack.HostToNetwork(NSCount), Result, 8);
  UInt16ToTwoBytes(GStack.HostToNetwork(ARCount), Result, 10);
end;

function TDNSHeader.GetAA: UInt16;
begin
  Result := (FBitCode shr 10) and $0001;
end;

{
function TDNSHeader.GetAD: UInt16;
begin
  Result := (FBitCode shr 5) and $0001;
end;

function TDNSHeader.GetCD: UInt16;
begin
  Result := (FBitCode shr 4) and $0001;
end;
}

function TDNSHeader.GetOpCode: UInt16;
begin
  Result := (FBitCode shr 11) and $000F;
end;

function TDNSHeader.GetQr: UInt16;
begin
  Result := (FBitCode shr 15) and $0001;
end;

function TDNSHeader.GetRA: UInt16;
begin
  Result := (FBitCode shr 7) and $0001;
end;

function TDNSHeader.GetRCode: UInt16;
begin
  Result := FBitCode and $000F;
end;

function TDNSHeader.GetRD: UInt16;
begin
  Result := (FBitCode shr 8) and $0001;
end;

function TDNSHeader.GetTC: UInt16;
begin
  Result := (FBitCode shr 9) and $0001;
end;

function TDNSHeader.ParseQuery(Data: TIdBytes): integer;
begin
  Result := -1;
  if Length(Data) >= 12 then begin
    try
      ID      := GStack.NetworkToHost(BytesToUInt16(Data, 0));
      BitCode := GStack.NetworkToHost(BytesToUInt16(Data, 2));
      QDCount := GStack.NetworkToHost(BytesToUInt16(Data, 4));
      ANCount := GStack.NetworkToHost(BytesToUInt16(Data, 6));
      NSCount := GStack.NetworkToHost(BytesToUInt16(Data, 8));
      ARCount := GStack.NetworkToHost(BytesToUInt16(Data, 10));
      Result := 0;
    except
    end;
  end;
end;

procedure TDNSHeader.SetAA(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $FBFF;
  end else begin
    FBitCode := FBitCode or $0400;
  end;
end;

{
procedure TDNSHeader.SetAD(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $FFDF;
  end else begin
    FBitCode := FBitCode or $0020;
  end;
end;
}

procedure TDNSHeader.SetBitCode(const Value: UInt16);
begin
  FBitCode := Value;
end;

{
procedure TDNSHeader.SetCD(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $FFEF;
  end else begin
    FBitCode := FBitCode or $0010;
  end;
end;
}

procedure TDNSHeader.SetOpCode(const Value: UInt16);
begin
  FBitCode := (FBitCode and $87FF) or ((Value and $000F) shl 11);
end;

procedure TDNSHeader.SetQr(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $7FFF;
  end else begin
    FBitCode := FBitCode or $8000;
  end;
end;

procedure TDNSHeader.SetRA(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $FF7F;
  end else begin
    FBitCode := FBitCode or $0080;
  end;
end;

procedure TDNSHeader.SetRCode(const Value: UInt16);
begin
  FBitCode := (FBitCode and $FFF0) or (Value and $000F);
end;

procedure TDNSHeader.SetRD(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $FEFF;
  end else begin
    FBitCode := FBitCode or $0100;
  end;
end;

procedure TDNSHeader.SetTC(const Value: UInt16);
begin
  if Value = 0 then begin
    FBitCode := FBitCode and $FDFF;
  end else begin
    FBitCode := FBitCode or $0200;
  end;
end;


{ TIdTextModeResourceRecord }

function TIdTextModeResourceRecord.BinQueryRecord(AFullName: string): TIdBytes;
begin
  // This was empty? Where did it go?
  //todo;
  // Explain by Dennies : No, here must be empty, it's only a
  // virtual method, for child class to implement.
  Result := nil;
end;

procedure TIdTextModeResourceRecord.ClearAnswer;
begin
  SetLength(FAnswer, 0);
end;

constructor TIdTextModeResourceRecord.CreateInit(const ARRName: String; ATypeCode: Integer);
begin
  inherited Create;
  SetLength(FAnswer, 0);
  FRRName := ARRName;
  FTypeCode := ATypeCode;
  FRRDatas := TStringList.Create;
  TTL := 0;
end;

destructor TIdTextModeResourceRecord.Destroy;
begin
  FreeAndNil(FRRDatas);
  inherited Destroy;
end;

function TIdTextModeResourceRecord.FormatQName(const AFullName: string): string;
begin
  Result := FormatQName(FRRName, AFullName);
end;

function TIdTextModeResourceRecord.FormatQName(const AName, AFullName: string): string;
begin
  if Copy(AName, Length(AName), 1) <> '.' then begin
    Result := AName + '.' + AFullName;
  end else begin
    Result := AName;
  end;
end;

function TIdTextModeResourceRecord.FormatQNameFull(const AFullName: string): string;
var
  LQName: string;
begin
  LQName := FRRName + '.';
  if LQName <> AFullName then begin
    LQName := FormatQName(AFullName);
  end;
  if LQName = AFullName then begin
    Result := '@';
  end else begin
    Result := LQName;
  end;
end;

function TIdTextModeResourceRecord.FormatRecord(const AFullName: String; const ARRData: TIdBytes): TIdBytes;
var
  LDomain: TIdBytes;
  LIdx: Integer;
begin
  LDomain := DomainNameToDNSStr(FormatQName(AFullName));
  SetLength(Result, Length(LDomain)+(SizeOf(UInt16)*3)+SizeOf(UInt32)+Length(ARRData));
  LIdx := 0;
  IdBytesCopyBytes(LDomain, Result, LIdx);
  IdBytesCopyUInt16(GStack.HostToNetwork(UInt16(TypeCode)), Result, LIdx);
  IdBytesCopyUInt16(GStack.HostToNetwork(UInt16(Class_IN)), Result, LIdx);
  IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(TTL)), Result, LIdx);
  IdBytesCopyUInt16(GStack.HostToNetwork(UInt16(Length(ARRData))), Result, LIdx);
  IdBytesCopyBytes(ARRData, Result, LIdx);
end;

function TIdTextModeResourceRecord.GetValue(const AName: String): String;
begin
  Result := RRDatas.Values[AName];
end;

procedure TIdTextModeResourceRecord.SetValue(const AName: String; const AValue: String);
begin
  RRDatas.Values[AName] := AValue;
end;

function TIdTextModeResourceRecord.ifAddFullName(AFullName, AGivenName: string): boolean;
var
  LTailString, LBackString, LDestination : string;
  LTS, LRR : integer;
begin
  if AGivenName = '' then begin
    LDestination := RRName;
  end else begin
    LDestination := AGivenName;
  end;

  if TextEndsWith(LDestination, '.') then begin
    Result := False;
  end else begin
    if TextEndsWith(AFullName, '.') then begin
      LTailString := Copy(AFullName, 1, Length(AFullName) - 1);
    end else begin
      LTailString := AFullName;
    end;

    LTS := Length(LTailString);
    LRR := Length(LDestination);

    if LRR >= LTS then begin
      LBackString := Copy(LDestination, LRR - LTS + 1 , LTS);
      Result := not (LBackString = LTailString);
    end else begin
      Result := True;
    end;
  end;
end;

function TIdTextModeResourceRecord.ItemCount: integer;
begin
  Result := RRDatas.Count;
end;

procedure TIdTextModeResourceRecord.SetRRDatas(const Value: TStrings);
begin
  FRRDatas.Assign(Value);
end;

procedure TIdTextModeResourceRecord.SetTTL(const Value: integer);
begin
  FTTL := Value;
  FTimeOut := DateTimeToStr(AddMSecToTime(Now, Value * 1000));
end;

function TIdTextModeResourceRecord.TextRecord(AFullName: string): string;
begin
  Result := '';
end;

{ TIdTextModeRRs }

constructor TIdTextModeRRs.Create;
begin
  inherited Create;
  FItemNames := TStringList.Create;
end;

destructor TIdTextModeRRs.Destroy;
begin
  FreeAndNil(FItemNames);
  inherited Destroy;
end;

{$IFNDEF HAS_GENERICS_TObjectList}
function TIdTextModeRRs.GetItem(Index: Integer): TIdTextModeResourceRecord;
begin
  Result := TIdTextModeResourceRecord(inherited GetItem(Index));
end;

procedure TIdTextModeRRs.SetItem(Index: Integer; const Value: TIdTextModeResourceRecord);
begin
  inherited SetItem(Index, Value);
end;
{$ENDIF}

procedure TIdTextModeRRs.SetItemNames(const Value: TStrings);
begin
  FItemNames.Assign(Value);
end;

{ TIdRR_CName }

function TIdRR_CName.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(CName);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_CName.Create;
begin
  inherited CreateInit('CName', TypeCode_CName); {do not localize}
  CName := '';
end;

function TIdRR_CName.GetCName: String;
begin
  Result := GetValue('CName'); {do not localize}
end;

procedure TIdRR_CName.SetCName(const Value: String);
begin
  SetValue('CName', Value);  {do not localize}
end;

function TIdRR_CName.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'CNAME' + Chr(9) + CName + EOL;  {do not localize}
end;

{ TIdRR_HINFO }

function TIdRR_HINFO.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  if Length(FAnswer) = 0 then begin
    RRData := NormalStrToDNSStr(CPU);
    AppendBytes(RRData, NormalStrToDNSStr(OS));
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_HINFO.Create;
begin
  inherited CreateInit('HINFO', TypeCode_HINFO); {do not localize}
  CPU := '';
  OS := '';
end;

function TIdRR_HINFO.GetCPU: String;
begin
  Result := GetValue('CPU'); {do not localize}
end;

function TIdRR_HINFO.GetOS: String;
begin
  Result := GetValue('OS');  {do not localize}
end;

procedure TIdRR_HINFO.SetCPU(const Value: String);
begin
  SetValue('CPU', Value);  {do not localize}
end;

procedure TIdRR_HINFO.SetOS(const Value: String);
begin
  SetValue('OS', Value); {do not localize}
end;

function TIdRR_HINFO.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'HINFO' + Chr(9)
    + '"' + CPU + '" "' + OS + '"' + EOL; {do not localize}
end;

{ TIdRR_MB }

function TIdRR_MB.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(MADName);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_MB.Create;
begin
  inherited CreateInit('MB', TypeCode_MB);  {do not localize}
  MADName := '';
end;

function TIdRR_MB.GetMADName: String;
begin
  Result := GetValue('MADNAME'); {do not localize}
end;

procedure TIdRR_MB.SetMADName(const Value: String);
begin
  SetValue('MADNAME', Value);  {do not localize}
end;

function TIdRR_MB.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MB' + Chr(9) + MADName + EOL;  {do not localize}
end;

{ TIdRR_MG }

function TIdRR_MG.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(MGMName);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_MG.Create;
begin
  inherited CreateInit('MG', TypeCode_MG);  {do not localize}
  MGMName := '';
end;

function TIdRR_MG.GetMGMName: String;
begin
  Result := GetValue('MGMNAME'); {do not localize}
end;

procedure TIdRR_MG.SetMGMName(const Value: String);
begin
  SetValue('MGMNAME', Value);  {do not localize}
end;

function TIdRR_MG.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MG' + Chr(9) + MGMName + EOL; {do not localize}
end;

{ TIdRR_MINFO }

function TIdRR_MINFO.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
{
From: http://www.its.uq.edu.au/DMT/RFC/rfc1035.html#MINFO_RR
3.3.7. MINFO RDATA format (EXPERIMENTAL)

    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    /                    RMAILBX                    /
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
    /                    EMAILBX                    /
    +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
}
begin
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(Responsible_Mail);
    AppendBytes(RRData, DomainNameToDNSStr(ErrorHandle_Mail));
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_MINFO.Create;
begin
  inherited CreateInit('MINFO', TypeCode_MINFO); {do not localize}
  Responsible_Mail := '';
  ErrorHandle_Mail := '';
end;

function TIdRR_MINFO.GetEMail: String;
begin
  Result := GetValue('EMAILBX'); {do not localize}
end;

function TIdRR_MINFO.GetRMail: String;
begin
  Result := GetValue('RMAILBX'); {do not localize}
end;

procedure TIdRR_MINFO.SetErrorHandle_Mail(const Value: String);
begin
  SetValue('EMAILBX', Value);  {do not localize}
end;

procedure TIdRR_MINFO.SetResponsible_Mail(const Value: String);
begin
  SetValue('RMAILBX', Value);  {do not localize}
end;

function TIdRR_MINFO.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MINFO' + Chr(9)  {do not localize}
    + Responsible_Mail + ' ' + ErrorHandle_Mail + EOL; {do not localize}
end;

{ TIdRR_MR }

function TIdRR_MR.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(NewName);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_MR.Create;
begin
  inherited CreateInit('MR', TypeCode_MR);  {do not localize}
  NewName := '';
end;

function TIdRR_MR.GetNewName: String;
begin
  Result := GetValue('NewName'); {do not localize}
end;

procedure TIdRR_MR.SetNewName(const Value: String);
begin
  SetValue('NewName', Value);  {do not localize}
end;

function TIdRR_MR.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MR' + Chr(9) + NewName + EOL; {do not localize}
end;

{ TIdRR_MX }

function TIdRR_MX.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData, Tmp: TIdBytes;
  Pref : UInt16;
begin
  Tmp := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    Pref := IndyStrToInt(Preference);
    RRData := ToBytes(GStack.HostToNetwork(Pref));
    Tmp := DomainNameToDNSStr(FormatQName(Exchange,AFullName));
    AppendBytes(RRData, Tmp);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_MX.Create;
begin
  inherited CreateInit('MX', TypeCode_MX);  {do not localize}
  Exchange := '';
end;

function TIdRR_MX.GetExchang: String;
begin
  Result := GetValue('EXCHANGE');  {do not localize}
end;

function TIdRR_MX.GetPref: String;
begin
  Result := GetValue('PREF');  {do not localize}
end;

procedure TIdRR_MX.SetExchange(const Value: String);
begin
  SetValue('EXCHANGE', Value); {do not localize}
end;

procedure TIdRR_MX.SetPref(const Value: String);
begin
  SetValue('PREF', Value); {do not localize}
end;

function TIdRR_MX.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MX' + Chr(9) {do not localize}
    + Preference + ' ' + Exchange + EOL; {do not localize}
end;

{ TIdRR_NS }

function TIdRR_NS.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(NSDName);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_NS.Create;
begin
  inherited CreateInit('NS', TypeCode_NS);  {do not localize}
  NSDName := '';
end;

function TIdRR_NS.GetNS: String;
begin
  Result := GetValue('NSDNAME'); {do not localize}
end;

procedure TIdRR_NS.SetNS(const Value: String);
begin
  SetValue('NSDNAME', Value);  {do not localize}
end;

function TIdRR_NS.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'NS' + Chr(9) + NSDName + EOL; {do not localize}
end;

{ TIdRR_PTR }

function TIdRR_PTR.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := DomainNameToDNSStr(PTRDName);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_PTR.Create;
begin
  inherited CreateInit('PTR', TypeCode_PTR); {do not localize}
  PTRDName := '';
end;

function TIdRR_PTR.GetPTRName: String;
begin
  Result := GetValue('PTRDNAME');  {do not localize}
end;

procedure TIdRR_PTR.SetPTRName(const Value: String);
begin
  SetValue('PTRDNAME', Value); {do not localize}
end;

function TIdRR_PTR.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'PTR' + Chr(9) + PTRDName + EOL; {do not localize}
end;

{ TIdRR_SOA }

function TIdRR_SOA.BinQueryRecord(AFullName: string): TIdBytes;
var
  LMName, LRName, RRData: TIdBytes;
  LIdx: Integer;
begin
  // keep the compiler happy
  LMName := nil; 
  LRName := nil;
  RRData := nil;

  if Length(FAnswer) = 0 then begin
    LMName := DomainNameToDNSStr(MName);
    LRName := DomainNameToDNSStr(RName);

    SetLength(RRData, Length(LMName)+Length(LRName)+(SizeOf(UInt32)*5));

    LIdx := 0;
    IdBytesCopyBytes(LMName, RRData, LIdx);
    IdBytesCopyBytes(LRName, RRData, LIdx);

    IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Serial))), RRData, LIdx);
    IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Refresh))), RRData, LIdx);
    IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Retry))), RRData, LIdx);
    IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Expire))), RRData, LIdx);
    IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Minimum))), RRData, LIdx);

    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_SOA.Create;
begin
  inherited CreateInit('SOA', TypeCode_SOA); {do not localize}
  MName := '';
  RName := '';
  Serial := '';
  Refresh := '';
  Retry := '';
  Expire := '';
  Minimum := '';
end;

function TIdRR_SOA.GetExpire: String;
begin
  Result := GetName('EXPIRE'); {do not localize}
end;

function TIdRR_SOA.GetMin: String;
begin
  Result := GetName('MINIMUM');  {do not localize}
end;

function TIdRR_SOA.GetMName: String;
begin
  Result := GetName('MNAME');  {do not localize}
end;

function TIdRR_SOA.GetName(const CLabel: String): String;
begin
  Result := GetValue(CLabel);
end;

function TIdRR_SOA.GetRefresh: String;
begin
  Result := GetName('REFRESH');  {do not localize}
end;

function TIdRR_SOA.GetRetry: String;
begin
  Result := GetName('RETRY');  {do not localize}
end;

function TIdRR_SOA.GetRName: String;
begin
  Result := GetName('RNAME');  {do not localize}
end;

function TIdRR_SOA.GetSerial: String;
begin
  Result := GetName('SERIAL'); {do not localize}
end;

procedure TIdRR_SOA.SetExpire(const Value: String);
begin
  SetName('EXPIRE', Value);  {do not localize}
end;

procedure TIdRR_SOA.SetMin(const Value: String);
begin
  SetName('MINIMUM', Value); {do not localize}
end;

procedure TIdRR_SOA.SetMName(const Value: String);
begin
  SetName('MNAME', Value); {do not localize}
end;

procedure TIdRR_SOA.SetName(const CLabel: String; const Value: String);
begin
  SetValue(CLabel, Value);
end;

procedure TIdRR_SOA.SetRefresh(const Value: String);
begin
  SetName('REFRESH', Value); {do not localize}
end;

procedure TIdRR_SOA.SetRetry(const Value: String);
begin
  SetName('RETRY', Value); {do not localize}
end;

procedure TIdRR_SOA.SetRName(const Value: String);
begin
  SetName('RNAME', Value); {do not localize}
end;

procedure TIdRR_SOA.SetSerial(const Value: String);
begin
  SetName('SERIAL', Value);  {do not localize}
end;

function TIdRR_SOA.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'SOA' + Chr(9) {do not localize}
    + MName + ' ' + RName + ' ' + Serial + ' ' + Refresh + ' ' + Retry + ' ' {do not localize}
    + Expire + ' ' + Minimum + EOL; {do not localize}
end;

{ TIdRR_A }

function TIdRR_A.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(Self.FAnswer) = 0 then begin
    RRData := IPAddrToDNSStr(Address);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_A.Create;
begin
  inherited CreateInit('A', TypeCode_A);   {do not localize}
  Address := '';
end;

function TIdRR_A.GetA: String;
begin
  Result := GetValue('A'); {do not localize}
end;

procedure TIdRR_A.SetA(const Value: String);
begin
  SetValue('A', Value);  {do not localize}
end;

function TIdRR_A.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'A' + Chr(9) + Address + EOL; {do not localize}
end;

{ TIdRR_AAAA }

function TIdRR_AAAA.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    RRData := IPv6AAAAToDNSStr(Address);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_AAAA.Create;
begin
  inherited CreateInit('AAAA', TypeCode_AAAA);  {do not localize}
  Address := '';
end;

function TIdRR_AAAA.GetA: String;
begin
  Result := GetValue('AAAA');  {do not localize}
end;

procedure TIdRR_AAAA.SetA(const Value: String);
begin
  SetValue('AAAA', Value); {do not localize}
end;

function TIdRR_AAAA.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'AAAA' + Chr(9) + Address + EOL; {do not localize}
end;

{ TIdRR_TXT }

function TIdRR_TXT.BinQueryRecord(AFullName: string): TIdBytes;
var
  RRData: TIdBytes;
begin
  RRData := nil; // keep the compiler happy
  if Length(FAnswer) = 0 then begin
    //Fix here, make the RRData being DNSStr.
    //Fixed in 2005 Jan 25.
    RRData := NormalStrToDNSStr(TXT);
    FAnswer := FormatRecord(AFullName, RRData);
  end;
  Result := ToBytes(FAnswer, Length(FAnswer));
end;

constructor TIdRR_TXT.Create;
begin
  inherited CreateInit('TXT', TypeCode_TXT); {do not localize}
  TXT := '';
end;

function TIdRR_TXT.GetTXT: String;
begin
  Result := GetValue('TXT'); {do not localize}
end;

procedure TIdRR_TXT.SetTXT(const Value: String);
begin
  SetValue('TXT', Value);  {do not localize}
end;

function TIdRR_TXT.TextRecord(AFullName: string): string;
begin
  Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'TXT' + Chr(9) {do not localize}
    + '"' + TXT + '"' + EOL; {do not localize}
end;

{ TIdRR_WKS }

constructor TIdRR_WKS.Create;
begin
  inherited CreateInit('WKS', TypeCode_WKS); {do not localize}
end;

{ TIdRR_Error }

constructor TIdRR_Error.Create;
begin
   inherited CreateInit('', TypeCode_Error); {do not localize}
end;

function ReplaceSpecString(Source, Target, NewString : string; ReplaceAll : boolean = True) : string;
var
  FixingString, MiddleString, FixedString : string;
begin
  if Target = NewString then begin
    Result := Source;
  end else begin
    FixingString := Source;
    MiddleString := '';                     {do not localize}
    FixedString := '';                      {do not localize}

    if Pos(Target, Source) > 0 then begin
      repeat
        MiddleString := Fetch(FixingString, Target);
        FixedString := FixedString + MiddleString + NewString;
      until (Pos(Target, FixingString) = 0) or (not ReplaceAll);
      Result := FixedString + FixingString;
    end else begin
      Result := Source;
    end;
  end;
end;

function IsBig5(ch1, ch2:char) : boolean;
begin
  // RLebeau 1/7/09: using Char() for #128-#255 because in D2009, the compiler
  // may change characters >= #128 from their Ansi codepage value to their true
  // Unicode codepoint value, depending on the codepage used for the source code.
  // For instance, #128 may become #$20AC...

  if (not (((ch1 >= Char(161)) and (ch1 <= Char(254))) or
    ((ch1 >= Char(142)) and (ch1 <= Char(160))) or
    ((ch1 >= Char(129)) and (ch1 <= Char(141)))) ) or
    (not (((ch2 >= #64) and (ch2 <= #126)) or
    ((ch2 >= Char(161)) and (ch2 <= Char(254)))) ) then
   begin
    Result := False;
  end else begin
    Result := True;
  end;
end;

end.