iddnsresolver.pas

Indy控件的使用源代码

  end;
  FDNSHeader.QDCount := iQ;
  if FDNSHeader.QDCount = 0 then begin
    FInternalQuery := '';    {Do not Localize}
    Exit;
  end;
  FInternalQuery := FInternalQuery + WordToTwoCharStr(FDNSHeader.FQDCount);
  FInternalQuery := FInternalQuery + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0);
  for ARecType := Low(TQueryRecordTypes) to High(TQueryRecordTypes) do begin
    if ARecType in QueryRecords then begin
      // Create the question
      if (ARecType = qtPTR) and (IndyPos('in-addr', ADomain) = 0) then begin {do not localize}
        AQuestion := AQuestion + DoHostAddress(ADomain) + Chr(0);
      end else begin
        AQuestion := AQuestion + DoDomainName(ADomain) + Chr(0);
      end;
      AQuestion := AQuestion + WordToTwoCharStr(QueryRecordValues[Ord(ARecType)]);
      AQuestion := AQuestion + WordToTwoCharStr(1);
    end;
  end;
  FInternalQuery := FInternalQuery + AQuestion;
  FQuestionLength := Length(AQuestion);
end;

destructor TIdDNSResolver.Destroy;
begin
  FQueryResult.Free;
  FDNSHeader.Free;
  inherited Destroy;
end;


procedure TIdDNSResolver.ParseAnswers(Answer: String; AnswerNum: Cardinal);
var
  i: integer;
  APos: Integer;
begin
  QueryResult.Clear;
  APos := 13; // Header is 12 byte long we need next byte
  // first, get the question
  // extract the domain name
  QueryResult.FDomainName :=  QueryResult.DNSStrToDomain(Answer, APos);
  // get the query type
  QueryResult.FQueryType := TwoCharToWord(Answer[APos], Answer[APos + 1]);
  Inc(APos, 2);
  // get the Query Class
  QueryResult.FQueryClass := TwoCharToWord(Answer[APos], Answer[APos + 1]);
  Inc(APos, 2);
  for i := 1 to AnswerNum  do
  begin
    QueryResult.Add(Answer, APos);
  end;
end;

procedure TIdDNSResolver.FillResult(AResult: string);
var
  ReplyId: Word;
  NAnswers: Word;
begin
  { TODO : Check bytes received }
  // Check to see if the reply is the one waited for
  ReplyId := TwoCharToWord(AResult[1],AResult[2]);
  if ReplyId <> FDNSHeader.FId then begin
    raise EIdDnsResolverError.Create(GetErrorStr(4, fDNSHeader.Fid));
  end;
  FDNSHeader.FBitCode := TwoCharToWord(AResult[3], AResult[4]);
  if FDNSHeader.RCode <> 0 then begin
    raise EIdDnsResolverError.Create(GetRCodeStr(FDNSHeader.RCode));
  end;
  if Length(AResult) < 12 then begin
    Raise EIdDnsResolverError.Create(GetErrorStr(5, 29));
  end;
  if Length(AResult) < Length(FInternalQuery) then begin
    raise EIdDnsResolverError.Create(GetErrorStr(5, 30));
  end;
  FDNSHeader.FQDCount := TwoCharToWord(AResult[5], AResult[6]);
  FDNSHeader.FANCount:= TwoCharToWord(AResult[7], AResult[8]);
  FDNSHeader.FNSCount := TwoCharToWord(AResult[9], AResult[10]);
  FDNSHeader.FARCount := TwoCharToWord(AResult[11], AResult[12]);
  NAnswers := FDNSHeader.FANCount + FDNSHeader.FNSCount + FDNSHeader.FARCount;
  if NAnswers > 0 then begin
    // Move Pointer to Start of answers
    if Length(AResult) > 12 then
      ParseAnswers(AResult, NAnswers);
  end;
end;

procedure TIdDNSResolver.Resolve(ADomain: string);
var
  AResult: string;
begin
  // Resolve queries the DNS for the records contained in the
  CreateQuery(ADomain);
  if Length(FInternalQuery) = 0 then
    raise EIdDnsResolverError.CreateFmt(RSQueryInvalidQueryCount, [0]);
  Send(FInternalQuery);
  AResult := ReceiveString;
  if Length(AResult) > 4 then
    FillResult(AResult)
  else
    raise EIdDnsResolverError.Create(RSDNSTimeout);
end;

{ TARecord }

procedure TRDATARecord.Assign(Source: TPersistent);
begin
  if Source is TARecord then begin
    FIPAddress := TARecord(Source).IPAddress;
  end else begin
    inherited Assign(Source);
  end;
end;

constructor TRDATARecord.Create(Collection: TCollection);
begin
//  FRecType := rtA;
  inherited Create(Collection);
end;

{ TMXRecord }

procedure TMXRecord.Assign(Source: TPersistent);
begin
  if Source is TMXRecord then begin
    FExchangeServer := TMXRecord(Source).ExchangeServer;
    FPreference := TMXRecord(Source).Preference;
  end else begin
    inherited Assign(Source);
  end;
end;

constructor TMXRecord.Create(Collection: TCollection);
begin
//  FRecType := rtMX;
  inherited Create(Collection);
end;

{ TCNAMERecord }

procedure TNAMERecord.Assign(Source: TPersistent);
begin
  if Source is TNAMERecord then begin
    FHostName := TNAMERecord(Source).HostName;
  end else begin
    inherited Assign(Source);
  end;
end;

constructor TNAMERecord.Create(Collection: TCollection);
begin
//  FRecType := rtCNAME;
  inherited Create(Collection);
end;

{ TQueryResult }

function TQueryResult.Add(Answer: string; var APos: Integer): TResultRecord;
var
  RRName: String;
  RR_type, RR_Class: word;
  RR_TTL: Cardinal;
  RD_Length: word;
  RData: String;
begin
  // extract the RR data
  RRName := DNSStrToDomain(Answer, APos);
  RR_Type := TwoCharToWord(Answer[APos], Answer[APos + 1]);
  RR_Class := TwoCharToWord(Answer[APos + 2], Answer[APos + 3]);
  RR_TTL := FourCharToCardinal(Answer[APos + 4], Answer[APos + 5], Answer[APos + 6], Answer[APos + 7]);
  RD_Length := TwoCharToWord(Answer[APos + 8], Answer[APos + 9]);
  RData := Copy(Answer, APos + 10, RD_Length);
  // remove what we have read from the buffer
  // Read the record type
  case TQueryRecordTypes(RR_Type - 1) of
    qtA:
    begin
      result := TARecord.Create(Self);
    end;
    qtNS:
    begin
      result := TNSRecord.Create(Self);
    end;
    qtMX:
    begin
      result := TMXRecord.Create(Self);
    end;
    qtName:
    begin
      result := TNAMERecord.Create(Self);
    end;
    qtSOA:
    begin
      result := TSOARecord.Create(Self);
    end;
    qtHINFO:
    begin
      result := THINFORecord.Create(Self);
    end;
    qtTXT:
    begin
      result := TTextRecord.Create(Self);
    end;
    qtWKS:
    begin
      result := TWKSRecord.Create(Self);
    end;
    qtPTR:
    begin
      result := TPTRRecord.Create(Self);
    end;
    qtMINFO:
    begin
      result := TMINFORecord.Create(Self);
    end;
    else
      // Unsoppurted query type, return generic record
      result := TResultRecord.Create(self);
  end; // case
  // Set the "general purprose" options
  if assigned(result) then
  begin
    if RR_Type <= High(QueryRecordTypes) then
      result.FRecType := QueryRecordTypes[Ord(RR_Type) - 1];
    result.FRecClass := RR_Class;
    result.FName := RRName;
    result.FTTL := RR_TTL;
    Result.FRData := Copy(RData, 1, RD_Length);
    Result.FRDataLength := RD_Length;
    // Parse the result
    // Since the DNS message can be compressed, we need to have the whole message to parse it, in case
    // we encounter a pointer
    Result.Parse(Copy(Answer, 1, APos + 9 + RD_Length), APos + 10);
  end;
  // Set the new position
  inc(APos, RD_Length + 10);
end;

constructor TQueryResult.Create(AResultRecord: TResultRecord);
begin
  inherited Create(TResultRecord);
  FRec := AResultRecord;
  FQueryPointerList := TStringList.Create;
end;

destructor TQueryResult.destroy;
begin
  FQueryPointerList.Free;
  inherited;
end;

function TQueryResult.GetItem(Index: Integer): TResultRecord;
begin
  Result := TResultRecord(inherited GetItem(Index));
end;

function TQueryResult.GetOwner: TPersistent;
begin
  Result := FRec;
end;

procedure TQueryResult.SetItem(Index: Integer; Value: TResultRecord);
begin
  inherited SetItem(Index, Value);
end;

{ TDNSHeader }

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

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

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

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

function TDNSHeader.GetQr: Word;
begin
  Result := FBitCode shr 15;
end;

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

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

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

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

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

procedure TDNSHeader.SetOpCode(const Value: Word);
begin
  case Value of
    0: FBitCode := FBitCode and $87FF;
    1: FBitCode := FBitCode and $8FFF;
    2: FBitCode := FBitCode and $4BFF;
  end;
end;

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

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

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

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

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

procedure TIdDNSResolver.SetAllowRecursiveQueries(const Value: Boolean);
begin
  FAllowRecursiveQueries := Value;
