Building a Simple DNS Server in Delphi with TTL Support

Below is a basic Delphi code example to implement a DNS server capable of handling A, AAAA, CNAME, and TXT records with Time-To-Live (TTL) support. This example uses the IdUDPServer component from Indy (Internet Direct) library for handling UDP packets.

unit DNS_Server;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, IdUDPServer, IdSocketHandle, IdGlobal, IdStack, IdDNSCommon,
 IdDNSResolver;
type
 TForm1 = class(TForm)
   UDPServer: TIdUDPServer;
   procedure FormCreate(Sender: TObject);
   procedure UDPServerUDPRead(AThread: TIdUDPListenerThread;
     AData: TBytes; ABinding: TIdSocketHandle);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
// Sample DNS records
const
 DNSRecords: array [0..2] of TIdRR = (
   (Host: 'example.com'; RDATA: '192.168.1.1'; TTL: 3600; RClass: inClass; RType: ARecord),
   (Host: 'example.com'; RDATA: '2001:0db8:85a3:0000:0000:8a2e:0370:7334'; TTL: 3600; RClass: inClass; RType: AAAARecord),
   (Host: 'cname.example.com'; RDATA: 'example.com'; TTL: 3600; RClass: inClass; RType: CNameRecord)
 );
procedure TForm1.FormCreate(Sender: TObject);
begin
 UDPServer.DefaultPort := 53;
 UDPServer.Active := True;
end;
function LookupRecord(const Query: TIdDNSQuery; var Response: TIdDNSQuery): Boolean;
var
 i: Integer;
begin
 Result := False;
 for i := 0 to High(DNSRecords) do
 begin
   if (Query.QType = DNSRecords[i].RType) and
      (SameText(Query.QName, DNSRecords[i].Host)) then
   begin
     Response.QType := DNSRecords[i].RType;
     Response.QName := DNSRecords[i].Host;
     Response.QClass := DNSRecords[i].RClass;
     Response.TTL := DNSRecords[i].TTL;
     Response.RData := DNSRecords[i].RData;
     Result := True;
     Break;
   end;
 end;
end;
procedure TForm1.UDPServerUDPRead(AThread: TIdUDPListenerThread;
 AData: TBytes; ABinding: TIdSocketHandle);
var
 Query, Response: TIdDNSQuery;
 ResponseData: TBytes;
begin
 Query := TIdDNSQuery.Create;
 Response := TIdDNSQuery.Create;
 try
   Query.Decode(AData);
   if LookupRecord(Query, Response) then
   begin
     Response.Encode(ResponseData);
     UDPServer.SendBuffer(ABinding.PeerIP, ABinding.PeerPort, ResponseData);
   end;
 finally
   Query.Free;
   Response.Free;
 end;
end;
end.

This code sets up a basic DNS server using the Indy library. It listens on UDP port 53 and handles DNS queries. The LookupRecord function mimics a simple DNS lookup by checking against hardcoded DNS records and populating the response if a matching record is found. This example supports A, AAAA, and CNAME record types with TTL. You can extend it to support other record types like TXT by adding them to the DNSRecords array and updating the LookupRecord function accordingly.