?? dnsquery.pas
字號:
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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(
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -