units/indy/IdDNSResolver.pas

   1 // 29-nov-2002
   2 unit IdDNSResolver;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } ,KOLClasses,
   8   IdResourceStrings,
   9   SysUtils,
  10   IdGlobal,
  11   IdUDPClient;
  12
  13 const
  14   IdDNSResolver_ReceiveTimeout = 4000;
  15
  16 const
  17   //fBitCode Bits and Masks
  18   cQRBit = $8000; //QR when 0 = Question when 1 Response
  19   cQRMask = $EFFF;
  20   cOpCodeBits = $7800; //Operation Code See Constansts Defined Below
  21   cOpCodeMask = $87FF;
  22   cAABit = $0400; //Valid in Responses Authoritative Answer if set (1)
  23   cAAMask = $FBFF;
  24   cTCBit = $0200; //Truncation Bit if Set Messages was truncated for length
  25   cTCMask = $FDFF;
  26   cRDBit = $0100; //If set(1) Recursive Search is Resquested by Query
  27   cRDMask = $FEFF;
  28   cRABit = $0080; //If set(1) Server supports Recursive Search (Available)
  29   cRAMask = $FF7F;
  30   cRCodeBits = $000F; //Response Code. See Constansts Defined Below
  31   cRCodeMask = $FFF0;
  32
  33    //Question Operation Code Values
  34   cResQuery = 0;
  35   cResIQuery = 1;
  36   cResStatus = 2;
  37   cOPCodeStrs: array[cResQuery..cResStatus] of string[7] =
  38   ('Query',
  39     'IQuery',
  40     'Status');
  41
  42   // QType Identifes the type of Question
  43   cA = 1; // a Host Address
  44   cNS = 2; // An Authoritative name server
  45   cMD = 3; // A mail destination obsolete use MX (OBSOLETE)
  46   cMF = 4; // A mail forwarder obsolete use MX   (OBSOLETE)
  47   cName = 5; // The canonical name for an alias
  48   cSOA = 6; // Marks the start of a zone of authority
  49   cMB = 7; // A mail box domain name (Experimental)
  50   cMG = 8; // A mail group member (Experimental)
  51   cMR = 9; // A mail Rename Domain Name (Experimental)
  52   cNULL = 10; // RR (Experimental)
  53   cWKS = 11; // A well known service description
  54   cPTR = 12; // A Domain Name Pointer;
  55   cHINFO = 13; // Host Information;
  56   cMINFO = 14; // Mailbox or Mail List Information;
  57   cMX = 15; // Mail Exchange
  58   cTXT = 16; // Text String;
  59   cAXFR = 252; // A Request for the Transfer of an entire zone;
  60   cMAILB = 253; // A request for mailbox related records (MB MG OR MR}
  61   cMAILA = 254; // A request for mail agent RRs (Obsolete see MX)
  62   cStar = 255; // A Request for all Records
  63
  64   //QClass
  65   cIN = 1; //The Internet
  66   cCS = 2; // the CSNet Obsolete
  67   cCH = 3; // The Chaos Claee
  68   cHS = 4; // Hesiod [Dyer 87]
  69
  70   //CStar any Class is same as QType for all records;
  71   cQClassStr: array[cIN..CHs] of string[3] =
  72   ('IN', 'CS', 'CH', 'HS');
  73
  74   //Sever Response codes (RCode)
  75   cRCodeNoError = 0;
  76   cRCodeFormatErr = 1;
  77   cRCodeServerErr = 2;
  78   cRCodeNameErr = 3;
  79   cRCodeNotImplemented = 4;
  80   cRCodeRefused = 5;
  81
  82   cRCodeStrs: array[cRCodeNoError..cRCodeRefused] of string =
  83   (RSCodeNoError,
  84     RSCodeQueryFormat,
  85     RSCodeQueryServer,
  86     RSCodeQueryName,
  87     RSCodeQueryNotImplemented,
  88     RSCodeQueryQueryRefused);
  89
  90 type
  91   TWKSBits = array[0..7] of byte;
  92
  93   TRequestedRecord = cA..cStar;
  94
  95   TRequestedRecords = set of TRequestedRecord;
  96
  97   TIdDNSHeader = object(TObj)
  98   protected
  99     FAnCount: Word;
 100     FArCount: Word;
 101     FBitCode: Word;
 102     FId: Word;
 103     FQdCount: Word;
 104     FNsCount: Word;
 105     function GetAA: Boolean;
 106     function GetOpCode: Word;
 107     function GetQr: Boolean;
 108     function GetRA: Boolean;
 109     function GetRCode: Word;
 110     function GetRD: Boolean;
 111     function GetTC: Boolean;
 112     procedure InitializefId;
 113     procedure SetAA(AuthAnswer: Boolean);
 114 //    procedure SetOpCode(OpCode: Word);
 115     procedure SetQr(IsResponse: Boolean);
 116     procedure SetRA(RecursionAvailable: Boolean);
 117 //    procedure SetRCode(RCode: Word);
 118     procedure SetRD(RecursionDesired: Boolean);
 119     procedure SetTC(IsTruncated: Boolean);
 120   public
 121      { constructor Create;
 122      } procedure InitVars; virtual;
 123     //
 124     property AA: boolean read GetAA write SetAA;
 125     property ANCount: Word read FAnCount write FAnCount;
 126     property ARCount: Word read FArCount write FArCount;
 127     property ID: Word read FId write FId;
 128     property NSCount: Word read FNsCount write FNsCount;
 129 //    property Opcode: Word read GetOpCode write SetOpCode;
 130     property QDCount: Word read FQdCount write FQdCount;
 131     property Qr: Boolean read GetQr write SetQr;
 132     property RA: Boolean read GetRA write SetRA;
 133 //    property RCode: Word read GetRCode write SetRCode;
 134     property RD: Boolean read GetRD write SetRD;
 135     property TC: Boolean read GetTC write SetTC;
 136   end;
 137 PIdDNSHeader=^TIdDNSHeader;
 138 function NewIdDNSHeader:PIdDNSHeader;
 139
 140 type
 141
 142   TQuestionItem = object(TCollectionItem)
 143   public
 144     QClass: Word;
 145     QName: string;
 146     QType: Word;
 147   end;
 148 PQuestionItem=^TQuestionItem;
 149 function NewQuestionItem:PQuestionItem;
 150
 151 type
 152
 153   TIdDNSQuestionList = object(TCollection)
 154   protected
 155     function GetItem(Index: Integer): TQuestionItem;
 156     procedure SetItem(Index: Integer; const Value: TQuestionItem);
 157   public
 158      { constructor Create;  }// reintroduce;
 159     function Add: TQuestionItem;
 160     property Items[Index: Integer]: TQuestionItem read GetItem write SetItem;
 161       default;
 162   end;
 163 PIdDNSQuestionList=^TIdDNSQuestionList;
 164 function NewIdDNSQuestionList:PIdDNSQuestionList;
 165
 166 type
 167
 168   THInfo = record
 169     CPUStr: ShortString;
 170     OsStr: ShortString;
 171   end;
 172
 173   TMInfo = record
 174     EMailBox: ShortString;
 175     RMailBox: ShortString;
 176   end;
 177
 178   TMX = record
 179     Exchange: ShortString;
 180     Preference: Word;
 181   end;
 182
 183   TSOA = record
 184     Expire: Cardinal;
 185     Minimum: Cardinal;
 186     MName: ShortString;
 187     Refresh: Cardinal;
 188     Retry: Cardinal;
 189     RName: ShortString;
 190     Serial: Cardinal;
 191   end;
 192
 193   TWKS = record
 194     Address: Cardinal;
 195     Bits: TWKSBits;
 196     Protocol: byte;
 197   end;
 198
 199   TRdata = record
 200     DomainName: string;
 201     HInfo: THInfo;
 202     MInfo: TMInfo;
 203     MX: TMx;
 204     SOA: TSOA;
 205     A: Cardinal;
 206     WKS: TWks;
 207     Data: string;
 208     HostAddrStr: string;
 209   end;
 210
 211   TIdDNSResourceItem = object(TCollectionITem)
 212   public
 213     AType: Word;
 214     AClass: Word;
 215       Name: string;
 216     RData: TRData;
 217     RDLength: Word;
 218     TTL: Cardinal;
 219     StarData: string;
 220   end;
 221 PIdDNSResourceItem=^TIdDNSResourceItem;
 222 function NewIdDNSResourceItem:PIdDNSResourceItem;
 223
 224 type
 225
 226   TIdDNSResourceList = object(TCollection)
 227   protected
 228     function GetItem(Index: Integer): TIdDNSResourceItem;
 229     procedure SetItem(Index: Integer; const Value: TIdDNSResourceItem);
 230   public
 231     function Add: TIdDNSResourceItem;
 232      { constructor Create;  }// reintroduce;
 233     property Items[Index: Integer]: TIdDNSResourceItem read GetItem write
 234       SetItem; default;
 235    { published }
 236     function GetDNSMxExchangeNameEx(Idx: Integer): string;
 237     function GetDNSRDataDomainName(Idx: Integer): string;
 238   end;
 239 PIdDNSResourceList=^TIdDNSResourceList;
 240 function NewIdDNSResourceList:PIdDNSResourceList;
 241
 242  type
 243
 244   TMXRecord = object(TIdDNSResourceItem)
 245   protected
 246     FPreference: Word;
 247     FExchange: string;
 248   public
 249     property Preference: Word read FPreference;
 250     property Exchange: string read FExchange;
 251   end;
 252 PMXRecord=^TMXRecord;
 253 function NewMXRecord:PMXRecord;
 254
 255 type
 256
 257   TARecord = object(TIdDNSResourceItem)
 258   protected
 259     FDomainName: string;
 260   public
 261     property DomainName: string read FDomainName;
 262   end;
 263 PARecord=^TARecord;
 264 function NewARecord:PARecord;
 265
 266 type
 267
 268   TNameRecord = object(TIdDNSResourceItem)
 269   protected
 270     FDomainName: string;
 271   public
 272     property DomainName: string read FDomainName;
 273   end;
 274 PNameRecord=^TNameRecord;
 275 function NewNameRecord:PNameRecord;
 276
 277  type
 278   TPTRRecord = object(TIdDNSResourceItem)
 279   protected
 280     FDomainName: string;
 281   public
 282     property DomainName: string read FDomainName;
 283   end;
 284 PPTRRecord=^TPTRRecord;
 285 function NewPTRRecord:PPTRRecord;
 286 type
 287
 288   THInfoRecord = object(TIdDNSResourceItem)
 289   protected
 290     FCPUStr: string;
 291     FOsStr: string;
 292   public
 293     property CPUStr: string read FCPUStr;
 294     property OsStr: string read FOsStr;
 295   end;
 296 PHInfoRecord=^THInfoRecord;
 297 function NewHInfoRecord:PHInfoRecord;
 298 type
 299
 300   TMInfoRecord = object(TIdDNSResourceItem)
 301   protected
 302     FEMmailBox: string;
 303     FRMailBox: string;
 304   public
 305     property EMmailBox: string read FEMmailBox;
 306     property RMailBox: string read FRMailBox;
 307   end;
 308 PMInfoRecord=^TMInfoRecord;
 309 function NewMInfoRecord:PMInfoRecord;
 310 type
 311
 312   TMRecord = object(TIdDNSResourceItem)
 313   protected
 314     FEMailBox: string;
 315     FRMailBox: string;
 316   public
 317     property EMailBox: string read FEMailBox;
 318     property RMailBox: string read FRMailBox;
 319   end;
 320 PMRecord=^TMRecord;
 321 function NewMRecord:PMRecord;
 322 type
 323
 324   TSOARecord = object(TIdDNSResourceItem)
 325   protected
 326     FExpire: Cardinal;
 327     FMinimum: Cardinal;
 328     FMName: string;
 329     FRefresh: Cardinal;
 330     FRetry: Cardinal;
 331     FRName: string;
 332     FSerial: Cardinal;
 333   public
 334     property Expire: Cardinal read FExpire;
 335     property Minimum: Cardinal read FMinimum;
 336     property MName: string read FMName;
 337     property Refresh: Cardinal read FRefresh;
 338     property Retry: Cardinal read FRetry;
 339     property RName: string read FRName;
 340     property Serial: Cardinal read FSerial;
 341   end;
 342 PSOARecord=^TSOARecord;
 343 function NewSOARecord:PSOARecord;
 344
 345 type
 346
 347   TWKSRecord = object(TIdDNSResourceItem)
 348   protected
 349     FAddress: Cardinal;
 350     FBits: TWKSBits;
 351     FProtocol: byte;
 352
 353     function GetBits(AIndex: Integer): Byte;
 354   public
 355     property Address: Cardinal read FAddress;
 356     property Bits[AIndex: Integer]: Byte read GetBits;
 357     property Protocol: byte read FProtocol;
 358   end;
 359 PWKSRecord=^TWKSRecord;
 360 function NewTWKSRecord:PWKSRecord;
 361 type
 362
 363   TIdDNSResolver = object(TIdUDPClient)
 364   protected
 365     FDNSAnList: TIdDNSResourceList;
 366     FDNSArList: TIdDNSResourceList;
 367     FDNSHeader: TIdDNSHeader;
 368     FDNSQdList: TIdDNSQuestionList;
 369     FDNSNsList: TIdDNSResourceList;
 370     FQPacket: string;
 371     FRPacket: string;
 372     FQPackSize: Integer;
 373     FRequestedRecords: TRequestedRecords;
 374     FRPackSize: Integer;
 375
 376     FAnswers: TIdDNSResourceList;
 377
 378     function CreateLabelStr(QName: string): string;
 379     procedure CreateQueryPacket;
 380     procedure DecodeReplyPacket;
 381   public
 382     procedure ClearVars; virtual;
 383      { constructor Create(AOwner: TComponent); override;
 384      } destructor Destroy;
 385      virtual; procedure ResolveDNS;
 386     procedure ResolveDomain(const ADomain: string);
 387
 388     property Answers: TIdDNSResourceList read FAnswers;
 389     property DNSAnList: TIdDNSResourceList read FDnsAnList write FDnsAnList;
 390     property DNSARList: TIdDNSResourceList read FDnsArList write FDnsArList;
 391     property DNSHeader: TIdDNSHeader read FDNSHeader write FDNSHeader;
 392     property DNSQDList: TIdDNSQuestionList read FDnsQdList write FDnsQdList;
 393     property DNSNSList: TIdDNSResourceList read FDnsNsList write FDnsNsList;
 394     property Port default IdPORT_DOMAIN;
 395     property QPacket: string read FQPacket write FQpacket;
 396     property RequestedRecords: TRequestedRecords read FRequestedRecords write
 397       FRequestedRecords;
 398     property RPacket: string read FRPacket write FRPacket;
 399 //    property ReceiveTimeout default IdDNSResolver_ReceiveTimeout;
 400   end;
 401 PIdDNSResolver=^TIdDNSResolver;
 402 function NewIdDNSResolver(AOwner: PControl):PIdDNSResolver;
 403 type
 404
 405   HiLoBytes = record
 406     HiByte: Byte;
 407     LoByte: Byte;
 408   end;
 409
 410   WordRec = record
 411     case byte of
 412       1: (TheBytes: HiLoBytes);
 413       2: (AWord: Word);
 414   end;
 415
 416   HiLoWords = record
 417     HiWord,
 418       LowWord: Word;
 419   end;
 420
 421   CardinalRec = record
 422     case Byte of
 423       1: (aCardinal: Cardinal);
 424       2: (Words: HILoWords);
 425   end;
 426
 427 function GetQTypeStr(aQType: Integer): string;
 428 function GetQClassStr(QClass: Integer): string;
 429
 430 implementation
 431
 432 {uses
 433   IdException;}
 434
 435 function TwoCharToWord(AChar1, AChar2: Char): Word;
 436 begin
 437   Result := Word((Ord(AChar1) shl 8) and $FF00) or Word(Ord(AChar2) and $00FF);
 438 end;
 439
 440 function FourCharToCardinal(AChar1, AChar2, AChar3, AChar4: Char): Cardinal;
 441 var
 442   ARes: CardinalRec;
 443 begin
 444   ares.Words.HiWord := TwoCharToWord(AChar1, AChar2);
 445   aRes.Words.LowWord := TwoCharToWord(AChar3, AChar4);
 446   Result := ARes.aCardinal;
 447 end;
 448
 449 function WordToTwoCharStr(AWord: Word): string;
 450 begin
 451   Result := Chr(Hi(AWord)) + Chr(Lo(AWord));
 452 end;
 453
 454 function GetRCodeStr(RCode: Integer): string;
 455 begin
 456   if Rcode in [cRCodeNoError..cRCodeRefused] then
 457   begin
 458     Result := cRCodeStrs[Rcode];
 459   end
 460   else
 461   begin
 462     Result := RSCodeQueryUnknownError;
 463   end;
 464 end;
 465
 466 function GetQTypeStr(aQType: Integer): string;
 467 begin
 468   case AQType of
 469     cA: Result := 'A'; // a Host Address
 470     cNS: Result := 'NS'; // An Authoritative name server
 471     cMD: Result := 'MD'; // A mail destination obsolete use MX (OBSOLETE)
 472     cMF: Result := 'MF'; // A mail forwarder obsolete use MX   (OBSOLETE)
 473     cName: Result := 'NAME'; // The canonical name for an alias
 474     cSOA: Result := 'SOA'; // Marks the start of a zone of authority
 475     cMB: Result := 'MB'; // A mail box domain name (Experimental)
 476     cMG: Result := 'MG'; // A mail group member (Experimental)
 477     cMR: Result := 'MR'; // A mail Rename Domain Name (Experimental)
 478     cNULL: Result := 'NULL'; // RR (Experimental)
 479     cWKS: Result := 'WKS'; // A well known service description
 480     cPTR: Result := 'PTR'; // A Domain Name Pointer;
 481     cHINFO: Result := 'HINFO'; // Host Information;
 482     cMINFO: Result := 'MINFO'; // Mailbox or Mail List Information;
 483     cMX: Result := 'MX'; // Mail Exchange
 484     cTXT: Result := 'TXT'; // Text String;
 485     cAXFR: Result := 'AXFR'; // A Request for the Transfer of an entire zone;
 486     cMAILB: Result := 'MAILB';
 487       // A request for mailbox related records (MB MG OR MR}
 488     cMAILA: Result := 'MAILA'; // A request for mail agent RRs (Obsolete see MX)
 489     cStar: Result := '*'; // A Request for all Records
 490   else
 491     Result := IntToSTr(aQType);
 492   end;
 493 end;
 494
 495 function GetQClassStr(QClass: Integer): string;
 496 begin
 497   if QClass in [cIN..CHs] then
 498   begin
 499     Result := cQClassStr[QClass];
 500   end
 501   else
 502   begin
 503     if QClass = 15 then
 504     begin
 505       Result := 'MX';
 506     end
 507     else
 508     begin
 509       Result := IntToStr(QClass);
 510     end;
 511   end;
 512 end;
 513
 514 function GetErrorStr(Code, Id: Integer): string;
 515 begin
 516   case code of
 517     1: Result := Format(RSQueryInvalidQueryCount, [Id]);
 518     2: Result := Format(RSQueryInvalidPacketSize, [InttoSTr(Id)]);
 519     3: Result := Format(RSQueryLessThanFour, [Id]);
 520     4: Result := Format(RSQueryInvalidHeaderID, [Id]);
 521     5: Result := Format(RSQueryLessThanTwelve, [Id]);
 522     6: Result := Format(RSQueryPackReceivedTooSmall, [Id]);
 523   end;
 524 end;
 525
 526 //constructor TIdDNSHeader.Create;
 527 function NewIdDNSHeader:PIdDNSHeader;
 528 begin
 529 //  inherited Create;
 530   New( Result, Create );
 531 with Result^ do
 532   InitialIzeFid;
 533 end;
 534
 535 procedure TIdDNSHeader.InitializefId;
 536 begin
 537   Randomize;
 538   fId := Random(10000);
 539 end;
 540
 541 procedure TIdDNSHeader.InitVars;
 542 begin
 543   fBitCode := 0;
 544     { Holds Qr,OPCode AA TC RD RA RCode and Reserved Bits           }
 545   fQdCount := 0;
 546     { Number of Question Entries in Question Section                }
 547   fAnCount := 0;
 548     { Number of Resource Records in Answer Section                  }
 549   fNsCount := 0;
 550     { Number of Name Server Resource Recs in  Authority Rec Section }
 551   fArCount := 0;
 552     { Number of Resource Records in Additional records Section      }
 553 end;
 554
 555 function TIdDNSHeader.GetQR: Boolean;
 556 begin
 557   Result := (fBitCode and cQRBit) = cQRBit;
 558 end;
 559
 560 procedure TIdDNSHeader.SetQr(IsResponse: Boolean);
 561 begin
 562   if IsResponse then
 563   begin
 564     fBitCode := fBitCode or cQRBit;
 565   end
 566   else
 567   begin
 568     fBitCode := fBitCode and cQRMask
 569   end;
 570 end;
 571
 572 function TIdDNSHeader.GetOpCode: Word;
 573 begin
 574   Result := ((fBitCode and cOpCodeBits) shr 11) and $000F;
 575 end;
 576
 577 {procedure TIdDNSHeader.SetOpCode(OpCode: Word);
 578 begin
 579   fBitCode := ((OpCode shl 11) and cOpCodeBits) or
 580     (fBitCode and cOpCodeMask);
 581 end;}
 582
 583 function TIdDNSHeader.GetAA: Boolean;
 584 begin
 585   Result := (fBitCode and cAABit) = cAABit;
 586 end;
 587
 588 procedure TIdDNSHeader.SetAA(AuthAnswer: Boolean);
 589 begin
 590   if AuthAnswer then
 591   begin
 592     fBitCode := fBitCode or cAABit;
 593   end
 594   else
 595   begin
 596     fBitCode := fBitCode and cAAMask;
 597   end;
 598 end;
 599
 600 function TIdDNSHeader.GetTC: Boolean;
 601 begin
 602   Result := (fBitCode and cTCBit) = cTCBit;
 603 end;
 604
 605 procedure TIdDNSHeader.SetTC(IsTruncated: Boolean);
 606 begin
 607   if IsTruncated then
 608   begin
 609     fBitCode := fBitCode or cTCBit;
 610   end
 611   else
 612   begin
 613     fBitCode := fBitCode and cTCMask;
 614   end;
 615 end;
 616
 617 function TIdDNSHeader.GetRD: Boolean;
 618 begin
 619   Result := (fBitCode and cRDBit) = cRDBit;
 620 end;
 621
 622 procedure TIdDNSHeader.SetRD(RecursionDesired: Boolean);
 623 begin
 624   if RecursionDesired then
 625   begin
 626     fBitCode := fBitCode or cRDBit;
 627   end
 628   else
 629   begin
 630     fBitCode := fBitCode and cRDMask;
 631   end;
 632 end;
 633
 634 function TIdDNSHeader.GetRA: Boolean;
 635 begin
 636   Result := (fBitCode and cRABit) = cRABit;
 637 end;
 638
 639 procedure TIdDNSHeader.SetRA(RecursionAvailable: Boolean);
 640 begin
 641   if RecursionAvailable then
 642   begin
 643     fBitCode := fBitCode or cRABit;
 644   end
 645   else
 646   begin
 647     fBitCode := fBitCode and cRAMask;
 648   end;
 649 end;
 650
 651 function TIdDNSHeader.GetRCode: Word;
 652 begin
 653   Result := (fBitCode and cRCodeBits);
 654 end;
 655
 656 {procedure TIdDNSHeader.SetRCode(RCode: Word);
 657 begin
 658   fBitCode := (RCode and cRCodeBits) or (fBitCode and cRCodeMask);
 659 end;}
 660
 661 function TIdDNSQuestionList.Add: TQuestionItem;
 662 begin
 663 //  Result := TQuestionItem(inherited Add);
 664 end;
 665
 666 //constructor TIdDNSQuestionList.Create;
 667 function NewIdDNSQuestionList:PIdDNSQuestionList;
 668 begin
 669   New( Result, Create );
 670 //  inherited Create(TQuestionItem);
 671 end;
 672
 673 function TIdDNSQuestionList.GetItem(Index: Integer): TQuestionItem;
 674 begin
 675 //  Result := TQuestionItem(inherited Items[Index]);
 676 end;
 677
 678 procedure TIdDNSQuestionList.SetItem(Index: Integer;
 679   const Value: TQuestionItem);
 680 begin
 681 //  inherited SetItem(Index, Value);
 682 end;
 683
 684 //constructor TIdDNSResourceList.Create;
 685 function NewIdDNSResourceList:PIdDNSResourceList;
 686 begin
 687   New( Result, Create );
 688 //  inherited Create(TIdDNSResourceItem);
 689 end;
 690
 691 function TIdDNSResourceList.GetDNSRDataDomainName(Idx: Integer): string;
 692 begin
 693   if (Idx < Count) and (Idx >= 0) then
 694   begin
 695     Result := TIdDNSResourceItem(Items[Idx]).RData.DomainName;
 696   end
 697   else
 698     Result := '';
 699 end;
 700
 701 function TIdDNSResourceList.GetDnsMxExchangeNameEx(Idx: Integer): string;
 702 begin
 703   if (Idx < Count) and (Idx >= 0) then
 704   begin
 705     Result :=
 706       IntToStr(TIdDNSResourceItem(Items[Idx]).RData.MX.Preference);
 707     while Length(Result) < 5 do
 708     begin
 709       Result := ' ' + Result;
 710     end;
 711     Result :=
 712       Result + ' ' + TIdDNSResourceItem(Items[Idx]).RData.MX.Exchange;
 713   end
 714   else
 715   begin
 716     Result := '';
 717   end;
 718 end;
 719
 720 function TIdDNSResourceList.Add: TIdDNSResourceItem;
 721 begin
 722 //  Result := TIdDNSResourceItem(inherited Add);
 723 end;
 724
 725 function TIdDNSResourceList.GetItem(Index: Integer): TIdDNSResourceItem;
 726 begin
 727 //  Result := TIdDNSResourceItem(inherited Items[Index]);
 728 end;
 729
 730 procedure TIdDNSResourceList.SetItem(Index: Integer;
 731   const Value: TIdDNSResourceItem);
 732 begin
 733 //  inherited SetItem(Index, Value);
 734 end;
 735
 736 //constructor TIdDNSResolver.Create(aOwner: tComponent);
 737 function NewIdDNSResolver(AOwner: PControl):PIdDNSResolver;
 738 begin
 739 New( Result, Create );
 740 with Result^ do
 741 begin
 742 //  inherited Create(aOwner);
 743 {  Port := IdPORT_DOMAIN;
 744   ReceiveTimeout := IdDNSResolver_ReceiveTimeout;
 745   fDNSHeader := TIdDNSHeader.Create;
 746   fDnsQdList := TIdDNSQuestionList.Create;
 747   fDnsAnList := TIdDNSResourceList.Create;
 748   fDnsNsList := TIdDNSResourceList.Create;
 749   fDnsArList := TIdDNSResourceList.Create;
 750   FAnswers := TIdDNSREsourceList.Create;}
 751 end;
 752 end;
 753
 754 destructor TIdDNSResolver.Destroy;
 755 begin
 756   fDNSHeader.Free;
 757   fDnsQdList.Free;
 758   fDnsAnList.Free;
 759   fDnsNsList.Free;
 760   fDnsArList.Free;
 761   FAnswers.Free;
 762   inherited Destroy;
 763 end;
 764
 765 procedure TIdDNSResolver.ResolveDNS;
 766 begin
 767   try
 768     CreateQueryPacket;
 769     Send(QPacket);
 770     fRPacket := ReceiveString;
 771   finally DecodeReplyPacket;
 772   end;
 773 end;
 774
 775 procedure TIdDNSResolver.ClearVars;
 776 begin
 777   fDNSHeader.InitVars;
 778   fDnsQdList.Clear;
 779   fDnsAnList.Clear;
 780   fDnsNsList.Clear;
 781   fDnsArList.Clear;
 782 end;
 783
 784 function TIdDNSResolver.CreateLabelStr(QName: string): string;
 785 const
 786   aPeriod = '.';
 787 var
 788   aLabel: string;
 789   ResultArray: array[0..512] of Char;
 790   NumBytes,
 791     aPos,
 792     RaIdx: Integer;
 793
 794 begin
 795   Result := '';
 796   FillChar(ResultArray, SizeOf(ResultArray), 0);
 797   aPos := Pos(aPeriod, QName);
 798   RaIdx := 0;
 799   while (aPos <> 0) and ((RaIdx + aPos) < SizeOf(ResultArray)) do
 800   begin
 801     aLabel := Copy(QName, 1, aPos - 1);
 802     NumBytes := Succ(Length(Alabel));
 803     Move(aLabel, ResultArray[RaIdx], NumBytes);
 804     Inc(RaIdx, NumBytes);
 805     Delete(QName, 1, aPos);
 806     aPos := Pos(aPeriod, QName);
 807   end;
 808   Result := string(ResultArray);
 809 end;
 810
 811 procedure TIdDNSResolver.CreateQueryPacket;
 812 var
 813   QueryIdx: Integer;
 814   DnsQuestion: TQuestionItem;
 815
 816   procedure DoDomainName(ADNS: string);
 817   var
 818     BufStr: string;
 819     aPos: Integer;
 820   begin
 821     while Length(aDns) > 0 do
 822     begin
 823       aPos := Pos('.', aDns);
 824       if aPos = 0 then
 825       begin
 826         aPos := Length(aDns) + 1;
 827       end;
 828       BufStr := Copy(aDns, 1, aPos - 1);
 829       Delete(aDns, 1, aPos);
 830       QPacket := QPacket + Chr(Length(BufStr)) + BufStr;
 831     end;
 832   end;
 833
 834   procedure DoHostAddress(aDNS: string);
 835   var
 836     BufStr,
 837       BufStr2: string;
 838     aPos: Integer;
 839   begin
 840     while Length(aDns) > 0 do
 841     begin
 842       aPos := Pos('.', aDns);
 843       if aPos = 0 then
 844       begin
 845         aPos := Length(aDns) + 1;
 846       end;
 847       BufStr := Copy(aDns, 1, aPos - 1);
 848       Delete(aDns, 1, aPos);
 849       BufStr2 := Chr(Length(BufStr)) + BufStr + BufStr2;
 850     end;
 851     QPacket :=
 852       QPacket + BufStr2 + Chr(07) + 'in-addr' + Chr(04) + 'arpa';
 853   end;
 854
 855 begin
 856 {  DNSHeader.fId := Random(62000);
 857   DNSHeader.fQdCount := fDnsQdList.Count;
 858   if DNSHeader.fQdCount < 1 then
 859   begin
 860     raise EIdDnsResolverError.Create(GetErrorStr(1, 1));
 861   end;
 862   QPacket := WordToTwoCharStr(DNSHeader.fId);
 863   QPacket := QPacket + WordToTwoCharStr(DNSHeader.fBitCode);
 864   QPacket := QPacket + WordToTwoCharStr(DNSHeader.fQdCount);
 865   QPacket := QPacket + Chr(0) + Chr(0)
 866     + Chr(0) + Chr(0)
 867     + Chr(0) + Chr(0);
 868   for QueryIdx := 0 to fDnsQdList.Count - 1 do
 869   begin
 870     DNsQuestion := fDnsQdList.Items[QueryIdx];
 871     case DNSQuestion.Qtype of
 872       cA: DoDomainName(DNsQuestion.QName);
 873       cNS: DoDomainName(DNsQuestion.QName);
 874       cMD: raise EIdDnsResolverError.Create(RSDNSMDISObsolete);
 875       cMF: raise EIdDnsResolverError.Create(RSDNSMFIsObsolete);
 876       cName: DoDomainName(DNsQuestion.QName);
 877       cSOA: DoDomainName(DNsQuestion.Qname);
 878       cMB: DoDomainName(DNsQuestion.QName);
 879       cMG: DoDomainName(DNsQuestion.QName);
 880       cMR: DoDomainName(DNsQuestion.QName);
 881       cNULL: DoDomainName(DNsQuestion.QName);
 882       cWKS: DoDomainName(DNsQuestion.QName);
 883       cPTR: DoHostAddress(DNsQuestion.QName);
 884       cHINFO: DoDomainName(DNsQuestion.QName);
 885       cMINFO: DoDomainName(DNsQuestion.QName);
 886       cMX: DoDomainName(DNsQuestion.QName);
 887       cTXT: DoDomainName(DNsQuestion.QName);
 888       cAXFR: DoDomainName(DNsQuestion.QName);
 889       cMAILB: DoDomainName(DNsQuestion.QName);
 890       cMailA: raise EIdDnsResolverError.Create(RSDNSMailAObsolete);
 891       cSTar: DoDomainName(DNsQuestion.QName);
 892     end;
 893     fQPacket := fQPacket + Chr(0);
 894     fQPacket := fQPacket + WordToTwoCharStr(DNsQuestion.QType);
 895     fQPacket := fQPacket + WordToTwoCharStr(DNsQuestion.QClass);
 896   end;
 897   FQPackSize := Length(fQPacket);}
 898 end;
 899
 900 procedure TIdDNSResolver.DecodeReplyPacket;
 901 var
 902   CharCount: Integer;
 903   Idx: Integer;
 904   ReplyId: Word;
 905
 906   function LabelsToDomainName(const SrcStr: string; var Idx: Integer): string;
 907   var
 908     LabelStr: string;
 909     Len: Integer;
 910     SavedIdx: Integer;
 911     AChar: Char;
 912   begin
 913     Result := '';
 914     SavedIdx := 0;
 915     repeat
 916       Len := Byte(SrcStr[Idx]);
 917       if Len > 63 then
 918       begin
 919         if SavedIdx = 0 then
 920         begin
 921           SavedIdx := Succ(Idx);
 922         end;
 923         aChar := Char(Len and $3F);
 924         Idx := TwoCharToWord(aChar, SrcStr[Idx + 1]) + 1;
 925       end;
 926       if Idx > fRPackSize then
 927       begin
 928 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 2));
 929       end;
 930       SetLength(LabelStr, Byte(SrcStr[Idx]));
 931       Move(SrcStr[Idx + 1], LabelStr[1], Length(LabelStr));
 932       Inc(Idx, Length(LabelStr) + 1);
 933       if (Idx - 1) > fRPackSize then
 934       begin
 935 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 3));
 936       end;
 937       Result := Result + LabelStr + '.';
 938     until (SrcStr[Idx] = Char(0)) or (Idx >= Length(SrcStr));
 939     if Result[Length(Result)] = '.' then
 940     begin
 941       Delete(Result, Length(Result), 1);
 942     end;
 943     if SavedIdx > 0 then
 944     begin
 945       Idx := SavedIdx;
 946     end;
 947     Inc(Idx);
 948   end;
 949
 950   function ParseQuestions(StrIdx: Integer): Integer;
 951   var
 952     DNSQuestion: TQuestionItem;
 953     Idx: Integer;
 954   begin
 955     for Idx := 1 to fDNSHeader.fQdCount do
 956     begin
 957       DnsQuestion := fDnsQdList.Add;
 958       DnsQuestion.QName := LabelsToDomainName(RPacket, StrIdx);
 959       if StrIdx > fRPackSize then
 960       begin
 961 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 4));
 962       end;
 963       DnsQuestion.Qtype := TwoCharToWord(RPacket[StrIdx], RPacket[StrIdx + 1]);
 964       Inc(StrIdx, 2);
 965       if StrIdx > fRPackSize then
 966       begin
 967 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 5));
 968       end;
 969       DnsQuestion.QClass := TwoCharToWord(RPacket[StrIdx], RPacket[StrIdx + 1]);
 970       if StrIdx + 1 > fRPackSize then
 971       begin
 972 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 6));
 973       end;
 974       Inc(StrIdx, 2);
 975     end;
 976     Result := StrIdx;
 977   end;
 978
 979   function ParseResource(NumItems, StrIdx: Integer; DnsList: TIdDNSResourceList)
 980       : Integer;
 981   var
 982     RDataStartIdx: Integer;
 983     DnsResponse: TIdDNSResourceItem;
 984     Idx: Integer;
 985
 986     procedure ProcessRData(sIdx: Integer);
 987
 988       procedure DoHostAddress;
 989       var
 990         Idx: Integer;
 991
 992       begin
 993         if sIdx + 3 > fRPackSize then
 994         begin
 995 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 7));
 996         end;
 997         for Idx := sIdx to sIdx + 3 do
 998         begin
 999           DnsResponse.RData.HostAddrStr := DNSResponse.RData.HostAddrStr +
1000             IntToStr(Ord(RPacket[Idx])) + '.';
1001         end;
1002         Delete(DNSResponse.RData.HostAddrStr,
1003           Length(DNSResponse.RData.HostAddrStr), 1);
1004       end;
1005
1006       procedure DoDomainNameRData;
1007       begin
1008         DnsResponse.RData.DomainName := LabelsToDomainName(RPacket, sIdx);
1009         if (sIdx - 1) > fRPackSize then
1010         begin
1011 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 8));
1012         end;
1013       end;
1014
1015       procedure DoSOARdata;
1016       begin
1017         DNSResponse.RData.SOA.MName := LabelsToDomainName(RPacket, sIdx);
1018         if sIdx > fRPackSize then
1019         begin
1020 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 9));
1021         end;
1022         DNSResponse.RData.SOA.RName := LabelsToDomainName(RPacket, sIdx);
1023         if sIdx + 4 > fRPackSize then
1024         begin
1025 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 10));
1026         end;
1027         DNSResponse.RData.SOA.Serial := FourCharToCardinal(RPacket[sIdx],
1028           RPacket[sIdx + 1], RPacket[sIdx + 2], RPacket[sIdx + 3]);
1029         Inc(sIdx, 4);
1030         if sIdx + 4 > fRPackSize then
1031         begin
1032 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 11));
1033         end;
1034         DNSResponse.RData.SOA.Refresh := FourCharToCardinal(RPacket[sIdx],
1035           RPacket[sIdx + 1], RPacket[sIdx + 2], RPacket[sIdx + 3]);
1036         Inc(sIdx, 4);
1037         if sIdx + 4 > fRPackSize then
1038         begin
1039 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 12));
1040         end;
1041         DNSResponse.RData.SOA.ReTry := FourCharToCardinal(RPacket[sIdx],
1042           RPacket[sIdx + 1], RPacket[sIdx + 2], RPacket[sIdx + 3]);
1043         Inc(sIdx, 4);
1044         if sIdx + 4 > fRPackSize then
1045         begin
1046 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 13));
1047         end;
1048         DNSResponse.RData.SOA.Expire := FourCharToCardinal(RPacket[sIdx],
1049           RPacket[sIdx + 1], RPacket[sIdx + 2], RPacket[sIdx + 3]);
1050         Inc(sIdx, 4);
1051         if sIdx + 3 > fRPackSize then
1052         begin
1053 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 14));
1054         end;
1055         DNSResponse.RData.SOA.Minimum := FourCharToCardinal(RPacket[sIdx],
1056           RPacket[sIdx + 1], RPacket[sIdx + 2], RPacket[sIdx + 3]);
1057         Inc(sIdx, 4);
1058       end;
1059
1060       procedure DoWKSRdata;
1061       begin
1062         if sIdx + 4 > fRPackSize then
1063         begin
1064 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 15));
1065         end;
1066         DNSResponse.RData.WKS.Address :=
1067           FourCharToCardinal(RPacket[sIdx], RPacket[sIdx + 1], RPacket[sIdx +
1068             2], RPacket[sIdx + 3]);
1069         Inc(sIdx, 4);
1070         DNSResponse.RData.WKS.Protocol := Byte(RPacket[sIdx]);
1071         Inc(sIdx);
1072         if sIdx + 7 > fRPackSize then
1073         begin
1074 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 16));
1075         end;
1076         Move(RPacket[sIdx], DNSResponse.RData.WKS.Bits, 8);
1077       end;
1078
1079       procedure DoHInfoRdata;
1080       begin
1081         if sIdx + Ord(RPacket[sIdx]) + 1 > fRPackSize then
1082         begin
1083 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 17));
1084         end;
1085         Move(RPacket[sIdx], DNSResponse.RData.Hinfo.CpuStr,
1086           Ord(RPacket[sIdx]) + 1);
1087         sIdx := sIdx + Length(DNSResponse.RData.Hinfo.CpuStr) + 2;
1088         if sIdx + Ord(RPacket[sIdx]) + 1 > fRPackSize then
1089         begin
1090 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 18));
1091         end;
1092         Move(RPacket[sIdx], DNSResponse.RData.Hinfo.OSStr,
1093           Ord(RPacket[sIdx]) + 1);
1094       end;
1095
1096       procedure DoMInfoRdata;
1097       begin
1098         DNSResponse.RData.Minfo.RMailBox :=
1099           LabelsToDomainName(RPacket, sIdx);
1100         if sIdx > fRPackSize then
1101         begin
1102 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 19));
1103         end;
1104         DNSResponse.RData.MinFo.EMailBox :=
1105           LabelsToDomainName(RPacket, sIdx);
1106         if sIdx > fRPackSize then
1107         begin
1108 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 20));
1109         end;
1110       end;
1111
1112       procedure DoMXRData;
1113       begin
1114         if sIdx + 2 > fRPackSize then
1115         begin
1116 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 21));
1117         end;
1118         DNSResponse.RData.MX.Preference :=
1119           TwoCharToWord(RPacket[sIdx], RPacket[sIdx + 1]);
1120         Inc(sIdx, 2);
1121         if sIdx + 2 > fRPackSize then
1122         begin
1123 //          raise EIdDnsResolverError.Create(GetErrorStr(2, 22));
1124         end;
1125         DNSResponse.RData.Mx.Exchange := LabelsToDomainName(RPacket, sIdx);
1126       end;
1127
1128       procedure DoMailBRdata;
1129       begin
1130 //        raise EIdDnsResolverError.Create(RSDNSMailBNotImplemented);
1131       end;
1132
1133     begin
1134       case DnsResponse.AType of
1135         cA: DoHostAddress;
1136         cNS: DoDomainNameRData;
1137 //        cMD: raise EIdDnsResolverError.Create(RSDNSMDISObsolete);
1138 //        cMF: raise EIdDnsResolverError.Create(RSDNSMFIsObsolete);
1139         cName: DoDomainNameRData;
1140         cSOA: DoSOARdata;
1141         cMB: DoDomainNameRData;
1142         cMG: DoDomainNameRData;
1143         cMR: DoDomainNameRData;
1144         cNULL:
1145           DnsResponse.StarData :=
1146             Copy(RPacket, RDataStartIdx, DnsResponse.RdLength);
1147         cWKS: DoWKSRdata;
1148         cPTR: DoDomainNameRData;
1149         cHINFO: DoHInfoRdata;
1150         cMINFO: DoMInfoRdata;
1151         cMX: DoMXRData;
1152         cTXT:
1153           DnsResponse.StarData :=
1154             Copy(RPacket, RDataStartIdx, DnsResponse.RdLength);
1155         cAXFR:
1156           DnsResponse.StarData :=
1157             Copy(RPacket, RDataStartIdx, DnsResponse.RdLength);
1158         cMAILB: DoMailBRData;
1159 //        cMailA: raise EIdDnsResolverError.Create(RSDNSMFIsObsolete);
1160         cStar:
1161           DnsResponse.StarData :=
1162             Copy(RPacket, RDataStartIdx, DnsResponse.RdLength);
1163       else
1164
1165       end;
1166     end;
1167
1168   begin
1169     Result := 0;
1170     for Idx := 1 to NumItems do
1171     begin
1172       DnsResponse := DnsList.Add;
1173       DnsResponse.Name := LabelsToDomainName(RPacket, StrIdx);
1174       if StrIdx + 10 > fRPackSize then
1175       begin
1176 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 23));
1177       end;
1178       DnsResponse.aType :=
1179         TwoCharToWord(RPacket[StrIdx], RPacket[StrIdx + 1]);
1180       Inc(StrIdx, 2);
1181       DnsResponse.aClass :=
1182         TwoCharToWord(RPacket[StrIdx], RPacket[StrIdx + 1]);
1183       Inc(StrIdx, 2);
1184       DnsResponse.TTL :=
1185         FourCharToCardinal(RPacket[StrIdx], RPacket[StrIdx + 1],
1186         RPacket[StrIdx + 2], RPacket[StrIdx + 3]);
1187       Inc(StrIdx, 4);
1188       DnsResponse.RdLength :=
1189         TwoCharToWord(RPacket[StrIdx], RPacket[StrIdx + 1]);
1190       Inc(StrIdx, 2);
1191       if ((StrIdx + DnsResponse.RdLength) - 1) > fRPackSize then
1192       begin
1193 //        raise EIdDnsResolverError.Create(GetErrorStr(2, 23));
1194       end;
1195       RDataStartIdx := StrIdx;
1196       ProcessRdata(StrIdx);
1197       Inc(StrIdx, DnsResponse.RdLength);
1198
1199       Result := StrIdx;
1200       if StrIdx >= Length(RPacket) then
1201       begin
1202         Exit;
1203       end;
1204     end;
1205     if Result = 0 then
1206     begin
1207       Result := StrIdx;
1208     end;
1209   end;
1210
1211 begin
1212   ClearVars;
1213   fRPackSize := Length(RPacket);
1214   if fRPackSize < 4 then
1215   begin
1216 //    raise EIdDnsResolverError.Create(GetErrorStr(3, 28));
1217   end;
1218   CharCount := 1;
1219   ReplyId := TwoCharToWord(RPacket[1], RPacket[2]);
1220   if ReplyId <> fDNSHeader.fid then
1221   begin
1222 //    raise EIdDnsResolverError.Create(GetErrorStr(4, fDNSHeader.Fid));
1223   end;
1224   Inc(CharCount, 4);
1225   fDNSHeader.fBitCode := TwoCharToWord(RPacket[3], RPacket[4]);
1226 //  if FDNSHeader.RCode <> 0 then
1227   begin
1228 //    raise EIdDnsResolverError.Create(GetRCodeStr(FDNSHeader.RCode));
1229   end;
1230   if fRPackSize < 12 then
1231   begin
1232 //    raise EIdDnsResolverError.Create(GetErrorStr(5, 29));
1233   end;
1234   fDNSHeader.fQdCount := TwoCharToWord(RPacket[5], RPacket[6]);
1235   fDNSHeader.fAnCount := TwoCharToWord(RPacket[7], RPacket[8]);
1236   fDNSHeader.fNsCount := TwoCharToWord(RPacket[9], RPacket[10]);
1237   fDNSHeader.fArCount := TwoCharToWord(RPacket[11], RPacket[12]);
1238   if (fRPackSize < FQPackSize) then
1239   begin
1240 //    raise EIdDnsResolverError.Create(GetErrorStr(5, 30));
1241   end;
1242   for Idx := 1 to fDNSHeader.fQdCount do
1243   begin
1244     CharCount := ParseQuestions(13);
1245   end;
1246   if (Charcount >= fRPackSize) and ((fDNSHeader.fAnCount > 0) or
1247     (fDNSHeader.fNsCount > 0) or
1248     (fDNSHeader.fArCount > 0)) then
1249   begin
1250 //    raise EIdDnsResolverError.Create(GetErrorStr(6, 31));
1251   end;
1252   if fDNSHeader.fAnCount > 0 then
1253   begin
1254     CharCount := ParseResource(fDNSHeader.fAnCount, CharCount, fDnsAnList);
1255   end;
1256   if (Charcount >= fRPackSize) and ((fDNSHeader.fNsCount > 0) or
1257     (fDNSHeader.fArCount > 0)) then
1258   begin
1259 //    raise EIdDnsResolverError.Create(GetErrorStr(6, 32));
1260   end;
1261   if fDNSHeader.fNsCount > 0 then
1262   begin
1263     CharCount := ParseResource(fDNSHeader.fNsCount, CharCount, fDnsNsList);
1264   end;
1265   if (Charcount >= fRPackSize) and (fDNSHeader.fArCount > 0) then
1266   begin
1267 //    raise EIdDnsResolverError.Create(GetErrorStr(6, 33));
1268   end;
1269   if fDNSHeader.fArCount > 0 then
1270   begin
1271     CharCount := ParseResource(fDNSHeader.fArCount, CharCount, fDnsArList);
1272   end;
1273   fRPackSize := CharCount;
1274 end;
1275
1276 procedure TIdDNSResolver.ResolveDomain(const ADomain: string);
1277 var
1278   i: Integer;
1279   Rec: TRequestedRecord;
1280   LRData: TRData;
1281 begin
1282   ClearVars;
1283 //  DNSHeader.ID := DNSHeader.Id + 1;
1284   DNSHeader.Qr := False;
1285 //  DNSHeader.Opcode := cResQuery;
1286   DNSHeader.RD := True;
1287   for Rec := Low(TRequestedRecord) to High(TRequestedRecord) do
1288   begin
1289     if Rec in FRequestedRecords then
1290     begin
1291 //      DNSHeader.QdCount := DNSHEader.QdCount + 1;
1292       with DNSQDList.Add do
1293       begin
1294         QName := ADomain;
1295         QType := Rec;
1296         QClass := cIN;
1297       end;
1298     end;
1299   end;
1300
1301   ResolveDNS;
1302
1303 {  for i := 0 to DNSAnList.Count - 1 do
1304   begin
1305     LRData := DNSAnList.Items[i].RData;
1306     case DNSAnList.Items[i].AType of
1307       cA:
1308         with TARecord.Create(Answers) do
1309         begin
1310           FDomainName := LRData.DomainName;
1311         end;
1312       cMX:
1313         with TMXRecord.Create(Answers) do
1314         begin
1315           FExchange := LRData.MX.Exchange;
1316           FPreference := LRData.MX.Preference;
1317         end;
1318       cNAME:
1319         with TNameRecord.Create(Answers) do
1320         begin
1321           FDomainName := LRData.DomainName;
1322         end;
1323       cSOA:
1324         with TSOARecord.Create(Answers) do
1325         begin
1326           FExpire := LRData.SOA.Expire;
1327           FMinimum := LRData.SOA.Minimum;
1328           FMName := LRData.SOA.MName;
1329           FRefresh := LRData.SOA.Refresh;
1330           FRetry := LRData.SOA.Retry;
1331           FRName := LRData.SOA.RName;
1332           FSerial := LRData.SOA.Serial;
1333         end;
1334       cWKS:
1335         with TWKSRecord.Create(Answers) do
1336         begin
1337           FAddress := LRData.WKS.Address;
1338           FBits := LRData.WKS.Bits;
1339           FProtocol := LRData.WKS.Protocol;
1340         end;
1341       cPTR:
1342         with TPTRRecord.Create(Answers) do
1343         begin
1344           FDomainName := LRData.HostAddrStr;
1345         end;
1346       cHINFO:
1347         with THInfoRecord.Create(Answers) do
1348         begin
1349           FCPUStr := LRData.HInfo.CPUStr;
1350           FOsStr := LRData.HInfo.OsStr;
1351         end;
1352       cMINFO:
1353         with TMInfoRecord.Create(Answers) do
1354         begin
1355           FEMmailBox := LRData.MInfo.EMailBox;
1356           FRMailBox := LRData.MInfo.RMailBox;
1357         end;
1358     end;
1359   end;}
1360 end;
1361
1362 function TWKSRecord.GetBits(AIndex: Integer): Byte;
1363 begin
1364   Result := FBits[Index];
1365 end;
1366
1367 function NewQuestionItem:PQuestionItem;
1368 begin
1369   New( Result, Create );
1370 end;
1371
1372 function NewIdDNSResourceItem:PIdDNSResourceItem;
1373 begin
1374   New( Result, Create );
1375 end;
1376
1377 function NewMXRecord:PMXRecord;
1378 begin
1379   New( Result, Create );
1380 end;
1381
1382 function NewARecord:PARecord;
1383 begin
1384   New( Result, Create );
1385 end;
1386
1387 function NewNameRecord:PNameRecord;
1388 begin
1389   New( Result, Create );
1390 end;
1391
1392 function NewPTRRecord:PPTRRecord;
1393 begin
1394   New( Result, Create );
1395 end;
1396
1397 function NewHInfoRecord:PHInfoRecord;
1398 begin
1399   New( Result, Create );
1400 end;
1401
1402 function NewMInfoRecord:PMInfoRecord;
1403 begin
1404   New( Result, Create );
1405 end;
1406
1407 function NewMRecord:PMRecord;
1408 begin
1409   New( Result, Create );
1410 end;
1411
1412 function NewSOARecord:PSOARecord;
1413 begin
1414   New( Result, Create );
1415 end;
1416
1417 function NewTWKSRecord:PWKSRecord;
1418 begin
1419   New( Result, Create );
1420 end;
1421
1422 end.