📄 dnsquery.pas
字号:
// moved at the beginning
if (Error<>0) then begin
fQueryPending:=false;
TriggerRequestDone(Error);
FResponseLen:=0;
exit;
end;
// !!KAP!! 2003-03-30
if (fUseTCP) then begin
// answer via TCP
if (not FResponseGotHead) and (fwsocket.RcvdCount>=2) then begin
// first datachunk, separate the length
FWSocket.Receive(@len,sizeof(len));
len:=WSocket_ntohs(len);
// resize buffer
if (len<>FResponseBufSize) then begin
freemem(FResponseBuf,FResponseBufSize);
FResponseBufSize:=len;
getmem(FResponseBuf,FResponseBufSize);
end;
FResponseGotHead:=true;
FResponseLen:=0;
end;
// We got the 2 bytes head
if (FResponseGotHead) then begin
rp:=FResponseBuf;
inc(integer(rp),FResponseLen);
// get data
i:=FWSocket.Receive(rp,FResponseBufSize-FResponseLen);
// got data?
if (i>0) then
FResponseLen:=FResponseLen+i;
// wait for more data or close the connection....
if (FResponseLen<>FResponseBufSize)
then exit
else FWSocket.close;
end else
// no header. Will this ever happen?
exit;
end else begin
// rqeusted via UDP
if (FResponseBufSize<>UDPBufSize) then begin
freemem(FResponseBuf,FResponseBufSize);
FResponseBufSize:=UDPBufSize;
getmem(FResponseBuf,FResponseBufSize);
end;
FResponseLen:=FWSocket.Receive(FResponseBuf,FResponseBufSize);
end;
{ Check for minimum response length }
if (FResponseLen<SizeOf(TDnsRequestHeader)) then begin
TriggerRequestDone(10);
Exit;
end;
Ans:=PDnsRequestHeader(FResponseBuf);
// ---
Flags:=WSocket_ntohs(Ans^.Flags);
{ Check if we got a response }
if (Flags and $8000) = 0 then begin
TriggerRequestDone(11);
Exit;
end;
{ Decode response header }
fDnsRequestAnswer.len := FResponseLen;
fDnsRequestAnswer.ID := WSocket_ntohs(Ans^.ID);
fDnsRequestAnswer.qr := (Flags and $8000) = $8000;
fDnsRequestAnswer.opcode := (Flags shr 11) and $000F;
fDnsRequestAnswer.AuthoritativeAnswer := (Flags and $0400) = $0400;
fDnsRequestAnswer.Truncation := (Flags and $0200) = $0200;
fDnsRequestAnswer.RecursionDesired := (Flags and $0100) = $0100;
fDnsRequestAnswer.RecursionAvailable := (Flags and $0080) = $0080;
fDnsRequestAnswer.z := (Flags shr 4) and $0007;
fDnsRequestAnswer.rcode := (Flags and $000F);
fDnsRequestAnswer.QDCount := WSocket_ntohs(Ans^.QDCount);
fDnsRequestAnswer.ANCount := WSocket_ntohs(Ans^.ANCount);
fDnsRequestAnswer.NSCount := WSocket_ntohs(Ans^.NSCount);
fDnsRequestAnswer.ARCount := WSocket_ntohs(Ans^.ARCount);
P:=@ResponseBuf[SizeOf(TDnsRequestHeader)];
{ Should never be greater than 1 because we sent only one question }
fQuestion.QuestionName:=NewExtractName(p);
fQuestion.QuestionType:=WSocket_ntohs(PDWORD(p)^); inc(p,sizeof(word));
fQuestion.QuestionClass:=WSocket_ntohs(PDWORD(p)^); inc(p,sizeof(word));
REndPtr:=FResponseBuf^; // !!KAP!! 2003-03-30
inc(rendptr,FResponseLen);
// the following is not very smart due two loops....
// get number or RRDatas
i:=0;
RDataPtr:=p;
while (integer(REndPtr)>integer(RDataPtr)) do begin
NewExtractName(RDataPtr);
i:=i+1;
inc(RDataPtr,sizeof(TRRInternal)+WSocket_ntohs(pRRInternal(rdataptr)^.rdlength));
end;
fdatacache.count:=i;
getmem(fdatacache.items,sizeof(fdatacache.items[0])*fdatacache.count);
// Fetch RRDatas
i:=0;
RDataPtr:=p;
while (integer(REndPtr)>integer(RDataPtr)) do begin
fdatacache.items[i].rrpos:=rdataptr;
NewExtractName(RDataPtr);
fdatacache.items[i].rrtype:=WSocket_ntohs(pRRInternal(rdataptr)^.rrtype);
i:=i+1;
inc(RDataPtr,sizeof(TRRInternal)+WSocket_ntohs(pRRInternal(rdataptr)^.rdlength));
end;
TriggerRequestDone(0);
end;
{ !!KAP!! 2002-02-15}
procedure TDnsQuery.DNSSocketSessionClosed(Sender: TObject; Error: Word);
begin
// das geht garnicht, da dann wsocketdataavailable zu sp鋞 aufgerufen wird
// !!KAP!! 2003-03-30
(*
if (fUseTCP) and (error<>0) then begin
fQueryPending:=false;
TriggerRequestDone(Error);
FResponseLen:=0;
end;
*)
end;
(************************************************************************************************)
(************************************************************************************************)
// 0 : all items, otherwise the queryitems
function TDnsQuery.GetRepsonsecount(nid : integer):integer;
var i : integer;
begin
if (nid=0) then
result:=fdatacache.count
else begin
result:=0;
for i:=0 to fdatacache.count-1 do
if (fdatacache.items[i].rrtype=nid) then
inc(result);
end;
end;
(************************************************************************************************)
(************************************************************************************************)
// 0 : all items, otherwise the queryitems
function TDnsQuery.GetResponseItem(nid : integer; nindex : integer):TRRRecord;
Type PCardinal = ^cardinal; // D5 does not have this, so we define it anyways... 2003-02-25
var i,
index : integer;
pp : pchar;
begin
// nada
fillchar(result,sizeof(result),0);
result.valid:=false;
// Cache hit
if (frrcache.lastid=nid) and (frrcache.lastindex=nindex) then begin
result:=frrcache;
exit;
end;
// store for caching.
result.lastid:=nid;
result.lastindex:=nindex;
// Search the entry
pp:=nil;
index:=-1;
for i:=0 to fdatacache.count-1 do
if (pp=nil) and ( (nid=0) or (fdatacache.items[i].rrtype=nid) ) then begin
if (nindex=0) then begin
index:=i;
pp:=fdatacache.items[i].rrpos;
end else
nindex:=nindex-1;
end;
// not found. Better raise exception?
if (pp=nil) then exit;
// headers
result.name:=NewExtractName(pp);
result.rrtype:=WSocket_ntohs(pRRInternal(pp)^.rrtype);
result.rrclass:=WSocket_ntohs(pRRInternal(pp)^.rrclass);
result.rrttl:=WSocket_ntohl(pRRInternal(pp)^.rrttl);
result.rdlength:=WSocket_ntohs(pRRInternal(pp)^.rdlength);
// end
inc(pp,sizeof(TRRInternal));
// Build the record
case fdatacache.items[index].rrtype of
DnsQueryMD,
DnsQueryMB,
DnsQueryMF : result.madname:=NewExtractName(pp);
DnsQueryMG : result.mgmname:=NewExtractName(pp);
DnsQueryCNAME : result.cname:=NewExtractName(pp);
DnsQueryMR : result.newname:=NewExtractName(pp);
DnsQueryNS : result.nsdname:=NewExtractName(pp);
DnsQueryPTR : result.ptrname:=NewExtractName(pp);
DnsQueryTXT : result.txt:=NewExtractName(pp);
DnsQueryA : begin
result.adress:=PDWORD(pp)^;
result.ipnumber:=WSocket_inet_ntoa(tinaddr(result.adress));
end;
DnsQueryMX : begin
result.mx.preference:=WSocket_ntohs(PDWORD(pp)^);
inc(pp,2);
result.mx.exchange:=NewExtractName(pp);
end;
DnsQueryHINFO : move(pp^,result.hinfo,sizeof(thinfo));
DnsQueryMINFO : begin
result.minfo.rmailbx:=NewExtractName(pp);
result.minfo.remailbx:=NewExtractName(pp);
end;
DnsQueryAAAA : begin
move(pp^,result.aaaa,sizeof(TAAAA));
result.ip6number:=format('%p:%p',[ pointer(result.aaaa[0]),pointer(result.aaaa[2]) ]);
end;
DnsQuerySOA : begin
result.soa.mname:=NewExtractName(pp);
result.soa.rname:=NewExtractName(pp);
result.soa.serial:=WSocket_ntohl(pcardinal(pp)^); inc(pp,sizeof(cardinal));
result.soa.refresh:=WSocket_ntohl(pcardinal(pp)^); inc(pp,sizeof(cardinal));
result.soa.retry:=WSocket_ntohl(pcardinal(pp)^); inc(pp,sizeof(cardinal));
result.soa.expire:=WSocket_ntohl(pcardinal(pp)^); inc(pp,sizeof(cardinal));
result.soa.minimum:=WSocket_ntohl(pcardinal(pp)^); inc(pp,sizeof(cardinal));
end;
DnsQueryLOC : begin
move(pp^,result.loc,sizeof(TLOCInfo));
result.locdecode:=Loc2Geo(result.loc);
end;
end;
// merken
frrcache:=result;
result.valid:=true;
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 : integer;
hemis : String;
var ldeg, lmin, lsec, lmsec : Extended;
var hemic : char);
var
Labs : Extended;
begin
LongLat := WSocket_ntohl(LongLat);
// !!KAP!! 2002-08-31
if (LongLat<0)
then Labs := Abs(1.0 * LongLat - zh31)
else Labs := Abs(1.0 * LongLat + zh31);
//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.%02.2d',
[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;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -