udnsclient.pas

NSinspector是一个Intenet地址解析工具(类似NSLookUp)(156KB)

BEGIN
  TimeOut.Enabled := FALSE;
  TTY('Max Timeout exceeded ...');
  TTY('');
  Waiting := FALSE;
END;

{-------------------------------------}

PROCEDURE TfrmMain.StringToLabel(Str : STRING; VAR Buf : TLabelStr);
VAR SubLabel : STRING;
BEGIN
  Buf := '';
  WHILE (Length(Str) > 0) AND (Pos('.',Str) > 0) DO BEGIN
    SubLabel := Copy(Str,1,Pos('.',Str)-1);
    Delete(Str,1,Pos('.',Str));
    Buf := Buf+Chr(Length(SubLabel))+SubLabel;
  END;
  IF Length(Str) > 0 THEN Buf := Buf+Chr(Length(Str))+Str;
  Buf := Buf+#0;  // Rootlabel = #0
END;

PROCEDURE TfrmMain.LabelToString(Buf : POINTER; VAR Pos : WORD; VAR Str : String);
VAR SubLabel : PChar;
    i,j, Len : INTEGER;
BEGIN
  Str := '';
  SubLabel := Buf;
  i := Pos;
  Pos := 0;
  WHILE SubLabel[i] <> #0 DO BEGIN
    // Handle Message compression
    IF (Ord(SubLabel[i]) AND 192) = 192 THEN BEGIN
      IF Pos = 0 THEN Pos := i+2;
      i := ((Ord(SubLabel[i]) AND 63) SHL 8) + Ord(SubLabel[i+1])-PosDiff;
    END;
    Len := Ord(SubLabel[i]);
    FOR j := 1 TO Len DO Str := Str+SubLabel[i+j];
    i := i+Len+1;
    IF SubLabel[i] <> #0 THEN Str := Str+'.';
  END;
  IF Pos = 0 THEN Pos := i+1;
END;

FUNCTION TfrmMain.GetQType(qt : STRING): STRING;
BEGIN
  IF qt = QType_A_Str     THEN Result := #0+Chr(QType_A);
  IF qt = QType_NS_Str    THEN Result := #0+Chr(QType_NS);
  IF qt = QType_CNAME_Str THEN Result := #0+Chr(QType_CNAME);
  IF qt = QType_SOA_Str   THEN Result := #0+Chr(QType_SOA);
  IF qt = QType_PTR_Str   THEN Result := #0+Chr(QType_PTR);
  IF qt = QType_MX_Str    THEN Result := #0+Chr(QType_MX);
  IF qt = QType_ALL_Str   THEN Result := #0+Chr(QType_ALL);
END;

{-------------------------------------}

PROCEDURE TfrmMain.UDPClientData(Sender: TObject; Socket: TSocket);
VAR i           : WORD;
    RRDomain    : STRING;
    RRDataType  : WORD;
    uShort      : TuShort;
    DataStrings : TStringList;

    PROCEDURE GetCNAME(Buffer : TBufferRec;VAR Pos : WORD; Strings : TStringList);
    VAR DataStr : STRING;
    BEGIN
      Strings.Clear;
      LabelToString(@Buffer.Data,Pos,DataStr);
      Strings.Add(RRDomain+' CNAME '+DataStr);
    END;

    PROCEDURE GetPTR(Buffer : TBufferRec;VAR Pos : WORD; Strings : TStringList);
    VAR DataStr : STRING;
    BEGIN
      Strings.Clear;
      LabelToString(@Buffer.Data,Pos,DataStr);
      Strings.Add(RRDomain+' PTR '+DataStr);
    END;

    PROCEDURE GetNS(Buffer : TBufferRec;VAR Pos : WORD; Strings : TStringList);
    VAR DataStr : STRING;
    BEGIN
      Strings.Clear;
      LabelToString(@Buffer.Data,Pos,DataStr);
      Strings.Add(RRDomain+' NS '+DataStr);
    END;

    PROCEDURE GetA(Buffer : TBufferRec;VAR Pos : WORD; Strings : TStringList);
    VAR DataStr : STRING;
        j       : WORD;
    BEGIN
      Strings.Clear;
      DataStr := '';
      FOR j := 1 TO 3 DO BEGIN
        DataStr := DataStr+IntToStr(Buffer.nData[i])+'.';
        Inc(i);
      END;
      DataStr := DataStr+IntToStr(Buffer.nData[i]);
      Inc(i);
      Strings.Add(RRDomain+' A '+DataStr);
    END;

    PROCEDURE GetSOA(Buffer : TBufferRec;VAR Pos : WORD; Strings : TStringList);
    VAR DataStr : STRING;
        j       : WORD;
        uLong   : TuLong;
    BEGIN
      Strings.Clear;
      LabelToString(@Buffer.Data,i,DataStr);
      Strings.Add(RRDomain+' SOA '+DataStr);
      LabelToString(@Buffer.Data,i,DataStr);
      Strings.Add('Mailbox: '+DataStr);
      // Serial
      FOR j := 3 DOWNTO 0 DO BEGIN
        uLong.B[j] := Buffer.nData[i];
        Inc(i);
      END;
      Strings.Add('Serial: '+IntToStr(uLong.Value));
      // Refresh
      FOR j := 3 DOWNTO 0 DO BEGIN
        uLong.B[j] := Buffer.nData[i];
        Inc(i);
      END;
      Strings.Add('Refresh: '+IntToStr(uLong.Value));
      // Retry
      FOR j := 3 DOWNTO 0 DO BEGIN
        uLong.B[j] := Buffer.nData[i];
        Inc(i);
      END;
      Strings.Add('Retry: '+IntToStr(uLong.Value));
      // Expire
      FOR j := 3 DOWNTO 0 DO BEGIN
        uLong.B[j] := Buffer.nData[i];
        Inc(i);
      END;
      Strings.Add('Expire: '+IntToStr(uLong.Value));
      // Minimum TTL
      FOR j := 3 DOWNTO 0 DO BEGIN
        uLong.B[j] := Buffer.nData[i];
        Inc(i);
      END;
      Strings.Add('Min TTL: '+IntToStr(uLong.Value));
    END;

    PROCEDURE GetMX(Buffer : TBufferRec;VAR Pos : WORD; Strings : TStringList);
    VAR DataStr : STRING;
        Data,j  : WORD;
    BEGIN
      Strings.Clear;
      Data := Buffer.nData[i] SHL 8;
      Inc(i);
      Data := Data + Buffer.nData[i];
      Inc(i);
      DataStr := '';
      LabelToString(@Buffer.Data,i,DataStr);
      Strings.Add(RRDomain+' MX '+IntToStr(Data)+' '+DataStr);
    END;

BEGIN
  DataStrings := TStringList.Create;
  TRY
    FillChar(Buffer.ID, 524, 32);
    WITH UDPClient DO BEGIN
      UDPClient.ReadBuffer(@Buffer.ID, 524);
      TimeOut.Enabled := FALSE;
      // Check if correct Data is recieved
      IF Buffer.ID = Swap(QueryID) THEN BEGIN
        // Skip Queryrecord
        i := 0;
        WHILE Buffer.Data[i] <> #0 DO Inc(i);
        i := i+5;
        // Process Ressourcerecords
        WHILE Buffer.Data[i] <> #32 DO BEGIN
          LabelToString(@Buffer.Data,i,RRDomain);
          Inc(i);
          RRDataType := Ord(Buffer.Data[i]);
          // Skip TTL & RDLength field
          i := i+9;
          // Get Type of RR
          CASE RRDataType OF
            QType_CNAME : GetCNAME(Buffer,i,DataStrings);
            QType_NS    : GetNS(Buffer,i,DataStrings);
            QType_A     : GetA(Buffer,i,DataStrings);
            QType_SOA   : GetSOA(Buffer,i,DataStrings);
            QType_PTR   : GetPTR(Buffer,i,DataStrings);
            QType_MX    : GetMX(Buffer,i,DataStrings);
            ELSE BEGIN
              // Skip unsupported Records
              uShort.B[1] := Buffer.nData[i-2];
              uShort.B[0] := Buffer.nData[i-1];
              i := i+uShort.Value;
            END;
          END;
          TTY(DataStrings.Text);
        END;
      END ELSE TTY('Error! Recieved wrong Data from Server!');
      //
      Waiting := FALSE;
    END;
  FINALLY
    DataStrings.Free;
  END;
END;


PROCEDURE TfrmMain.btnQueryClick(Sender: TObject);
VAR SubLabel : TLabelStr;
    QType    : STRING[2];
BEGIN
  WITH UDPClient DO BEGIN
    Host := cbHost.Text;
    IF cbHost.Items.IndexOf(cbHost.Text) < 0 THEN cbHost.Items.Add(cbHost.Text);
    Port := DNSPort;
    Open;
    IF SocketState = ssOpen THEN
    BEGIN
      cbHost.Enabled := FALSE;
      edData.Enabled := FALSE;
      btnQuery.Enabled := FALSE;
      // Initialize Header Section
      Buffer.Count := 0;
      Buffer.ID := Swap(QueryID);
      Move(Header_Option[1],Buffer.Option,10);
      // Convert Datastring to Sequence of Labels
      StringToLabel(edData.Text,SubLabel);
      Move(SubLabel[1],Buffer.Data[0],Length(SubLabel));
      Buffer.Count := Length(SubLabel);
      // ADD QType and QClass
      QType := GetQType(cbType.Text);
      Move(QType[1],Buffer.Data[Buffer.Count],2);
      Buffer.Count := Buffer.Count+2;
      Move(QClass_Internet,Buffer.Data[Buffer.Count],2);
      Buffer.Count := Buffer.Count+14;  // 2 + 12
      WriteBuffer(@Buffer.ID,Buffer.Count);
      //
      TTY('Query for "'+edData.Text+'"');
      //
      TimeOut := TTimer.Create(NIL);
      TRY
        TimeOut.OnTimer := OnTimeOut;
        TimeOut.Interval := MaxTimeOut*1000;
        Waiting := TRUE;
        WHILE Waiting DO BEGIN
          Application.ProcessMessages;
          Sleep(0);
        END;
      FINALLY
        TimeOut.Free;
      END;
      //
      Close;
      cbHost.Enabled := TRUE;
      edData.Enabled := TRUE;
      btnQuery.Enabled := TRUE;
    END;
    Inc(QueryID);
  END;
END;


END.