dxdnsquery.pas

Well known and usefull component for delphi 7

   end
   else
      RegDNS:=FAlternativeDNS;
   {$IFDEF IP_HELPER}
   if REGDNS='' then begin
      FixedInfoSize:=0;
      try
         Err:=GetNetworkParams(nil, FixedInfoSize);
         if (Err=ERROR_BUFFER_OVERFLOW) then begin
            GetMem(pFixedInfo, FixedInfoSize);
            try
               Err:=GetNetworkParams(pFixedInfo, FixedInfoSize);
               if (Err=0) then begin
                  REGDNS:=pFixedInfo.DnsServerList.IpAddress.S;
                  pAddrStr:=pFixedInfo.DnsServerList.Next;
                  while (pAddrStr<>nil) do begin
                     REGDNS:=REGDNS+' '+pAddrStr.IpAddress.S;
                     pAddrStr:=pAddrStr.Next;
                  end;
               end;
            finally
               FreeMem(pFixedInfo);
            end;
         end;
      except
         REGDNS:='';
      end;
   end;
   {$ENDIF}
   if REGDNS='' then Exit;
   while Length(REGDNS)>0 do begin
      I:=CharPos(#32, REGDNS);
      if I=0 then I:=Pos(',', REGDNS);
      if I>0 then begin
         FDNSServers.Add(Copy(REGDNS, 1, I-1));
         Delete(REGDNS, 1, I);
      end
      else begin
         FDNSServers.Add(REGDNS);
         REGDNS:='';
      end;
   end;
end;

///////////////////////////////////////////////////////////////////////////////
// RESOLVE:
///////////////////////////////////////////////////////////////////////////////

function TDXDNSQuery.Resolve(Domain:string; QueryType:Integer):string;
var
   TmpDNS:PDNSResultSet;
   MemoryStream:TMemoryStream;

begin
   Result:='';
   if Domain='' then Exit;
   MemoryStream:=TMemoryStream.Create;
   New(TmpDNS);
   TmpDNS^.Domain:=Domain;
   TmpDNS^.QueryType:=QueryType;
   with TmpDNS^ do begin
      Results:=MemoryStream;
      QueryClass:=255;
      FindDNSEntries(TmpDNS);
      if DNSServer<>'' then begin
         SetLength(Result, Results.Size);
         Results.Seek(0, 0);
         Results.Read(Result[1], Results.Size);
      end;
      Results.Free;
      Results:=nil;
   end;
   Dispose(TmpDNS);
end;

procedure TDXDNSQuery.FindDNSEntries(var DNSResultSet:PDNSResultSet);
const
   HeaderSize=16;

var
   QueryQuestion:string;
   QueryOffset:Integer;
   QueryBuf:string;
   QueryWord:Word;
   QueryString:string;
   Loop:Integer;
{$IFDEF USE_TPERSISTENT}
   NewConnect:TDXNewConnect;
{$ELSE}
   NewConnect:PNewConnect;
{$ENDIF}
   Found:Boolean;
   Socket:TDXSock;
   FDNSHeader:TDNSMessageHeader;
   ErrCode:Integer;

   function SetFlags:Word;
   begin
      Result:=0;
      with FDNSHeader do begin
         if QR then
            Result:=Result or $8000
         else
            Result:=Result and $EFFF;
         Result:=((OpCode shl 11)and $7800)or(Result and $87FF);
         if AA then
            Result:=Result or $0400
         else
            Result:=Result and $FBFF;
         if TC then
            Result:=Result or $0200
         else
            Result:=Result and $FDFF;
         if RD then
            Result:=Result or $0100
         else
            Result:=Result and $FEFF;
         if RA then
            Result:=Result or $0080
         else
            Result:=Result and $FF7F;
         Result:=(RCode and $000F)or(Result and $FFF0);
      end;
   end;

   procedure DecodeFlags(const W:Word);
   begin
      FillChar2(FDNSHeader, Sizeof(FDNSHeader), #0);
      with FDNSHeader do begin
         QR:=(W and $8000)=$8000;
         OpCode:=((W and $7800)shr 11)and $000F;
         AA:=(W and $0400)=$0400;
         TC:=(W and $0200)=$0200;
         RD:=(W and $0100)=$0100;
         RA:=(W and $0080)=$0080;
         RCode:=(W and $000F);
      end;
   end;

   {$HINTS OFF}

   procedure GetCounts(const QS:string);
   var
      QWord:Word;

   begin
      FastMove(QS[1], QWord, 2);
      SwapMove(QWord, fQDCount);
      FastMove(QS[3], QWord, 2);
      SwapMove(QWord, fANCount);
      FastMove(QS[5], QWord, 2);
      SwapMove(QWord, fNSCount);
      FastMove(QS[7], QWord, 2);
      SwapMove(QWord, fRRCount);
   end;

begin
   if FDNSServers.Count<1 then
      ShowMessageWindow('Fatal DNS Error',
         'Could not find DNS Server entries in registry!');
   if not Assigned(DNSResultSet) then Exit;
   if (DNSResultSet^.Domain='')or
      (not Assigned(DNSResultSet^.Results))or
      (FDNSServers.Count<1) then Exit;
   with DNSResultSet^ do begin
      Domain:=lowercase(Domain);
      DNSServer:='';
      {$IFDEF VER90}
      Results.WriteBuffer('', 0);
      {$ELSE}
      Results.Size:=0;
      {$ENDIF}
   end;
   Found:=False;
   Loop:=0;
   Socket:=TDXSock.Create(Nil);
   while (not Found)and(Loop<FDNSServers.Count) do begin
      {$IFDEF VER90}
      DNSResultSet^.Results.WriteBuffer('', 0);
      {$ELSE}
      DNSResultSet^.Results.Size:=0;
      {$ENDIF}
      with FDNSHeader do begin
         ID:=Random(Trunc(Now))+1;
         QR:=False;
         OpCode:=0;
         AA:=False;
         TC:=False;
         RD:=True;
         RA:=False;
         Z:=0;
         RCode:=0;
         QDCount:=1;
         ANCount:=0;
         NSCount:=0;
         ARCount:=0;
      end;
      case DNSResultSet^.QueryType of
         DX_QUERY_PTR:QueryQuestion:=EncodeAddress(DNSResultSet^.Domain);
      else
         QueryQuestion:=EncodeDomain(DNSResultSet^.Domain);
      end;
      QueryOffset:=Length(QueryQuestion);
      Setlength(QueryBuf, HeaderSize+QueryOffset);
      FillChar2(QueryBuf[1], HeaderSize+QueryOffset, #0);
      with FDNSHeader do begin
         SwapMove(ID, QueryBuf[1]);
         QueryWord:=SetFlags;
         SwapMove(QueryWord, QueryBuf[3]);
         SwapMove(QDCount, QueryBuf[5]);
      end;
      FastMove(QueryQuestion[1], QueryBuf[13], QueryOffset);
      SwapMove(DNSResultSet^.QueryType, QueryBuf[13+QueryOffset]);
      SwapMove(DNSResultSet^.QueryClass, QueryBuf[15+QueryOffset]);
{$IFDEF USE_TPERSISTENT}
      NewConnect:=TDXNewConnect.Create;
{$ELSE}
      New(NewConnect);
{$ENDIF}
      with NewConnect do begin
         Port:=53;
         UseNAGLE:=False;
         UseUDP:=FUseUDP;
         UseBlocking:=True;
         ipAddress:=FDNSServers[Loop];
      end;
      if Socket.Connect(NewConnect) then begin
         Socket.Write(QueryBuf);
         SetReceiveTimeout(Socket.Sock, 3000, ErrCode);
         QueryQuestion:=Socket.ReadStr(2048);
         Socket.CloseNow;
         {$IFDEF VER90}
         DNSResultSet^.Results.SetSize(0);
         {$ELSE}
         DNSResultSet^.Results.Size:=0;
         {$ENDIF}
         if QueryQuestion<>'' then
            DNSResultSet^.Results.WriteBuffer(QueryQuestion[1],
               Length(QueryQuestion));
         if Copy(QueryBuf, 1, 2)=Copy(QueryQuestion, 1, 2) then begin
            FastMove(QueryQuestion[3], QueryWord, 2);
            SwapMove(QueryWord, QueryWord);
            DecodeFlags(QueryWord);
            if FDNSHeader.RCode=0 then begin
               if DNSResultSet^.Results.Size>3 then
                  DNSResultSet^.DNSServer:=NewConnect.ipAddress;
            end;
            DNSResultSet^.Results.Seek(0, 0);
         end;
      end;
      Found:=DNSResultSet^.DNSServer<>'';
{$IFDEF USE_TPERSISTENT}
      if Assigned(NewConnect) then NewConnect.Free;
      NewConnect:=Nil;
{$ELSE}
      if Assigned(NewConnect) then Dispose(NewConnect);
{$ENDIF}
      Inc(Loop);
   end;
   Socket.Free;
   Socket:=nil;
   if Found then begin
      DNSResultSet^.Results.Seek(4, 0);
      Setlength(QueryString, 8);
      DNSResultSet^.Results.Read(QueryString[1], 8);
      GetCounts(QueryString);
      DNSResultSet^.Results.Seek(0, 0);
   end
   else begin
      fQDCount:=0;
      fANCount:=0;
      fNSCount:=0;
      fRRCount:=0;
   end;
end;
{$HINTS ON}

procedure TDXDNSQuery.SetDNSServers(value:TStrings);
begin
   fDNSServers.Assign(Value);
end;

end.