end;

procedure TRDATARecord.Parse(CompleteMessage: String; APos: Integer);
begin
  inherited;
  if Length(RData) > 0 then
    FIPAddress := Format('%d.%d.%d.%d',[Word(RData[1]), Word(RData[2]), Word(RData[3]), Word(RData[4])]);  {Do not Localize}
end;

{ TResultRecord }


destructor TResultRecord.Destroy;
begin
  inherited;
end;

procedure TResultRecord.Parse;
begin

end;

procedure TNAMERecord.Parse(CompleteMessage: String; APos: Integer);
begin
  inherited;
  FHostName := (Collection as TQueryResult).DNSStrToDomain(CompleteMessage, APos);
end;


procedure TQueryResult.Clear;
begin
  inherited Clear;
  FQueryPointerList.Clear;
end;

procedure TMXRecord.Parse(CompleteMessage: String; APos: Integer);
var
  Chars: Array[0..1] of char;
begin
  inherited;
  Move(CompleteMessage[APos], Chars, 2);
  FPreference := TwoCharToWord(Chars[0], Chars[1]);
  Inc(Apos, 2);
  FExchangeServer := (Collection as TQueryResult).DNSStrToDomain(CompleteMessage, APos);
end;

{ TTextRecord }

constructor TTextRecord.Create(Collection: TCollection);
begin
  inherited;
  FText := TStringlist.Create;
end;

destructor TTextRecord.Destroy;
begin
  FText.free;
  inherited;
end;

procedure TTextRecord.Parse(CompleteMessage: String; APos: Integer);
var
  Buffer: string;
begin
  FText.Clear;
  repeat
    Buffer := (Collection as TQueryResult).NextDNSLabel(CompleteMessage, APos);
    if Buffer = '' then   {Do not Localize}
    begin
      Break
    end
    else
    begin
      FText.Add(Buffer);
    end;
  until false;
  inherited;
end;

{ TSOARecord }

procedure TSOARecord.Parse(CompleteMessage: String;APos: Integer);
begin
  inherited;
  FMNAME := (Collection as TQueryResult).DNSStrToDomain(CompleteMessage, APos);
  FRNAME := (Collection as TQueryResult).DNSStrToDomain(CompleteMessage, APos);
  FSerial := FourCharToCardinal(CompleteMessage[APos], CompleteMessage[APos + 1], CompleteMessage[APos + 2], CompleteMessage[APos + 3]);
  inc(Apos, 4);
  FRefresh := FourCharToCardinal(CompleteMessage[APos], CompleteMessage[APos + 1], CompleteMessage[APos + 2], CompleteMessage[APos + 3]);
  inc(Apos, 4);
  FRetry := FourCharToCardinal(CompleteMessage[APos], CompleteMessage[APos + 1], CompleteMessage[APos + 2], CompleteMessage[APos + 3]);
  inc(Apos, 4);
  FExpire := FourCharToCardinal(CompleteMessage[APos], CompleteMessage[APos + 1], CompleteMessage[APos + 2], CompleteMessage[APos + 3]);
  inc(Apos, 4);
  FMinimumTTL := FourCharToCardinal(CompleteMessage[APos], CompleteMessage[APos + 1], CompleteMessage[APos + 2], CompleteMessage[APos + 3]);
end;

{ TWKSRecord }

constructor TWKSRecord.Create;
begin

end;

destructor TWKSRecord.Destroy;
begin
  inherited;
end;

function TWKSRecord.GetABit(index: integer): Byte;
var
  realPos: PByte;
begin
  realPos := FData;
  Inc(realPos, Index);
  result := realPos^;
end;

procedure TWKSRecord.Parse(CompleteMessage: String; APos: Integer);
begin
  inherited;
  FAddress := Format('%d.%d.%d.%d',[Word(RData[1]), Word(RData[2]), Word(RData[3]), Word(RData[4])]);   {Do not Localize}
  FProtocol := Word(Rdata[5]);
  FData := PByte(PChar(FRData));
  Inc(FData, 5);
end;

{ TMINFORecord }

procedure TMINFORecord.Parse(CompleteMessage: String; APos: Integer);
begin
  inherited;
  FResponsiblePerson := (Collection as TQueryResult).DNSStrToDomain(CompleteMessage, APos);
  FErrorMailbox := (Collection as TQueryResult).DNSStrToDomain(CompleteMessage, APos);
end;

{ THINFORecord }

procedure THINFORecord.Parse(CompleteMessage: String; APos: Integer);
begin
  inherited;
  FCPU := (Collection as TQueryResult).NextDNSLabel(CompleteMessage, APos);
  FOS := (Collection as TQueryResult).NextDNSLabel(CompleteMessage, APos);
end;


end.