cldnsmessage.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

    rec.Free();
  end;
end;

function TclDnsMessage.CreateRecordByType(ARecordType: Integer): TclDnsRecord;
begin
  case ARecordType of
    1: Result := TclDnsARecord.Create();
    2: Result := TclDnsNSRecord.Create();
    5: Result := TclDnsCNAMERecord.Create();
    6: Result := TclDnsSOARecord.Create();
    12: Result := TclDnsPTRRecord.Create();
    15: Result := TclDnsMXRecord.Create()
  else
    Result := TclDnsRecord.Create();
  end;
end;

destructor TclDnsMessage.Destroy;
begin
  FAdditionalRecords.Free();
  FQueries.Free();
  FAnswers.Free();
  FNameServers.Free();
  FHeader.Free();
  inherited Destroy();
end;

procedure TclDnsMessage.Parse(ASource: TStream);
var
  i, ind: Integer;
  buf: TclByteArray;
  rec: TclDnsRecord;
begin
  if (ASource.Size - ASource.Position) > cDatagramSize then
  begin
    raise EclDnsError.Create(cDnsDatagramInvalid, -1);
  end;

  Clear();

  SetLength(buf, cDatagramSize);
  ASource.Read(buf[0], cDatagramSize);
  ind := 0;
  Header.Parse(buf, ind);

  for i := 0 to Header.QueryCount - 1 do
  begin
    rec := CreateRecord(buf, ind);
    Queries.Add(rec);
    rec.ParseQuery(buf, ind);
  end;

  for i := 0 to Header.AnswerCount - 1 do
  begin
    rec := CreateRecord(buf, ind);
    Answers.Add(rec);
    rec.Parse(buf, ind);
  end;

  for i := 0 to Header.NameServerCount - 1 do
  begin
    rec := CreateRecord(buf, ind);
    NameServers.Add(rec);
    rec.Parse(buf, ind);
  end;
  
  for i := 0 to Header.AdditionalCount - 1 do
  begin
    rec := CreateRecord(buf, ind);
    AdditionalRecords.Add(rec);
    rec.Parse(buf, ind);
  end;
end;

{ TclDnsRecordList }

function TclDnsRecordList.Add(AItem: TclDnsRecord): Integer;
begin
  Result := FList.Add(AItem);
end;

procedure TclDnsRecordList.Clear;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    Items[i].Free();
  end;
  FList.Clear();
end;

constructor TclDnsRecordList.Create;
begin
  inherited Create();
  FList := TList.Create();
end;

procedure TclDnsRecordList.Delete(Index: Integer);
begin
  Items[Index].Free();
  FList.Delete(Index);
end;

destructor TclDnsRecordList.Destroy;
begin
  Clear();
  FList.Free();
  inherited Destroy();
end;

function TclDnsRecordList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TclDnsRecordList.GetItems(Index: Integer): TclDnsRecord;
begin
  Result := TclDnsRecord(FList[Index]);
end;

function TclDnsRecordList.ItemByName(const AName: string): TclDnsRecord;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    if SameText(Items[i].Name, AName) then
    begin
      Result := Items[i];
      Exit;
    end;
  end;
  Result := nil;
end;

{ TclDnsMXRecord }

constructor TclDnsMXRecord.Create;
begin
  inherited Create();
  RecordType := 15;
end;

procedure TclDnsMXRecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
  inherited InternalParse(ASource, AIndex);
  Preference := ByteArrayReadWord(ASource, AIndex);
  MailServer := ReadDomainName(ASource, AIndex);
end;

{ TclDnsRecord }

procedure TclDnsRecord.Build(var ADestination: TclByteArray; var AIndex: Integer);
begin
  BuildQuery(ADestination, AIndex);
  InternalBuild(ADestination, AIndex);
end;

procedure TclDnsRecord.BuildQuery(var ADestination: TclByteArray; var AIndex: Integer);
const
  RecClass: array[TclDnsRecordClass] of Word = (1, 3, 4);
begin
  WriteDomainName(Name, ADestination, AIndex);
  ByteArrayWriteWord(Word(RecordType), ADestination, AIndex);
  ByteArrayWriteWord(RecClass[RecordClass], ADestination, AIndex);
end;

procedure TclDnsRecord.InternalBuild(var ADestination: TclByteArray; var AIndex: Integer);
begin
  Assert(False, 'Not implemented');
end;

procedure TclDnsRecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
end;

procedure TclDnsRecord.Parse(const ASource: TclByteArray; var AIndex: Integer);
var
  ind: Integer;
begin
  ParseQuery(ASource, AIndex);

  TTL := ByteArrayReadDWord(ASource, AIndex);
  DataLength := ByteArrayReadWord(ASource, AIndex);

  ind := AIndex;
  AIndex := AIndex + DataLength;
  InternalParse(ASource, ind);

  Assert(ind <= AIndex);
  Assert(AIndex <= Length(ASource));
