dnsquery.pas

BaiduMp3 search baidu mp3

        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;
            { !!KAP!! }
            DnsQueryLOC:
                begin
                    { for security reasons, if recompiled with future versions of delphi }
                    if (RDataLen = 16) and (rdatalen = sizeof(fLOCInfo)) then
                        Move(rdataptr^, fLOCInfo, 16)
                    else
                        FillChar(fLOCInfo, SizeOf(fLOCInfo), 0);
                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 ntohs(V : WORD) : Integer;
begin
    Result := ((V and $FF) shl 8) or ((V shr 8) and $FF);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function ntohl(V : DWORD) : LongInt;
begin
    Result := (ntohs(V and $FFFF) shl 16) or ntohs((V shr 16) and $FFFF);
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    := ntohs(PWORD(P)^);  { 06/03/2005 WSocket_ntohs(PWORD(P)^); }
    Inc(P, 2);
    QClass   := ntohs(PWORD(P)^);  { 06/03/2005 WSocket_ntohs(PWORD(P)^); }
    Inc(P, 2);
    TTL      := ntohl(PDWORD(P)^); { 06/03/2005 WSocket_ntohl(PDWORD(P)^); }
    Inc(P, 4);
    RDataLen := ntohs(PWORD(P)^);  { 06/03/2005 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 := Integer(PDWORD(Result)^);   { 06/03/2005 added cast }
    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!
}
(*
<0><1><129><128><0><1><0><1><0><5><0><5><9>fu-berlin
<2>de<0><0>

<29><0><1><192><12><0><29><0><1><0><0>,

<0><16><0><21><22><19><139>Av<167><130><218>L<242>
<0><152><156>\<192><12><0><2><0><1><0><0><12><176>
<0>"<4>arbi<10>informatik<13>uni-oldenburg<2>de<0>
<192><12><0><2><0><1><0><0><12><176><0><12><5>deneb<3>
dfn<192>d<192><12><0><2><0><1><0><0><12><176><0><6><3>
ns3<192><12><192><12><0><2><0><1><0><0><12><176><0><6>
<3>ns2<192><12><192><12><0><2><0><1><0><0><12><176><0>
<6><3>ns1<192><12><192>F<0><1><0><1><0><0>t<169><0><4>
<134>j<1><7><192>t<0><1><0><1><0><0>9<209><0><4><192>L
<176><9><192><140><0><1><0><1><0><0>T<19><0><4><130>
<133><1>9<192><158><0><1><0><1><0><0><28><206><0><4>
<160>-<10><12><192><176><0><1><0><1><0><0>1<198><0>
<4><160>-<8><8>
*)

{ !!KAP!! }
{raw translation of some perl-source LOC.pm from package Net::DNS::RR::LOC;

fu-berlin.de   LOC  52 27 19.591 N 13 17 40.978 E 15.00m 1000.00m 10000.00m 10.00m
}
const conv_sec = 1000.0;
      conv_min = 60.0 * conv_sec;
      conv_deg = 60.0 * conv_min;
      zh31     = 1 shl 31;

procedure SubLOCgeo(longlat : longint;
                    hemis : String;
                    var ldeg, lmin, lsec, lmsec : Extended;
                    var hemic : char);
var
    Labs : Extended;
begin
    LongLat := WSocket_ntohl(LongLat);
    Labs    := Abs(1.0 * LongLat - zh31);
    Ldeg    := Trunc(labs / conv_deg);
    Labs    := Labs - ldeg * conv_deg;
    Lmin    := Trunc(labs / conv_min);
    Labs    := Labs - lmin * conv_min;
    Lsec    := Trunc(labs / conv_sec);
    Labs    := Labs - lsec * conv_sec;
    Lmsec   := Labs;
    Hemic   := Copy(Hemis, 1 + ord(LongLat <= zh31), 1)[1]; { yeah. }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function LongLatToDMS(longlat : longint; hemis : string):string;
Var ldeg, lmin, lsec, lmsec : extended;
    hemi                    : char;
begin
  SubLOCgeo(longlat,hemis,ldeg,lmin,lsec,lmsec,hemi);
  result := Format('%d %02d %02d.%03d',
               [round(ldeg), round(lmin), round(lsec),
                round(lmsec)]) + ' ' + hemi;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ in cm!! }
function LocAltToAlt(Localt : LongInt) : LongInt;
begin
    Result := Round((WSocket_ntohl(localt) - 100000.0 * 100.0) / 100.0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ !!KAP!! }
function Loc2Geo(loc : TLOCInfo):TLogGeo;
  { dolle umwandlung }
  procedure du(longlat : Integer;
               hemis   : String;
               var ideg, imin, isec, imsec : Integer;
               var hemic : Char);
  var
      ldeg, lmin, lsec, lmsec : extended;
  begin
      SubLOCgeo(longlat, hemis, ldeg, lmin, lsec, lmsec, hemic);
      ideg  := Round(ldeg);
      imin  := Round(lmin);
      isec  := Round(lsec);
      imsec := Round(lmsec);
  end;

begin
    Result.version  := Loc.version;
    Result.longsize := Round(Exp(Ln(10)*(loc.size and $f)));
    Result.latsize  := Round(Exp(Ln(10)*(loc.size shr 4)));

    Result.horizpre := Loc.horizpre;
    Result.vertpre  := Loc.vertpre;

    du(loc.latitude, 'NS', result.lad, result.lam,
       result.las, result.lams, result.lahem);
    du(loc.longitude, 'EW', result.lod, result.lom,
       result.los, result.loms, result.lohem);

    Result.altitude := LocAltToAlt(loc.altitude);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TDnsQuery.SetMultiThreaded(const Value: Boolean);
begin
    if Assigned(FWSocket) then
        FWSocket.Multithreaded := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TDnsQuery.GetMultiThreaded: Boolean;
begin
    if Assigned(FWSocket) then
        Result := FWSocket.Multithreaded
    else
        Result := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.