📄 dnsquery.pas
字号:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Fran鏾is PIETTE
Description: Component to query DNS records.
Implement a subset of RFC 1035 (A and MX records).
Creation: January 29, 1999
Version: 1.07
EMail: http://www.overbyte.be http://www.rtfm.be/fpiette
francois.piette@overbyte.be francois.piette@rtfm.be
Support: Use the mailing list twsocket@elists.org
Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1999-2005 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<francois.piette@overbyte.be>
This software is provided 'as-is', without any express or
implied warranty. In no event will the author be held liable
for any damages arising from the use of this software.
Permission is granted to anyone to use this software for any
purpose, including commercial applications, and to alter it
and redistribute it freely, subject to the following
restrictions:
1. The origin of this software must not be misrepresented,
you must not claim that you wrote the original software.
If you use this software in a product, an acknowledgment
in the product documentation would be appreciated but is
not required.
2. Altered source versions must be plainly marked as such, and
must not be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
4. You must register this software by sending a picture postcard
to the author. Use a nice stamp and mention your name, street
address, EMail address and any comment you like to say.
History:
Feb 14, 1999 V0.02 Indirectly call winsock functions using wsocket because
wsocket provide runtime dynamic link instead of loadtime link.
This allows a program to use DnsQuery if it discover that winsock
is installed and still run if winsock is not installed.
Feb 24, 1999 V1.00 Added code for reverse lookup (PTR record).
Mar 07, 1999 V1.01 Adapted for Delphi 1
Aug 20, 1999 V1.02 Revise compile time option. Adapted for BCB4
Jul 27, 2001 V1.03 Holger Lembke <holger@hlembke.de> implemented a few new
queries or propreties (QueryAny, LongLatToDMS, Loc2Geo, Loc)
and related data types.
Sep 04, 2003 V1.04 Replaced all htons by WSocket_htons
May 31, 2004 V1.05 Used ICSDEFS.INC
Nov 19, 2004 V1.06 Added Multithreaded property
Mar 06, 2005 V1.07 DecodeAnswer has been fixed to avoid winsock ntohs and
ntohl function which have range check errors because Borland
defined the function as returning LongInt instead of Cardinal
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit DnsQuery;
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$X+} { Enable extended syntax }
{$I ICSDEFS.INC}
{$IFDEF DELPHI6_UP}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_LIBRARY OFF}
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
{$IFNDEF VER80} { Not for Delphi 1 }
{$H+} { Use long strings }
{$J+} { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF BCB3_UP}
{$ObjExportAll On}
{$ENDIF}
interface
uses
Messages,
{$IFDEF USEWINDOWS}
Windows,
{$ELSE}
WinTypes, WinProcs,
{$ENDIF}
SysUtils, Classes, Winsock, WSocket;
const
DnsQueryVersion = 107;
CopyRight : String = ' TDnsQuery (c) 1999-2005 F. Piette V1.07 ';
{ Maximum answers (responses) count }
MAX_ANCOUNT = 50;
{ Maximum number of MX records taken into account in responses }
MAX_MX_RECORDS = 50;
MAX_A_RECORDS = 50;
MAX_PTR_RECORDS = 10;
{ DNS Classes }
DnsClassIN = 1; { The internet }
DnsClassCS = 2; { The CSNET class (obsolete, used only for examples)}
DnsClassCH = 3; { The CHAOS class }
DnsClassHS = 4; { Hesiod name service }
DnsClassALL = 255; { Any class }
{ Type of query/response a DNS can handle }
DnsQueryA = 1; { A HostAddress }
DnsQueryNS = 2; { NS Authoritative name server }
DnsQueryMD = 3; { MD MailDestination, obsolete, use Mail Exchange }
DnsQueryMF = 4; { MF MailForwarder, obsolete, use Mail Exchange }
DnsQueryCNAME = 5; { CNAME CanonicalName }
DnsQuerySOA = 6; { SOA Start of a Zone of Authority }
DnsQueryMB = 7; { MB MailBox, experimental }
DnsQueryMG = 8; { MG MailGroup, experimental }
DnsQueryMR = 9; { MR MailRename, experimental }
DnsQueryNULL = 10; { NULL Experimental }
DnsQueryWKS = 11; { WKS Well Known Service Description }
DnsQueryPTR = 12; { PTR Domain Name Pointer }
DnsQueryHINFO = 13; { HINFO Host Information }
DnsQueryMINFO = 14; { MINFO Mailbox information }
DnsQueryMX = 15; { MX Mail Exchange }
DnsQueryTXT = 16; { TXT Text Strings }
{ !!KAP!! }
DnsQueryRP = 17;
DnsQueryAFSDB = 18;
DnsQueryX25 = 19;
DnsQueryISDN = 20;
DnsQueryRT = 21;
DnsQueryNSAP = 22;
DnsQueryNSAPPTR = 23;
DnsQuerySIG = 24; { see RFC-2065 }
DnsQueryKEY = 25; { see RFC-2065 }
DnsQueryPX = 26;
DnsQueryGPOS = 27; { GPOS has the following format:
<owner> <ttl> <class> GPOS <longitude> <latitude> <altitude> }
DnsQueryAAAA = 28; { see IP6 Address }
DnsQueryLOC = 29; (* see RFC-1876 http://rfc.net/rfc1876.html
<owner> <TTL> <class> LOC ( d1 [m1 [s1]] {"N"|"S"} d2 [m2 [s2]]
{"E"|"W"} alt["m"] [siz["m"] [hp["m"]
[vp["m"]]]] )
*)
DnsQueryNXT = 30; { see RFC-2065 }
DnsQuerySRV = 33; { see RFC-2052 }
DnsQueryNAPTR = 35; { see RFC-2168 }
DnsQueryKX = 36;
{ Some additional type only allowed in queries }
DnsQueryAXFR = 252; { Transfer for an entire zone }
DnsQueryMAILB = 253; { Mailbox related records (MB, MG or MR) }
DnsQueryMAILA = 254; { MailAgent, obsolete, use MX instead }
DnsQueryALL = 255; { Request ALL records }
{ Opcode field in query flags }
DnsOpCodeQUERY = 0;
DnsOpCodeIQUERY = 1;
DnsOpCodeSTATUS = 2;
type
TDnsAnswerNameArray = packed array [0..MAX_ANCOUNT - 1] of String;
TDnsAnswerTypeArray = packed array [0..MAX_ANCOUNT - 1] of Integer;
TDnsAnswerClassArray = packed array [0..MAX_ANCOUNT - 1] of Integer;
TDnsAnswerTTLArray = packed array [0..MAX_ANCOUNT - 1] of LongInt;
TDnsAnswerTagArray = packed array [0..MAX_ANCOUNT - 1] of Integer;
TDnsMXPreferenceArray = packed array [0..MAX_MX_RECORDS - 1] of Integer;
TDnsMXExchangeArray = packed array [0..MAX_MX_RECORDS - 1] of String;
TDnsAddressArray = packed array [0..MAX_A_RECORDS - 1] of TInAddr;
TDnsHostnameArray = packed array [0..MAX_PTR_RECORDS - 1] of String;
TDnsRequestDoneEvent = procedure (Sender : TObject; Error : WORD) of Object;
TDnsRequestHeader = packed record
ID : WORD;
Flags : WORD;
QDCount : WORD;
ANCount : WORD;
NSCount : WORD;
ARCount : WORD;
end;
PDnsRequestHeader = ^TDnsRequestHeader;
TLOCInfo = packed record { need to be 16 bytes }
version : byte;
size : byte;
horizpre : byte;
vertpre : byte;
latitude : longint;
longitude : longint;
altitude : longint;
end;
PLOCInfo = ^TLOCInfo;
{ Decoded TLOCInfo }
TLogGeo = record
version : byte;
longsize : integer;
latsize : integer;
horizpre : integer;
vertpre : integer;
{ Latitude, degree, minutes, seconds, milliseconds }
lad, lam, las, lams : integer;
lahem : char;
{ same for Longitude }
lod, lom, los, loms : integer;
lohem : char;
altitude : integer;
end;
TDnsQuery = class(TComponent)
protected
FWSocket : TWSocket;
FPort : String;
FAddr : String;
FIDCount : WORD;
FQueryBuf : array [0..511] of char;
FQueryLen : Integer;
FResponseBuf : array [0..511] of char;
FResponseLen : Integer;
FResponseID : Integer;
FResponseCode : Integer;
FResponseOpCode : Integer;
FResponseAuthoritative : Boolean;
FResponseTruncation : Boolean;
FResponseRecursionAvailable : Boolean;
FResponseQDCount : Integer;
FResponseANCount : Integer;
FResponseNSCount : Integer;
FResponseARCount : Integer;
FQuestionType : Integer;
FQuestionClass : Integer;
FQuestionName : String;
FAnswerNameArray : TDnsAnswerNameArray;
FAnswerTypeArray : TDnsAnswerTypeArray;
FAnswerClassArray : TDnsAnswerClassArray;
FAnswerTTLArray : TDnsAnswerTTLArray;
FAnswerTagArray : TDnsAnswerTagArray;
FMXRecordCount : Integer;
FMXPreferenceArray : TDnsMXPreferenceArray; { For MX request }
FMXExchangeArray : TDnsMXExchangeArray; { For MX request }
FARecordCount : Integer;
FAddressArray : TDnsAddressArray; { For A request }
FPTRRecordCount : Integer;
FHostnameArray : TDnsHostnameArray; { For PTR request }
FOnRequestDone : TDnsRequestDoneEvent;
{ !!KAP!! }
fLOCInfo : TLOCInfo;
function GetMXPreference(nIndex : Integer) : Integer;
function GetMXExchange(nIndex : Integer) : String;
function GetAnswerName(nIndex : Integer) : String;
function GetAnswerType(nIndex : Integer) : Integer;
function GetAnswerClass(nIndex : Integer) : Integer;
function GetAnswerTTL(nIndex : Integer) : LongInt;
function GetAnswerTag(nIndex : Integer) : Integer;
function GetAddress(nIndex : Integer) : TInAddr;
function GetHostname(nIndex : Integer) : String;
procedure BuildRequestHeader(Dst : PDnsRequestHeader;
ID : WORD;
OPCode : BYTE;
Recursion : Boolean;
QDCount : WORD;
ANCount : WORD;
NSCount : WORD;
ARCount : WORD); virtual;
function BuildQuestionSection(Dst : PChar;
const QName : String;
QType : WORD;
QClass : WORD) : Integer; virtual;
procedure WSocketDataAvailable(Sender: TObject; Error: WORD); virtual;
procedure TriggerRequestDone(Error: WORD); virtual;
function GetResponseBuf : PChar;
procedure SendQuery;
function ExtractName(Base : PChar;
From : PChar;
var Name : String) : PChar;
function DecodeQuestion(Base : PChar;
From : PChar;
var Name : String;
var QType : Integer;
var QClass : Integer) : PChar;
function DecodeAnswer(Base : PChar;
From : PChar;
var Name : String;
var QType : Integer;
var QClass : Integer;
var TTL : LongInt;
var RDataPtr : Pointer;
var RDataLen : Integer) : PChar;
function DecodeMXData(Base : PChar;
From : PChar;
var Preference : Integer;
var Exchange : String) : PChar;
function DecodeAData(Base : PChar;
From : PChar;
var Address : TInAddr) : PChar;
function DecodePTRData(Base : PChar;
From : PChar;
var Hostname : String) : PChar;
function GetMultiThreaded: Boolean;
procedure SetMultiThreaded(const Value: Boolean);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Notification(AComponent: TComponent; operation: TOperation); override;
function MXLookup(Domain : String) : Integer;
function ALookup(Host : String) : Integer;
function PTRLookup(IP : String) : Integer;
{ !!KAP!! }
function QueryAny(Host : String; QNumber : Integer) : Integer;
property ResponseID : Integer read FResponseID;
property ResponseCode : Integer read FResponseCode;
property ResponseOpCode : Integer read FResponseOpCode;
property ResponseAuthoritative : Boolean read FResponseAuthoritative;
property ResponseTruncation : Boolean read FResponseTruncation;
property ResponseRecursionAvailable : Boolean read FResponseRecursionAvailable;
property ResponseQDCount : Integer read FResponseQDCount;
property ResponseANCount : Integer read FResponseANCount;
property ResponseNSCount : Integer read FResponseNSCount;
property ResponseARCount : Integer read FResponseARCount;
property ResponseBuf : PChar read GetResponseBuf;
property ResponseLen : Integer read FResponseLen;
property QuestionType : Integer read FQuestionType;
property QuestionClass : Integer read FQuestionClass;
property QuestionName : String read FQuestionName;
property AnswerName[nIndex : Integer] : String read GetAnswerName;
property AnswerType[nIndex : Integer] : Integer read GetAnswerType;
property AnswerClass[nIndex : Integer] : Integer read GetAnswerClass;
property AnswerTTL[nIndex : Integer] : LongInt read GetAnswerTTL;
property AnswerTag[nIndex : Integer] : Integer read GetAnswerTag;
property MXPreference[nIndex : Integer] : Integer read GetMXPreference;
property MXExchange[nIndex : Integer] : String read GetMXExchange;
property Address[nIndex : Integer] : TInAddr read GetAddress;
property Hostname[nIndex : Integer] : String read GetHostname;
{ !!KAP!! }
property Loc : TLOCInfo read fLOCInfo;
published
property Port : String read FPort write FPort;
property Addr : String read FAddr write FAddr;
property MultiThreaded : Boolean read GetMultiThreaded
write SetMultiThreaded;
property OnRequestDone : TDnsRequestDoneEvent read FOnRequestDone
write FOnRequestDone;
end;
function ReverseIP(const IP : String) : String;
function LongLatToDMS(longlat : longint; hemis : String) : String; { !!KAP!! }
function Loc2Geo(loc : TLOCInfo) : TLogGeo; { !!KAP!! }
procedure Register;
implementation
type
PWORD = ^WORD;
PDWORD = ^DWORD;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function ReverseIP(const IP : String) : String;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -