dnsquery.pas

包含常用Internet协议TCP,UDP、HTTP、FTP、Telnet等

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TDnsQuery.TriggerRequestDone(Error: WORD);
begin
    if Assigned(FOnRequestDone) then
        FOnRequestDone(Self, Error);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TDnsQuery.WSocketDataAvailable(Sender: TObject; Error: WORD);
var
    Len    : Integer;
    Ans    : PDnsRequestHeader;
    Flags  : Integer;
    P      : PChar;
    RDataPtr : Pointer;
    RDataLen : Integer;
    I        : Integer;
begin
    Ans := PDnsRequestHeader(@FResponseBuf);
    Len := FWSocket.Receive(Ans, SizeOf(FResponseBuf));
    if Error <> 0 then begin
        TriggerRequestDone(Error);
        Exit;
    end;
    { Check for minimum response length }
    if Len < SizeOf(TDnsRequestHeader) then
        Exit;
    Flags := WSocket_ntohs(Ans^.Flags);
    { Check if we got a response }
    if (Flags and $8000) = 0 then
        Exit;
    FResponseLen := Len;
    { Decode response header }
    FResponseID                 := WSocket_ntohs(Ans^.ID);
    FResponseCode               := Flags and $000F;
    FResponseOpCode             := (Flags shr 11) and $000F;
    FResponseAuthoritative      := (Flags and $0400) = $0400;
    FResponseTruncation         := (Flags and $0200) = $0200;
    FResponseRecursionAvailable := (Flags and $0080) = $0080;
    FResponseQDCount            := WSocket_ntohs(Ans^.QDCount);
    FResponseANCount            := WSocket_ntohs(Ans^.ANCount);
    FResponseNSCount            := WSocket_ntohs(Ans^.NSCount);
    FResponseARCount            := WSocket_ntohs(Ans^.ARCount);

    P := @ResponseBuf[SizeOf(TDnsRequestHeader)];
    if FResponseQDCount = 0 then begin
        { I don't think we could receive 0 questions }
        FQuestionName  := '';
        FQuestionType  := 0;
        FQuestionClass := 0;
    end
    else begin
        { Should never be greater than 1 because we sent only one question }
        P := DecodeQuestion(@FResponseBuf, P,
                            FQuestionName, FQuestionType, FQuestionClass);
    end;
    if FResponseANCount = 0 then begin
        RDataPtr        := nil;
        RDataLen        := 0;
        FMXRecordCount  := 0;
        FARecordCount   := 0;
        FPTRRecordCount := 0;
    end
    else begin
        FMXRecordCount  := 0;
        FARecordCount   := 0;
        FPTRRecordCount := 0;
        for I := 0 to FResponseANCount - 1 do begin
            P := DecodeAnswer(@FResponseBuf,        P,
                              FAnswerNameArray[I],  FAnswerTypeArray[I],
                              FAnswerClassArray[I], FAnswerTTLArray[I],
                              RDataPtr,             RDataLen);
            FAnswerTagArray[I] := -1;
            case FAnswerTypeArray[I] of
            DnsQueryMX:
                begin
                    if FMXRecordCount <= High(FMXPreferenceArray) then begin
                        FAnswerTagArray[I] := FMXRecordCount;
                        DecodeMXData(@FResponseBuf, RDataPtr,
                                     FMXPreferenceArray[FMXRecordCount],
                                     FMXExchangeArray[FMXRecordCount]);
                        Inc(FMXRecordCount);
                    end;
                end;
            DnsQueryA:
                begin
                    if FARecordCount <= High(FAddressArray) then begin
                        FAnswerTagArray[I] := FARecordCount;
                        DecodeAData(@FResponseBuf, RDataPtr,
                                    FAddressArray[FARecordCount]);
                        Inc(FARecordCount);
                    end;
                end;
            DnsQueryPTR:
                begin
                    if FPTRRecordCount <= High(FHostnameArray) then begin
                        FAnswerTagArray[I] := FPTRRecordCount;
                        DecodePTRData(@FResponseBuf, RDataPtr,
                                      FHostnameArray[FPTRRecordCount]);
                        Inc(FPTRRecordCount);
                    end;
                end;
            end;
        end;
    end;
    TriggerRequestDone(0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.ExtractName(
    Base       : PChar;
    From       : PChar;
    var Name   : String) : PChar;
var
    N       : Integer;
    I       : Integer;
    P       : PChar;
    NameEnd : String;
begin
    P := From;
    if P^ = #0 then begin
        Name := '';
        Inc(P);
    end
    else begin
        Name := '';
        while TRUE do begin
            { Get name part length }
            N := Ord(P^);
            if (N and $C0) = $C0 then begin
                 { Message compression }
                 N := ((N and $3F) shl 8) + Ord(P[1]);
                 if Length(Name) = 0 then
                     Self.ExtractName(Base, Base + N, Name)
                 else begin
                     Self.ExtractName(Base, Base + N, NameEnd);
                     Name := Name + NameEnd;
                 end;
                 Inc(P, 2);
                 break;
            end;
            Inc(P);
            if N = 0 then
                break;
            { Copy name part }
            for I := 1 to N do begin
                Name := Name + P^;
                Inc(P);
            end;
            if P^ <> #0 then
                Name := Name + '.';
        end;
    end;
    Result := P;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.DecodeQuestion(
    Base       : PChar;
    From       : PChar;
    var Name   : String;
    var QType  : Integer;
    var QClass : Integer) : PChar;
var
    P : PChar;
begin
    P := ExtractName(Base, From, Name);
    QType  := WSocket_ntohs(PWORD(P)^);
    Inc(P, 2);
    QClass := WSocket_ntohs(PWORD(P)^);
    Inc(P, 2);
    Result := P;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.DecodeAnswer(
    Base         : PChar;
    From         : PChar;
    var Name     : String;
    var QType    : Integer;
    var QClass   : Integer;
    var TTL      : LongInt;
    var RDataPtr : Pointer;
    var RDataLen : Integer) : PChar;
var
    P : PChar;
begin
    P := ExtractName(Base, From, Name);
    QType  := WSocket_ntohs(PWORD(P)^);
    Inc(P, 2);
    QClass := WSocket_ntohs(PWORD(P)^);
    Inc(P, 2);
    TTL    := WSocket_ntohl(PDWORD(P)^);
    Inc(P, 4);
    RDataLen := WSocket_ntohs(PWORD(P)^);
    Inc(P, 2);
    RDataPtr := P;
    Result := P + RDataLen;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.DecodeMXData(
    Base           : PChar;
    From           : PChar;
    var Preference : Integer;
    var Exchange   : String) : PChar;
begin
    Result := From;
    Preference := WSocket_ntohs(PWORD(Result)^);
    Inc(Result, 2);
    Result := ExtractName(Base, Result, Exchange);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.DecodePTRData(
    Base         : PChar;
    From         : PChar;
    var Hostname : String) : PChar;
begin
    Result := ExtractName(Base, From, Hostname);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.DecodeAData(
    Base        : PChar;
    From        : PChar;
    var Address : TInAddr) : PChar;
begin
    Result := From;
    Address.S_addr := PDWORD(Result)^;
    Inc(Result, 4);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{
  <0><1><129><128><0><1><0><1><0><4><0><5><7>inp
  rise<3>com<0><0><15><0><1><192><12><0>
  <15><0><1><0><1>QV<0><10><0><10><5>drui
  d<192><12><192><12><0><2><0><1><0><1>Qc<0><6><3>
  ns1<192><12><192><12><0><2><0><1><0><1>Qc<0>
  <20><3>NS1<10>SPRINTLINK
  <3>NET<0><192><12><0><2><0><1><0><1>Qc<0>
  <6><3>NS2<192>U<192><12><0><2><0><1><0><1>Q
  c<0><6><3>NS3<192>U<192>+<0><1><0><1><0>
  <1>QV<0><4><143><186><11>F<192>?<0><1><0><1><0>
  <1>Qc<0><4><207>iS<30><192>Q<0><1><0><1><0>
  <2><144>i<0><4><204>u<214><10><192>q<0><1><0><1><0>
  <2><144>i<0><4><199><2><252><10><192><131><0><1><0><1><0>
  <2><142><182><0><4><204>a<212><10>
}
{
  <0><3><129><128><0><1><0><1><0><2><0><3><4>rtf
  m<2>be<0><0><15><0><1><192><12><0><15><0><1><0>
  <1>.b<0><9><0><10><4>mail<192><12><192><12>
  <0><2><0><1><0><1>.b<0><11><2>ns<3>dn
  s<2>be<0><192><12><0><2><0><1><0><1>.b<0>
  <5><2>ns<192><12><192>'<0><1><0><1><0><1>.b
  <0><4><195><0>d<253><192>:<0><1><0><1><0><1>QY
  <0><4><134>:J!<192>Q<0><1><0><1><0><1>.b
  <0><4><195><0>d<253>
}
{
  <0><7><133><128><0><1><0><1><0><2><0><2><3>www
  <4>rtfm<2>be<0><0><1><0><1><192><12><0>
  <1><0><1><0><1>Q<128><0><4><195><0>d<253><4>rt
  fm<2>be<0><0><2><0><1><0><1>Q<128><0><5>
  <2>ns<192>-<192>-<0><2><0><1><0><1>Q<128><0>
  <9><2>ns<3>dns<192>2<192>@<0><1><0><1>
  <0><1>Q<128><0><4><195><0>d<253><192>Q<0><1><0><1>
  <0><0><26><132><0><4><134>:J!
}
end.