end;

procedure TclDnsRecord.ParseQuery(const ASource: TclByteArray;
  var AIndex: Integer);
begin
  Name := ReadDomainName(ASource, AIndex);
  RecordType := ByteArrayReadWord(ASource, AIndex);
  case ByteArrayReadWord(ASource, AIndex) of
    3: RecordClass := rcChaos;
    4: RecordClass := rcHesiod
  else
    RecordClass := rcInternet;
  end;
end;

function TclDnsRecord.ReadDomainName(const ASource: TclByteArray;
  var AIndex: Integer): string;
var
  s: string;
  i, ind, len: Integer;
begin
  Result := '';
  ind := -1;
  repeat
    len := ASource[AIndex];
    while (len and $C0) = $C0 do
    begin
      if ind < 0 then
      begin
        ind := Succ(AIndex);
      end;
      AIndex := MakeWord(len and $3F, ASource[AIndex + 1]);
      Assert(AIndex < Length(ASource));
      len := ASource[AIndex];
    end;
    SetLength(s, len);
    if len > 0 then
    begin
      for i := 1 to len do
      begin
        s[i] := Char(ASource[AIndex + i]);
      end;
      Inc(AIndex, Length(s) + 1);
    end;
    Result := Result + s + '.';
  until (ASource[AIndex] = 0) or (AIndex >= Length(ASource));
  if Result[Length(Result)] = '.' then
  begin
    SetLength(Result, Length(Result) - 1);
  end;
  if ind >= 0 then
  begin
    AIndex := ind;
  end;
  Inc(AIndex);
end;

procedure TclDnsRecord.WriteDomainName(const AName: string;
  var ADestination: TclByteArray; var AIndex: Integer);
var
  name, s: string;
  ind: Integer;
  size: Byte;
begin
  name := AName;
  while Length(name) > 0 do
  begin
    ind := system.Pos('.', name);
    if ind = 0 then
    begin
      ind := Length(name) + 1;
    end;
    s := system.Copy(name, 1, ind - 1);
    system.Delete(name, 1, ind);

    size := Byte(Length(s) and $00FF);
    ADestination[AIndex] := size;
    Inc(AIndex);
    system.Move(PChar(s)^, ADestination[AIndex], size);
    Inc(AIndex, size);
  end;

  ADestination[AIndex] := 0;
  Inc(AIndex);
end;

{ TclDnsNSRecord }

constructor TclDnsNSRecord.Create;
begin
  inherited Create();
  RecordType := 2;
end;

procedure TclDnsNSRecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
  inherited InternalParse(ASource, AIndex);
  NameServer := ReadDomainName(ASource, AIndex);
end;

{ TclDnsARecord }

constructor TclDnsARecord.Create;
begin
  inherited Create();
  RecordType := 1;
end;

procedure TclDnsARecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
  inherited InternalParse(ASource, AIndex);
  IPAddress := Format('%d.%d.%d.%d',[ASource[AIndex], ASource[AIndex + 1], ASource[AIndex + 2], ASource[AIndex + 3]]);
  Inc(AIndex, 4);
end;

{ TclDnsPTRRecord }

constructor TclDnsPTRRecord.Create;
begin
  inherited Create();
  RecordType := 12;
end;

procedure TclDnsPTRRecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
  inherited InternalParse(ASource, AIndex);
  DomainName := ReadDomainName(ASource, AIndex);
end;

{ TclDnsSOARecord }

constructor TclDnsSOARecord.Create;
begin
  inherited Create();
  RecordType := 6;
end;

procedure TclDnsSOARecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
  inherited InternalParse(ASource, AIndex);
  PrimaryNameServer := ReadDomainName(ASource, AIndex);
  ResponsibleMailbox := ReadDomainName(ASource, AIndex);
  SerialNumber := ByteArrayReadDWord(ASource, AIndex);
  RefreshInterval := ByteArrayReadDWord(ASource, AIndex);
  RetryInterval := ByteArrayReadDWord(ASource, AIndex);
  ExpirationLimit := ByteArrayReadDWord(ASource, AIndex);
  MinimumTTL := ByteArrayReadDWord(ASource, AIndex);
end;

{ TclDnsCNAMERecord }

constructor TclDnsCNAMERecord.Create;
begin
  inherited Create();
  RecordType := 5;
end;

procedure TclDnsCNAMERecord.InternalParse(const ASource: TclByteArray; var AIndex: Integer);
begin
  inherited InternalParse(ASource, AIndex);
  PrimaryName := ReadDomainName(ASource, AIndex);
end;

end.