aksdb
/
restemplate
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
restemplate/indy/Protocols/IdDNSCommon.pas

2040 lines
59 KiB
Plaintext
Raw Blame History

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
Rev 1.29 1/31/2005 9:02:44 PM JPMugaas
Should compile again. OOPS!!
Rev 1.28 1/28/2005 8:06:08 PM JPMugaas
Bug with MINFO, it was not returning the responsible E-Mail address.
Rev 1.27 1/28/2005 7:12:34 PM JPMugaas
Minor formatting adjustments.
Rev 1.26 1/28/2005 3:46:18 PM JPMugaas
Should compile.
Rev 1.25 2005/1/28 ¤U¤È 12:40:08 DChang
Add a new method for TIdTextModeResourceRecord to clean the created FAnswer,
then while the record updated, new data can be used in the FAnswer.
Rev 1.23 2005/1/25 ¤U¤È 12:24:14 DChang
For speeding up the query, one private variable is added into all TIdRR_
series object, only first time query will generate the binary codes, the
others will read the result form the first time generated.
Rev 1.22 2004/12/15 ¤W¤È 11:12:18 DChang Version: 1.22
Fix all BinQueryRecord method of TIdRR_*,
TIdRR_TXT.BinQueryRecord is completed,
and remark the comment of TIdTextModeResourceRecord.BinQueryRecord,
it's should be empty.
Rev 1.21 10/26/2004 9:06:30 PM JPMugaas
Updated references.
Rev 1.20 9/15/2004 4:59:34 PM DSiders
Added localization comments.
Rev 1.19 2004/7/19 ¤U¤È 09:43:40 DChang
1. Move the TIdTextModeResourceRecords which was defined in
IdDNSServer.pas to here.
2. Add a QueryType (DqtIXFR) in TDNSQueryRecordTypes.
Rev 1.18 6/29/04 1:22:32 PM RLebeau
Updated NormalStrToDNSStr() to use CopyTIdBytes() instead of AppendBytes()
Rev 1.17 2/11/2004 5:21:12 AM JPMugaas
Vladimir Vassiliev changes for removal of byte flipping. Network conversion
order conversion functions are used instead.
IPv6 addresses are returned in the standard form.
In WKS records, Address was changed to IPAddress to be consistant with other
record types. Address can also imply a hostname.
Rev 1.16 2/7/2004 7:18:30 PM JPMugaas
Moved some functions out of IdDNSCommon so we can use them elsewhere.
Rev 1.15 2004.02.07 5:45:10 PM czhower
Fixed compile error in D7.
Rev 1.14 2004.02.07 5:03:26 PM czhower
.net fixes.
Rev 1.13 2004.02.03 5:45:56 PM czhower
Name changes
Rev 1.12 12/7/2003 8:07:24 PM VVassiliev
string -> TIdBytes
Rev 1.11 11/15/2003 1:16:06 PM VVassiliev
Move AppendByte from IdDNSCommon to IdCoreGlobal
Rev 1.10 11/13/2003 5:46:04 PM VVassiliev
DotNet
Rev 1.9 10/25/2003 06:51:50 AM JPMugaas
Updated for new API changes and tried to restore some functionality.
Rev 1.8 10/19/2003 11:56:12 AM DSiders
Added localization comments.
Rev 1.7 2003.10.12 3:50:38 PM czhower
Compile todos
Rev 1.6 2003/5/8 ¤U¤È 08:07:12 DChang
Add several constants for IdDNSServer
Rev 1.5 4/28/2003 03:34:56 PM JPMugaas
Illiminated constant for the service path. IFDEF's for platforms are only
allowed in designated units. Besides, the location of the services file is
different in Win9x operating systems than NT operating systems.
Rev 1.4 4/28/2003 02:30:46 PM JPMugaas
reverted back to the old one as the new one checked will not compile, has
problametic dependancies on Contrs and Dialogs (both not permitted).
Rev 1.2 4/28/2003 07:00:04 AM JPMugaas
Should now compile.
Rev 1.0 11/14/2002 02:18:20 PM JPMugaas
Rev 1.3 04/28/2003 01:15:20 AM DenniesChang
// Add iRCode mode constants in May 4, 2003.
// Modify all DNS relative header in IdDNSCommon.pas
// Apr. 28, 2003
// Jun. 03, 2002.
// Add AXFR function
Duplicate some varible and constants in DNSCommon,
because Indy change version very frequently, these
varlibles and objects are isolated.
I had added some methods into IdDNSResolver of Indy 9.02,
for parsing DN record directly and skip some check actions
from original query, but this modification will not relfect
the action of DN Query.
Original Programmer: Dennies Chang <dennies@ms4.hinet.net>
No Copyright. Code is given to the Indy Pit Crew.
Started: Jan. 20, 2002.
Finished:
}
unit IdDNSCommon;
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdContainers,
IdException,
IdGlobal,
IdResourceStrings,
IdResourceStringsProtocols;
const
IdDNSServerVersion = 'Indy DNSServer 20040121301'; {do not localize}
cRCodeNoError = 0;
cRCodeFormatErr = 1;
cRCodeServerErr = 2;
cRCodeNameErr = 3;
cRCodeNotImplemented = 4;
cRCodeRefused = 5;
iRCodeQueryNotImplement = 0;
iRCodeQueryReturned = 1;
iRCodeQueryOK = 2;
iRCodeQueryNotFound = 3;
iRCodeNoError = 0;
iRCodeFormatError = 1;
iRCodeServerFailure = 2;
iRCodeNameError = 3;
iRCodeNotImplemented = 4;
iRCodeRefused = 5;
iQr_Question = 0;
iQr_Answer = 1;
iAA_NotAuthoritative = 0;
iAA_Authoritative = 1;
cRCodeQueryNotImplement = 'NA'; {do not localize}
cRCodeQueryReturned = 'RC'; // Return Completed. {do not localize}
cRCodeQueryOK = 'OK'; {do not localize}
cRCodeQueryCacheOK = 'COK'; {do not localize}
cRCodeQueryNotFound = 'NOTFOUND'; {do not localize}
cRCodeQueryCacheFindError = 'CFoundError'; {do not localize}
RSDNSServerAXFRError_QuerySequenceError = 'First record must be SOA!'; {do not localize}
RSDNSServerSettingError_MappingHostError = 'Host must be an IP address'; {do not localize}
cOrigin = '$ORIGIN'; {do not localize}
cInclude = '$INCLUDE'; {do not localize}
cAAAA = 'AAAA'; {do not localize}
cAt = '@'; {do not localize}
cA = 'A'; {do not localize}
cNS = 'NS'; {do not localize}
cMD = 'MD'; {do not localize}
cMF = 'MF'; {do not localize}
cCName = 'CNAME'; {do not localize}
cSOA = 'SOA'; {do not localize}
cMB = 'MB'; {do not localize}
cMG = 'MG'; {do not localize}
cMR = 'MR'; {do not localize}
cNULL = 'NULL'; {do not localize}
cWKS = 'WKS'; {do not localize}
cPTR = 'PTR'; {do not localize}
cHINFO = 'HINFO'; {do not localize}
cMINFO = 'MINFO'; {do not localize}
cMX = 'MX'; {do not localize}
cTXT = 'TXT'; {do not localize}
cNSAP = 'NSAP'; {do not localize}
cNSAP_PTR = 'NSAP-PTR'; {do not localize}
cLOC = 'LOC'; {do not localize}
cAXFR = 'AXFR'; {do not localize}
cIXFR = 'IXFR'; {do not localize}
cSTAR = 'STAR'; {do not localize}
cRCodeStrs : Array[cRCodeNoError..cRCodeRefused] Of String =
(RSCodeNoError,
RSCodeQueryFormat,
RSCodeQueryServer,
RSCodeQueryName,
RSCodeQueryNotImplemented,
RSCodeQueryQueryRefused);
Class_IN = 1;
Class_CHAOS = 3;
TypeCode_A = 1;
TypeCode_NS = 2;
TypeCode_MD = 3;
TypeCode_MF = 4;
TypeCode_CName = 5;
TypeCode_SOA = 6;
TypeCode_MB = 7;
TypeCode_MG = 8;
TypeCode_MR = 9;
TypeCode_NULL = 10;
TypeCode_WKS = 11;
TypeCode_PTR = 12;
TypeCode_HINFO = 13;
TypeCode_MINFO = 14;
TypeCode_MX = 15;
TypeCode_TXT = 16;
TypeCode_RP = 17;
TypeCode_AFSDB = 18;
TypeCode_X25 = 19;
TypeCode_ISDN = 20;
TypeCode_RT = 21;
TypeCode_NSAP = 22;
TypeCode_NSAP_PTR = 23;
TypeCode_SIG = 24;
TypeCode_KEY = 25;
TypeCode_PX = 26;
TypeCode_QPOS = 27;
TypeCode_AAAA = 28;
TypeCode_LOC = 29;
TypeCode_NXT = 30;
TypeCode_R31 = 31;
TypeCode_R32 = 32;
TypeCode_Service = 33;
TypeCode_R34 = 34;
TypeCode_NAPTR = 35;
TypeCode_KX = 36;
TypeCode_CERT = 37;
TypeCode_V6Addr = 38;
TypeCode_DNAME = 39;
TypeCode_R40 = 40;
TypeCode_OPTIONAL = 41;
TypeCode_IXFR = 251;
TypeCode_AXFR = 252;
TypeCode_STAR = 255;
TypeCode_Error = 0;
type
{NormalTags = (cA, cNS, cMD, cMF, cCName, cSOA, cMB, cMG, cMR, cNULL, cWKS, cPTR,
cHINFO, cMINFO, cMX, cTXT); }
TDNSQueryRecordTypes = (DqtA, DqtNS, DqtMD, DqtMF, DqtName, DqtSOA, DqtMB,
DqtMG, DqtMR, DqtNull, DqtWKS, DqtPTR, DqtHINFO, DqtMINFO, DqtMX, DqtTXT,
DqtNSAP, DqtNSAP_PTR, DqtLOC, DqtIXFR, DqtAXFR, DqtSTAR, DqtAAAA);
TDNSServerTypes = (stPrimary, stSecondary);
EIdDNSServerSyncException = class(EIdSilentException);
EIdDNSServerSettingException = class(EIdSilentException);
// TODO: enable AD and CD properties. Those fields are reserved in RFC 1035, but defined in RFC 6895
TDNSHeader = class
private
FID: UInt16;
FBitCode: UInt16;
FQDCount: UInt16;
FANCount: UInt16;
FNSCount: UInt16;
FARCount: UInt16;
function GetAA: UInt16;
//function GetAD: UInt16;
//function GetCD: UInt16;
function GetOpCode: UInt16;
function GetQr: UInt16;
function GetRA: UInt16;
function GetRCode: UInt16;
function GetRD: UInt16;
function GetTC: UInt16;
procedure SetAA(const Value: UInt16);
//procedure SetAD(const Value: UInt16);
//procedure SetCD(const Value: UInt16);
procedure SetOpCode(const Value: UInt16);
procedure SetQr(const Value: UInt16);
procedure SetRA(const Value: UInt16);
procedure SetRCode(const Value: UInt16);
procedure SetRD(const Value: UInt16);
procedure SetTC(const Value: UInt16);
procedure SetBitCode(const Value: UInt16);
public
constructor Create;
procedure ClearByteCode;
function ParseQuery(Data : TIdBytes) : integer;
function GenerateBinaryHeader : TIdBytes;
property ID: UInt16 read FID write FID;
property Qr: UInt16 read GetQr write SetQr;
property OpCode: UInt16 read GetOpCode write SetOpCode;
property AA: UInt16 read GetAA write SetAA;
//property AD: UInt16 get GetAD write SetAD;
//property CD: UInt16 get GetCD write SetCD;
property TC: UInt16 read GetTC write SetTC;
property RD: UInt16 read GetRD write SetRD;
property RA: UInt16 read GetRA write SetRA;
property RCode: UInt16 read GetRCode write SetRCode;
property BitCode: UInt16 read FBitCode write SetBitCode;
property QDCount: UInt16 read FQDCount write FQDCount;
property ANCount: UInt16 read FANCount write FANCount;
property NSCount: UInt16 read FNSCount write FNSCount;
property ARCount: UInt16 read FARCount write FARCount;
end;
TIdTextModeResourceRecord = class(TObject)
protected
FAnswer : TIdBytes;
FRRName: string;
FRRDatas: TStrings; //TODO Should not be TIdStrings
FTTL: Int32;
FTypeCode: Integer;
FTimeOut: string;
function FormatQName(const AFullName: string): string; overload;
function FormatQName(const AName, AFullName: string): string; overload;
function FormatQNameFull(const AFullName: string): string;
function FormatRecord(const AFullName: String; const ARRData: TIdBytes): TIdBytes;
procedure SetRRDatas(const Value: TStrings);
procedure SetTTL(const Value: Int32);
public
constructor CreateInit(const ARRName: String; ATypeCode: Integer);
destructor Destroy; override;
property TypeCode : Integer read FTypeCode;
property RRName : string read FRRName write FRRName;
property RRDatas : TStrings read FRRDatas write SetRRDatas;
property TTL : integer read FTTL write SetTTL;
property TimeOut : string read FTimeOut write FTimeOut;
function ifAddFullName(AFullName: string; AGivenName: string = ''): boolean;
function GetValue(const AName: String): String;
procedure SetValue(const AName: String; const AValue: String);
function ItemCount : Integer;
function BinQueryRecord(AFullName: string): TIdBytes; virtual;
function TextRecord(AFullName: string): string; virtual;
procedure ClearAnswer;
end;
TIdTextModeRRs = class(TIdObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdTextModeResourceRecord>{$ENDIF})
private
FItemNames : TStrings;
{$IFNDEF HAS_GENERICS_TObjectList}
function GetItem(Index: Integer): TIdTextModeResourceRecord;
procedure SetItem(Index: Integer; const Value: TIdTextModeResourceRecord);
{$ENDIF}
procedure SetItemNames(const Value: TStrings);
public
constructor Create;
destructor Destroy; override;
property ItemNames : TStrings read FItemNames write SetItemNames;
{$IFNDEF HAS_GENERICS_TObjectList}
property Items[Index: Integer]: TIdTextModeResourceRecord read GetItem write SetItem; default;
{$ENDIF}
end;
TIdRR_CName = class(TIdTextModeResourceRecord)
protected
function GetCName: String;
procedure SetCName(const Value: String);
public
constructor Create;
property CName : String read GetCName write SetCName;
function BinQueryRecord(AFullName: string): TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_HINFO = class(TIdTextModeResourceRecord)
protected
procedure SetCPU(const Value: String);
function GetCPU: String;
function GetOS: String;
procedure SetOS(const Value: String);
public
constructor Create;
property CPU : String read GetCPU write SetCPU;
property OS : String read GetOS write SetOS;
function BinQueryRecord(AFullName : string): TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_MB = class(TIdTextModeResourceRecord)
protected
function GetMADName: String;
procedure SetMADName(const Value: String);
public
constructor Create;
property MADName : String read GetMADName write SetMADName;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_MG = class(TIdTextModeResourceRecord)
protected
function GetMGMName: String;
procedure SetMGMName(const Value: String);
public
constructor Create;
property MGMName : String read GetMGMName write SetMGMName;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_MINFO = class(TIdTextModeResourceRecord)
protected
procedure SetErrorHandle_Mail(const Value: String);
procedure SetResponsible_Mail(const Value: String);
function GetEMail: String;
function GetRMail: String;
public
constructor Create;
property Responsible_Mail : String read GetRMail write SetResponsible_Mail;
property ErrorHandle_Mail : String read GetEMail write SetErrorHandle_Mail;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_MR = class(TIdTextModeResourceRecord)
protected
function GetNewName: String;
procedure SetNewName(const Value: String);
public
constructor Create;
property NewName : String read GetNewName write SetNewName;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_MX = class(TIdTextModeResourceRecord)
protected
function GetExchang: String;
procedure SetExchange(const Value: String);
function GetPref: String;
procedure SetPref(const Value: String);
public
constructor Create;
property Exchange : String read GetExchang write SetExchange;
property Preference : String read GetPref write SetPref;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_NS = class(TIdTextModeResourceRecord)
protected
function GetNS: String;
procedure SetNS(const Value: String);
public
constructor Create;
property NSDName : String read GetNS write SetNS;
function BinQueryRecord(AFullName : string): TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_PTR = class(TIdTextModeResourceRecord)
protected
function GetPTRName: String;
procedure SetPTRName(const Value: String);
public
constructor Create;
property PTRDName : String read GetPTRName write SetPTRName;
function BinQueryRecord(AFullName : string): TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_SOA = class(TIdTextModeResourceRecord)
protected
function GetName(const CLabel : String): String;
procedure SetName(const CLabel: String; const Value : String);
function GetMName: String;
function GetRName: String;
procedure SetMName(const Value: String);
procedure SetRName(const Value: String);
function GetMin: String;
function GetRefresh: String;
function GetRetry: String;
function GetSerial: String;
procedure SetMin(const Value: String);
procedure SetRefresh(const Value: String);
procedure SetRetry(const Value: String);
procedure SetSerial(const Value: String);
function GetExpire: String;
procedure SetExpire(const Value: String);
public
constructor Create;
property MName : String read GetMName write SetMName;
property RName : String read GetRName write SetRName;
property Serial : String read GetSerial write SetSerial;
property Refresh : String read GetRefresh write SetRefresh;
property Retry : String read GetRetry write SetRetry;
property Expire : String read GetExpire write SetExpire;
property Minimum : String read GetMin write SetMin;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_A = class(TIdTextModeResourceRecord)
protected
function GetA: String;
procedure SetA(const Value: String);
public
constructor Create;
property Address : String read GetA write SetA;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_AAAA = class(TIdTextModeResourceRecord)
protected
function GetA: String;
procedure SetA(const Value: String);
public
constructor Create;
property Address : String read GetA write SetA;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
{ TODO : implement WKS record class }
TIdRR_WKS = class(TIdTextModeResourceRecord)
public
constructor Create;
end;
TIdRR_TXT = class(TIdTextModeResourceRecord)
protected
function GetTXT: String;
procedure SetTXT(const Value: String);
public
constructor Create;
property TXT : String read GetTXT write SetTXT;
function BinQueryRecord(AFullName : string) : TIdBytes; override;
function TextRecord(AFullName : string) : string; override;
end;
TIdRR_Error = class(TIdTextModeResourceRecord)
public
constructor Create;
end;
function DomainNameToDNSStr(const ADomain : String): TIdBytes;
function NormalStrToDNSStr(const Str : String): TIdBytes;
function IPAddrToDNSStr(const IPAddress : String): TIdBytes;
function IsValidIPv6(const v6Address : String): Boolean;
function ConvertToValidv6IP(const OrgIP : String) : string;
function ConvertToCanonical6IP(const OrgIP : String) : string;
function IPv6AAAAToDNSStr(const AIPv6Address : String): TIdBytes;
function GetErrorStr(const Code, Id: Integer): String;
function GetRCodeStr(RCode : Integer): String;
function ReplaceSpecString(Source, Target, NewString : string; ReplaceAll : boolean = True) : string;
function IsBig5(ch1, ch2: Char) : Boolean;
implementation
uses
{$IFDEF VCL_XE3_OR_ABOVE}
{$IFNDEF NEXTGEN}
System.Contnrs,
{$ENDIF}
{$ENDIF}
{$IFDEF HAS_UNIT_DateUtils}
DateUtils,
{$ENDIF}
IdGlobalProtocols,
IdStack, SysUtils;
const
ValidHexChars = '0123456789ABCDEFabcdef';
procedure IdBytesCopyBytes(const ASource: TIdBytes; var VDest: TIdBytes; var VDestIndex: Integer);
begin
CopyTIdBytes(ASource, 0, VDest, VDestIndex, Length(ASource));
Inc(VDestIndex, Length(ASource));
end;
procedure IdBytesCopyUInt16(const ASource: UInt16; var VDest: TIdBytes; var VDestIndex: Integer);
begin
CopyTIdUInt16(ASource, VDest, VDestIndex);
Inc(VDestIndex, SizeOf(UInt16));
end;
procedure IdBytesCopyUInt32(const ASource: UInt32; var VDest: TIdBytes; var VDestIndex: Integer);
begin
CopyTIdUInt32(ASource, VDest, VDestIndex);
Inc(VDestIndex, SizeOf(UInt32));
end;
function DomainNameToDNSStr(const ADomain : string): TIdBytes;
var
BufStr, LDomain : String;
LIdx : Integer;
LLen: Byte;
begin
if Length(ADomain) = 0 then begin
SetLength(Result, 0);
end else begin
// TODO: ned to re-write this...
SetLength(Result, Length(ADomain)+1);
LIdx := 0;
LDomain := ADomain;
repeat
BufStr := Fetch(LDomain, '.');
LLen := Length(BufStr);
Result[LIdx] := LLen;
CopyTIdString(BufStr, Result, LIdx+1, LLen);
Inc(LIdx, LLen+1);
until LDomain = '';
Result[LIdx] := 0;
SetLength(Result, LIdx+1);
end;
end;
function NormalStrToDNSStr(const Str : String): TIdBytes;
var
LLen: Byte;
LStr: TIdBytes;
begin
LStr := ToBytes(Str);
LLen := IndyMin(Length(LStr), $FF);
SetLength(Result, 1 + LLen);
Result[0] := LLen;
CopyTIdBytes(LStr, 0, Result, 1, LLen);
end;
function IPAddrToDNSStr(const IPAddress : String): TIdBytes;
Var
j, i: Integer;
s : string;
begin
SetLength(Result, 0);
if IsValidIP(IPAddress) then begin
s := Trim(IPAddress);
SetLength(Result, 4);
for i := 0 to 3 do begin
j := IndyStrToInt(Fetch(s, '.'), -1); {do not localize}
if (j < 0) or (j > 255) then begin
Result := ToBytes('Error IP'); {do not localize}
Exit;
end;
Result[I] := Byte(j);
end;
end else begin
Result := ToBytes('Error IP'); {do not localize}
end;
end;
procedure IdHexToBin(const AText: TIdBytes; var Buffer: TIdBytes; const BufSize: Integer);
const
Convert: array['0'..'f'] of Int16 = {do not localize}
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
-1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,10,11,12,13,14,15);
var
BufferPos, TextPos: Integer;
ValidChars: TIdBytes;
begin
ValidChars := ToBytes(ValidHexChars);
BufferPos := 0;
TextPos := 0;
repeat
if (not ByteIsInSet(AText, TextPos, ValidChars)) or
(not ByteIsInSet(AText, TextPos+1, ValidChars)) then
begin
Break;
end;
Buffer[BufferPos] := (Convert[Char(AText[TextPos])] shl 4) + Convert[Char(AText[TextPos + 1])];
Inc(BufferPos);
Inc(TextPos, 2);
until False;
end;
function IPv6AAAAToDNSStr(const AIPv6Address : String): TIdBytes;
var
LAddr : TIdIPv6Address;
begin
IPv6ToIdIPv6Address(AIPv6Address, LAddr);
SetLength(Result, 16);
CopyTIdIPV6Address(LAddr, Result, 0);
end;
function IsValidIPv6(const v6Address : String): boolean;
var
Temps : TStrings;
Apart, All: String;
Count, Loc, Goal : integer;
begin
All := v6Address;
Temps := TStringList.Create;
try
// Check Double Colon existence, but only single.
Count := 0;
repeat
Loc := IndyPos('::', All); {do not localize}
if Loc > 0 then begin
Count := Count + 1;
IdDelete(All, Loc, 2);
end;
until Loc = 0;
if Count <= 1 then begin
// Convert Double colon into compatible format.
All := ReplaceSpecString(v6Address, '::', ':Multi:'); {do not localize}
repeat
Apart := Fetch(All, ':'); {do not localize}
Temps.Add(Apart);
until All = ''; {do not localize}
Loc := Temps.IndexOf('Multi'); {do not localize}
if Loc > -1 then begin
Goal := 8 - Temps.Count;
Temps.Strings[Loc] := '0000'; {do not localize}
for Count := 0 to Goal -1 do begin
Temps.Insert(Loc, '0000'); {do not localize}
end;
if Temps.Strings[0] = '' then begin {do not localize}
Temps.Strings[0] := '0000'; {do not localize}
end;
end;
All := ReplaceSpecString(Temps.CommaText, ',', ':'); {do not localize}
Result := True;
Temps.Clear;
repeat
Apart := Trim(Fetch(All, ':')); {do not localize}
if Length(Apart) <= 4 then begin
Apart := '0000' + Apart; {do not localize}
Apart := Copy(Apart, Length(Apart)-3, 4);
Temps.Add(Apart);
end else begin
Result := False;
end;
until (All = '') or (not Result); {do not localize}
if (not Result) or (Temps.Count > 8) then begin
Result := False;
end else begin
for Count := 0 to Temps.Count -1 do begin
All := All + Temps.Strings[Count];
end;
Result := Length(All) > 0;
for Count := 1 to Length(All) do begin
Result := CharIsInSet(All, Count, ValidHexChars);
if not Result then begin
Break;
end;
end;
end;
end else begin
// mulitple Double colon, it's an incorrect IPv6 address.
Result := False;
end;
finally
FreeAndNil(Temps);
end;
end;
function ConvertToValidv6IP(const OrgIP : String) : string;
var
All, Apart : string;
Temps : TStrings;
Count, Loc, Goal : integer;
begin
Result := '';
All := OrgIP;
Temps := TStringList.Create;
try
// Check Double Colon existence, but only single.
// Count := 0;
repeat
Loc := IndyPos('::', All); {do not localize}
if Loc > 0 then begin
// Count := Count + 1;
IdDelete(All, Loc, 2);
end;
until Loc = 0;
// Convert Double colon into compatible format.
All := ReplaceSpecString(OrgIP, '::', ':Multi:'); {do not localize}
repeat
Apart := Fetch(All, ':'); {do not localize}
Temps.Add(Apart);
until All = ''; {do not localize}
Loc := Temps.IndexOf('Multi'); {do not localize}
if Loc > -1 then begin
Goal := 8 - Temps.Count;
Temps.Strings[Loc] := '0000'; {do not localize}
for Count := 0 to Goal -1 do begin
Temps.Insert(Loc, '0000'); {do not localize}
end;
if Temps.Strings[0] = '' then begin
Temps.Strings[0] := '0000'; {do not localize}
end;
end;
Result := ReplaceSpecString(Temps.CommaText, ',', ':'); {do not localize}
finally
FreeAndNil(Temps);
end;
end;
function ConvertToCanonical6IP(const OrgIP : String) : string;
var
All, Apart: string;
begin
{Supposed OrgIP is valid IPV6 string}
Result := ''; {do not localize}
All := ConvertToValidv6IP(OrgIP);
repeat
Apart := Trim(Fetch(All, ':')); {do not localize}
if Length(Apart) < 4 then
begin
Apart := '0000' + Apart; {do not localize}
Apart := Copy(Apart, Length(Apart)-3, 4);
end;
Result := Result + Apart + ':'; {do not localize}
until (All = ''); {do not localize}
SetLength(Result, Length(Result) - 1); //Remove last :
end;
{ TODO : Move these to member }
function GetErrorStr(const Code, Id: Integer): String;
begin
case Code of
1 : Result := IndyFormat(RSQueryInvalidQueryCount, [Id]);
2 : Result := IndyFormat(RSQueryInvalidPacketSize, [Id]);
3 : Result := IndyFormat(RSQueryLessThanFour, [Id]);
4 : Result := IndyFormat(RSQueryInvalidHeaderID, [Id] );
5 : Result := IndyFormat(RSQueryLessThanTwelve, [Id]);
6 : Result := IndyFormat(RSQueryPackReceivedTooSmall, [Id]);
else
Result := IndyFormat(RSQueryUnknownError, [Code, Id]);
end; //case code Of
end;
function GetRCodeStr(RCode : Integer): String;
begin
if Rcode in [cRCodeNoError..cRCodeRefused] then begin
Result := cRCodeStrs[Rcode];
end else begin // if Rcode in [cRCodeNoError..cRCodeRefused] then
Result := RSCodeQueryUnknownError;
end; //else.. if Rcode in [cRCodeNoError..cRCodeRefused] then
end;
{ TDNSHeader }
procedure TDNSHeader.ClearByteCode;
begin
FBitCode := 0;
end;
constructor TDNSHeader.Create;
begin
inherited Create;
Randomize;
FId := Random(65535);
end;
function TDNSHeader.GenerateBinaryHeader: TIdBytes;
{
The header contains the following fields:
1 1 1 1 1 1
0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| ID |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|QR| Opcode |AA|TC|RD|RA| Z|AD|CD| RCODE |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| QDCOUNT/ZOCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| ANCOUNT/PRCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| NSCOUNT/UPCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
| ARCOUNT |
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
where:
ID A 16 bit identifier assigned by the program that
generates any kind of query. This identifier is copied
the corresponding reply and can be used by the requester
to match up replies to outstanding queries.
QR A one bit field that specifies whether this message is a
query (0), or a response (1).
OPCODE A four bit field that specifies kind of query in this
message. This value is set by the originator of a query
and copied into the response. The values are:
0 a standard query (QUERY)
1 an inverse query (IQUERY)
2 a server status request (STATUS)
3-15 reserved for future use
AA Authoritative Answer - this bit is valid in responses,
and specifies that the responding name server is an
authority for the domain name in question section.
Note that the contents of the answer section may have
multiple owner names because of aliases. The AA bit
corresponds to the name which matches the query name, or
the first owner name in the answer section.
TC TrunCation - specifies that this message was truncated
due to length greater than that permitted on the
transmission channel.
RD Recursion Desired - this bit may be set in a query and
is copied into the response. If RD is set, it directs
the name server to pursue the query recursively.
Recursive query support is optional.
RA Recursion Available - this be is set or cleared in a
response, and denotes whether recursive query support is
available in the name server.
Z Reserved for future use. Must be zero in all queries
and responses.
AD Authentic Data - signal indicating that the requester
understands and is interested in the value of the AD bit
in the response. This allows a requester to indicate that
it understands the AD bit without also requesting DNSSEC
data via the DO bit.
CD Checking Disabled
RCODE Response code - this 4 bit field is set as part of
responses. The values have the following
interpretation:
0 No error condition
1 Format error - The name server was
unable to interpret the query.
2 Server failure - The name server was
unable to process this query due to a
problem with the name server.
3 Name Error - Meaningful only for
responses from an authoritative name
server, this code signifies that the
domain name referenced in the query does
not exist.
4 Not Implemented - The name server does
not support the requested kind of query.
5 Refused - The name server refuses to
perform the specified operation for
policy reasons. For example, a name
server may not wish to provide the
information to the particular requester,
or a name server may not wish to perform
a particular operation (e.g., zone
transfer) for particular data.
6-15 Reserved for future use.
QDCOUNT an unsigned 16 bit integer specifying the number of
entries in the question section.
ANCOUNT an unsigned 16 bit integer specifying the number of
resource records in the answer section.
NSCOUNT an unsigned 16 bit integer specifying the number of name
server resource records in the authority records
section.
ARCOUNT an unsigned 16 bit integer specifying the number of
resource records in the additional records section.
}
begin
SetLength(Result, 12);
UInt16ToTwoBytes(GStack.HostToNetwork(ID), Result, 0);
UInt16ToTwoBytes(GStack.HostToNetwork(BitCode), Result, 2);
UInt16ToTwoBytes(GStack.HostToNetwork(QDCount), Result, 4);
UInt16ToTwoBytes(GStack.HostToNetwork(ANCount), Result, 6);
UInt16ToTwoBytes(GStack.HostToNetwork(NSCount), Result, 8);
UInt16ToTwoBytes(GStack.HostToNetwork(ARCount), Result, 10);
end;
function TDNSHeader.GetAA: UInt16;
begin
Result := (FBitCode shr 10) and $0001;
end;
{
function TDNSHeader.GetAD: UInt16;
begin
Result := (FBitCode shr 5) and $0001;
end;
function TDNSHeader.GetCD: UInt16;
begin
Result := (FBitCode shr 4) and $0001;
end;
}
function TDNSHeader.GetOpCode: UInt16;
begin
Result := (FBitCode shr 11) and $000F;
end;
function TDNSHeader.GetQr: UInt16;
begin
Result := (FBitCode shr 15) and $0001;
end;
function TDNSHeader.GetRA: UInt16;
begin
Result := (FBitCode shr 7) and $0001;
end;
function TDNSHeader.GetRCode: UInt16;
begin
Result := FBitCode and $000F;
end;
function TDNSHeader.GetRD: UInt16;
begin
Result := (FBitCode shr 8) and $0001;
end;
function TDNSHeader.GetTC: UInt16;
begin
Result := (FBitCode shr 9) and $0001;
end;
function TDNSHeader.ParseQuery(Data: TIdBytes): integer;
begin
Result := -1;
if Length(Data) >= 12 then begin
try
ID := GStack.NetworkToHost(BytesToUInt16(Data, 0));
BitCode := GStack.NetworkToHost(BytesToUInt16(Data, 2));
QDCount := GStack.NetworkToHost(BytesToUInt16(Data, 4));
ANCount := GStack.NetworkToHost(BytesToUInt16(Data, 6));
NSCount := GStack.NetworkToHost(BytesToUInt16(Data, 8));
ARCount := GStack.NetworkToHost(BytesToUInt16(Data, 10));
Result := 0;
except
end;
end;
end;
procedure TDNSHeader.SetAA(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $FBFF;
end else begin
FBitCode := FBitCode or $0400;
end;
end;
{
procedure TDNSHeader.SetAD(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $FFDF;
end else begin
FBitCode := FBitCode or $0020;
end;
end;
}
procedure TDNSHeader.SetBitCode(const Value: UInt16);
begin
FBitCode := Value;
end;
{
procedure TDNSHeader.SetCD(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $FFEF;
end else begin
FBitCode := FBitCode or $0010;
end;
end;
}
procedure TDNSHeader.SetOpCode(const Value: UInt16);
begin
FBitCode := (FBitCode and $87FF) or ((Value and $000F) shl 11);
end;
procedure TDNSHeader.SetQr(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $7FFF;
end else begin
FBitCode := FBitCode or $8000;
end;
end;
procedure TDNSHeader.SetRA(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $FF7F;
end else begin
FBitCode := FBitCode or $0080;
end;
end;
procedure TDNSHeader.SetRCode(const Value: UInt16);
begin
FBitCode := (FBitCode and $FFF0) or (Value and $000F);
end;
procedure TDNSHeader.SetRD(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $FEFF;
end else begin
FBitCode := FBitCode or $0100;
end;
end;
procedure TDNSHeader.SetTC(const Value: UInt16);
begin
if Value = 0 then begin
FBitCode := FBitCode and $FDFF;
end else begin
FBitCode := FBitCode or $0200;
end;
end;
{ TIdTextModeResourceRecord }
function TIdTextModeResourceRecord.BinQueryRecord(AFullName: string): TIdBytes;
begin
// This was empty? Where did it go?
//todo;
// Explain by Dennies : No, here must be empty, it's only a
// virtual method, for child class to implement.
Result := nil;
end;
procedure TIdTextModeResourceRecord.ClearAnswer;
begin
SetLength(FAnswer, 0);
end;
constructor TIdTextModeResourceRecord.CreateInit(const ARRName: String; ATypeCode: Integer);
begin
inherited Create;
SetLength(FAnswer, 0);
FRRName := ARRName;
FTypeCode := ATypeCode;
FRRDatas := TStringList.Create;
TTL := 0;
end;
destructor TIdTextModeResourceRecord.Destroy;
begin
FreeAndNil(FRRDatas);
inherited Destroy;
end;
function TIdTextModeResourceRecord.FormatQName(const AFullName: string): string;
begin
Result := FormatQName(FRRName, AFullName);
end;
function TIdTextModeResourceRecord.FormatQName(const AName, AFullName: string): string;
begin
if Copy(AName, Length(AName), 1) <> '.' then begin
Result := AName + '.' + AFullName;
end else begin
Result := AName;
end;
end;
function TIdTextModeResourceRecord.FormatQNameFull(const AFullName: string): string;
var
LQName: string;
begin
LQName := FRRName + '.';
if LQName <> AFullName then begin
LQName := FormatQName(AFullName);
end;
if LQName = AFullName then begin
Result := '@';
end else begin
Result := LQName;
end;
end;
function TIdTextModeResourceRecord.FormatRecord(const AFullName: String; const ARRData: TIdBytes): TIdBytes;
var
LDomain: TIdBytes;
LIdx: Integer;
begin
LDomain := DomainNameToDNSStr(FormatQName(AFullName));
SetLength(Result, Length(LDomain)+(SizeOf(UInt16)*3)+SizeOf(UInt32)+Length(ARRData));
LIdx := 0;
IdBytesCopyBytes(LDomain, Result, LIdx);
IdBytesCopyUInt16(GStack.HostToNetwork(UInt16(TypeCode)), Result, LIdx);
IdBytesCopyUInt16(GStack.HostToNetwork(UInt16(Class_IN)), Result, LIdx);
IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(TTL)), Result, LIdx);
IdBytesCopyUInt16(GStack.HostToNetwork(UInt16(Length(ARRData))), Result, LIdx);
IdBytesCopyBytes(ARRData, Result, LIdx);
end;
function TIdTextModeResourceRecord.GetValue(const AName: String): String;
begin
Result := RRDatas.Values[AName];
end;
procedure TIdTextModeResourceRecord.SetValue(const AName: String; const AValue: String);
begin
RRDatas.Values[AName] := AValue;
end;
function TIdTextModeResourceRecord.ifAddFullName(AFullName, AGivenName: string): boolean;
var
LTailString, LBackString, LDestination : string;
LTS, LRR : integer;
begin
if AGivenName = '' then begin
LDestination := RRName;
end else begin
LDestination := AGivenName;
end;
if TextEndsWith(LDestination, '.') then begin
Result := False;
end else begin
if TextEndsWith(AFullName, '.') then begin
LTailString := Copy(AFullName, 1, Length(AFullName) - 1);
end else begin
LTailString := AFullName;
end;
LTS := Length(LTailString);
LRR := Length(LDestination);
if LRR >= LTS then begin
LBackString := Copy(LDestination, LRR - LTS + 1 , LTS);
Result := not (LBackString = LTailString);
end else begin
Result := True;
end;
end;
end;
function TIdTextModeResourceRecord.ItemCount: integer;
begin
Result := RRDatas.Count;
end;
procedure TIdTextModeResourceRecord.SetRRDatas(const Value: TStrings);
begin
FRRDatas.Assign(Value);
end;
procedure TIdTextModeResourceRecord.SetTTL(const Value: integer);
begin
FTTL := Value;
FTimeOut := DateTimeToStr(AddMSecToTime(Now, Value * 1000));
end;
function TIdTextModeResourceRecord.TextRecord(AFullName: string): string;
begin
Result := '';
end;
{ TIdTextModeRRs }
constructor TIdTextModeRRs.Create;
begin
inherited Create;
FItemNames := TStringList.Create;
end;
destructor TIdTextModeRRs.Destroy;
begin
FreeAndNil(FItemNames);
inherited Destroy;
end;
{$IFNDEF HAS_GENERICS_TObjectList}
function TIdTextModeRRs.GetItem(Index: Integer): TIdTextModeResourceRecord;
begin
Result := TIdTextModeResourceRecord(inherited GetItem(Index));
end;
procedure TIdTextModeRRs.SetItem(Index: Integer; const Value: TIdTextModeResourceRecord);
begin
inherited SetItem(Index, Value);
end;
{$ENDIF}
procedure TIdTextModeRRs.SetItemNames(const Value: TStrings);
begin
FItemNames.Assign(Value);
end;
{ TIdRR_CName }
function TIdRR_CName.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(CName);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_CName.Create;
begin
inherited CreateInit('CName', TypeCode_CName); {do not localize}
CName := '';
end;
function TIdRR_CName.GetCName: String;
begin
Result := GetValue('CName'); {do not localize}
end;
procedure TIdRR_CName.SetCName(const Value: String);
begin
SetValue('CName', Value); {do not localize}
end;
function TIdRR_CName.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'CNAME' + Chr(9) + CName + EOL; {do not localize}
end;
{ TIdRR_HINFO }
function TIdRR_HINFO.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
if Length(FAnswer) = 0 then begin
RRData := NormalStrToDNSStr(CPU);
AppendBytes(RRData, NormalStrToDNSStr(OS));
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_HINFO.Create;
begin
inherited CreateInit('HINFO', TypeCode_HINFO); {do not localize}
CPU := '';
OS := '';
end;
function TIdRR_HINFO.GetCPU: String;
begin
Result := GetValue('CPU'); {do not localize}
end;
function TIdRR_HINFO.GetOS: String;
begin
Result := GetValue('OS'); {do not localize}
end;
procedure TIdRR_HINFO.SetCPU(const Value: String);
begin
SetValue('CPU', Value); {do not localize}
end;
procedure TIdRR_HINFO.SetOS(const Value: String);
begin
SetValue('OS', Value); {do not localize}
end;
function TIdRR_HINFO.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'HINFO' + Chr(9)
+ '"' + CPU + '" "' + OS + '"' + EOL; {do not localize}
end;
{ TIdRR_MB }
function TIdRR_MB.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(MADName);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_MB.Create;
begin
inherited CreateInit('MB', TypeCode_MB); {do not localize}
MADName := '';
end;
function TIdRR_MB.GetMADName: String;
begin
Result := GetValue('MADNAME'); {do not localize}
end;
procedure TIdRR_MB.SetMADName(const Value: String);
begin
SetValue('MADNAME', Value); {do not localize}
end;
function TIdRR_MB.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MB' + Chr(9) + MADName + EOL; {do not localize}
end;
{ TIdRR_MG }
function TIdRR_MG.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(MGMName);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_MG.Create;
begin
inherited CreateInit('MG', TypeCode_MG); {do not localize}
MGMName := '';
end;
function TIdRR_MG.GetMGMName: String;
begin
Result := GetValue('MGMNAME'); {do not localize}
end;
procedure TIdRR_MG.SetMGMName(const Value: String);
begin
SetValue('MGMNAME', Value); {do not localize}
end;
function TIdRR_MG.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MG' + Chr(9) + MGMName + EOL; {do not localize}
end;
{ TIdRR_MINFO }
function TIdRR_MINFO.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
{
From: http://www.its.uq.edu.au/DMT/RFC/rfc1035.html#MINFO_RR
3.3.7. MINFO RDATA format (EXPERIMENTAL)
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
/ RMAILBX /
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
/ EMAILBX /
+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
}
begin
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(Responsible_Mail);
AppendBytes(RRData, DomainNameToDNSStr(ErrorHandle_Mail));
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_MINFO.Create;
begin
inherited CreateInit('MINFO', TypeCode_MINFO); {do not localize}
Responsible_Mail := '';
ErrorHandle_Mail := '';
end;
function TIdRR_MINFO.GetEMail: String;
begin
Result := GetValue('EMAILBX'); {do not localize}
end;
function TIdRR_MINFO.GetRMail: String;
begin
Result := GetValue('RMAILBX'); {do not localize}
end;
procedure TIdRR_MINFO.SetErrorHandle_Mail(const Value: String);
begin
SetValue('EMAILBX', Value); {do not localize}
end;
procedure TIdRR_MINFO.SetResponsible_Mail(const Value: String);
begin
SetValue('RMAILBX', Value); {do not localize}
end;
function TIdRR_MINFO.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MINFO' + Chr(9) {do not localize}
+ Responsible_Mail + ' ' + ErrorHandle_Mail + EOL; {do not localize}
end;
{ TIdRR_MR }
function TIdRR_MR.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(NewName);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_MR.Create;
begin
inherited CreateInit('MR', TypeCode_MR); {do not localize}
NewName := '';
end;
function TIdRR_MR.GetNewName: String;
begin
Result := GetValue('NewName'); {do not localize}
end;
procedure TIdRR_MR.SetNewName(const Value: String);
begin
SetValue('NewName', Value); {do not localize}
end;
function TIdRR_MR.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MR' + Chr(9) + NewName + EOL; {do not localize}
end;
{ TIdRR_MX }
function TIdRR_MX.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData, Tmp: TIdBytes;
Pref : UInt16;
begin
Tmp := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
Pref := IndyStrToInt(Preference);
RRData := ToBytes(GStack.HostToNetwork(Pref));
Tmp := DomainNameToDNSStr(FormatQName(Exchange,AFullName));
AppendBytes(RRData, Tmp);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_MX.Create;
begin
inherited CreateInit('MX', TypeCode_MX); {do not localize}
Exchange := '';
end;
function TIdRR_MX.GetExchang: String;
begin
Result := GetValue('EXCHANGE'); {do not localize}
end;
function TIdRR_MX.GetPref: String;
begin
Result := GetValue('PREF'); {do not localize}
end;
procedure TIdRR_MX.SetExchange(const Value: String);
begin
SetValue('EXCHANGE', Value); {do not localize}
end;
procedure TIdRR_MX.SetPref(const Value: String);
begin
SetValue('PREF', Value); {do not localize}
end;
function TIdRR_MX.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'MX' + Chr(9) {do not localize}
+ Preference + ' ' + Exchange + EOL; {do not localize}
end;
{ TIdRR_NS }
function TIdRR_NS.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(NSDName);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_NS.Create;
begin
inherited CreateInit('NS', TypeCode_NS); {do not localize}
NSDName := '';
end;
function TIdRR_NS.GetNS: String;
begin
Result := GetValue('NSDNAME'); {do not localize}
end;
procedure TIdRR_NS.SetNS(const Value: String);
begin
SetValue('NSDNAME', Value); {do not localize}
end;
function TIdRR_NS.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'NS' + Chr(9) + NSDName + EOL; {do not localize}
end;
{ TIdRR_PTR }
function TIdRR_PTR.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := DomainNameToDNSStr(PTRDName);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_PTR.Create;
begin
inherited CreateInit('PTR', TypeCode_PTR); {do not localize}
PTRDName := '';
end;
function TIdRR_PTR.GetPTRName: String;
begin
Result := GetValue('PTRDNAME'); {do not localize}
end;
procedure TIdRR_PTR.SetPTRName(const Value: String);
begin
SetValue('PTRDNAME', Value); {do not localize}
end;
function TIdRR_PTR.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'PTR' + Chr(9) + PTRDName + EOL; {do not localize}
end;
{ TIdRR_SOA }
function TIdRR_SOA.BinQueryRecord(AFullName: string): TIdBytes;
var
LMName, LRName, RRData: TIdBytes;
LIdx: Integer;
begin
// keep the compiler happy
LMName := nil;
LRName := nil;
RRData := nil;
if Length(FAnswer) = 0 then begin
LMName := DomainNameToDNSStr(MName);
LRName := DomainNameToDNSStr(RName);
SetLength(RRData, Length(LMName)+Length(LRName)+(SizeOf(UInt32)*5));
LIdx := 0;
IdBytesCopyBytes(LMName, RRData, LIdx);
IdBytesCopyBytes(LRName, RRData, LIdx);
IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Serial))), RRData, LIdx);
IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Refresh))), RRData, LIdx);
IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Retry))), RRData, LIdx);
IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Expire))), RRData, LIdx);
IdBytesCopyUInt32(GStack.HostToNetwork(UInt32(IndyStrToInt(Minimum))), RRData, LIdx);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_SOA.Create;
begin
inherited CreateInit('SOA', TypeCode_SOA); {do not localize}
MName := '';
RName := '';
Serial := '';
Refresh := '';
Retry := '';
Expire := '';
Minimum := '';
end;
function TIdRR_SOA.GetExpire: String;
begin
Result := GetName('EXPIRE'); {do not localize}
end;
function TIdRR_SOA.GetMin: String;
begin
Result := GetName('MINIMUM'); {do not localize}
end;
function TIdRR_SOA.GetMName: String;
begin
Result := GetName('MNAME'); {do not localize}
end;
function TIdRR_SOA.GetName(const CLabel: String): String;
begin
Result := GetValue(CLabel);
end;
function TIdRR_SOA.GetRefresh: String;
begin
Result := GetName('REFRESH'); {do not localize}
end;
function TIdRR_SOA.GetRetry: String;
begin
Result := GetName('RETRY'); {do not localize}
end;
function TIdRR_SOA.GetRName: String;
begin
Result := GetName('RNAME'); {do not localize}
end;
function TIdRR_SOA.GetSerial: String;
begin
Result := GetName('SERIAL'); {do not localize}
end;
procedure TIdRR_SOA.SetExpire(const Value: String);
begin
SetName('EXPIRE', Value); {do not localize}
end;
procedure TIdRR_SOA.SetMin(const Value: String);
begin
SetName('MINIMUM', Value); {do not localize}
end;
procedure TIdRR_SOA.SetMName(const Value: String);
begin
SetName('MNAME', Value); {do not localize}
end;
procedure TIdRR_SOA.SetName(const CLabel: String; const Value: String);
begin
SetValue(CLabel, Value);
end;
procedure TIdRR_SOA.SetRefresh(const Value: String);
begin
SetName('REFRESH', Value); {do not localize}
end;
procedure TIdRR_SOA.SetRetry(const Value: String);
begin
SetName('RETRY', Value); {do not localize}
end;
procedure TIdRR_SOA.SetRName(const Value: String);
begin
SetName('RNAME', Value); {do not localize}
end;
procedure TIdRR_SOA.SetSerial(const Value: String);
begin
SetName('SERIAL', Value); {do not localize}
end;
function TIdRR_SOA.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'SOA' + Chr(9) {do not localize}
+ MName + ' ' + RName + ' ' + Serial + ' ' + Refresh + ' ' + Retry + ' ' {do not localize}
+ Expire + ' ' + Minimum + EOL; {do not localize}
end;
{ TIdRR_A }
function TIdRR_A.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(Self.FAnswer) = 0 then begin
RRData := IPAddrToDNSStr(Address);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_A.Create;
begin
inherited CreateInit('A', TypeCode_A); {do not localize}
Address := '';
end;
function TIdRR_A.GetA: String;
begin
Result := GetValue('A'); {do not localize}
end;
procedure TIdRR_A.SetA(const Value: String);
begin
SetValue('A', Value); {do not localize}
end;
function TIdRR_A.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'A' + Chr(9) + Address + EOL; {do not localize}
end;
{ TIdRR_AAAA }
function TIdRR_AAAA.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
RRData := IPv6AAAAToDNSStr(Address);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_AAAA.Create;
begin
inherited CreateInit('AAAA', TypeCode_AAAA); {do not localize}
Address := '';
end;
function TIdRR_AAAA.GetA: String;
begin
Result := GetValue('AAAA'); {do not localize}
end;
procedure TIdRR_AAAA.SetA(const Value: String);
begin
SetValue('AAAA', Value); {do not localize}
end;
function TIdRR_AAAA.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'AAAA' + Chr(9) + Address + EOL; {do not localize}
end;
{ TIdRR_TXT }
function TIdRR_TXT.BinQueryRecord(AFullName: string): TIdBytes;
var
RRData: TIdBytes;
begin
RRData := nil; // keep the compiler happy
if Length(FAnswer) = 0 then begin
//Fix here, make the RRData being DNSStr.
//Fixed in 2005 Jan 25.
RRData := NormalStrToDNSStr(TXT);
FAnswer := FormatRecord(AFullName, RRData);
end;
Result := ToBytes(FAnswer, Length(FAnswer));
end;
constructor TIdRR_TXT.Create;
begin
inherited CreateInit('TXT', TypeCode_TXT); {do not localize}
TXT := '';
end;
function TIdRR_TXT.GetTXT: String;
begin
Result := GetValue('TXT'); {do not localize}
end;
procedure TIdRR_TXT.SetTXT(const Value: String);
begin
SetValue('TXT', Value); {do not localize}
end;
function TIdRR_TXT.TextRecord(AFullName: string): string;
begin
Result := FormatQNameFull(AFullName) + Chr(9) + 'IN' + Chr(9) + 'TXT' + Chr(9) {do not localize}
+ '"' + TXT + '"' + EOL; {do not localize}
end;
{ TIdRR_WKS }
constructor TIdRR_WKS.Create;
begin
inherited CreateInit('WKS', TypeCode_WKS); {do not localize}
end;
{ TIdRR_Error }
constructor TIdRR_Error.Create;
begin
inherited CreateInit('', TypeCode_Error); {do not localize}
end;
function ReplaceSpecString(Source, Target, NewString : string; ReplaceAll : boolean = True) : string;
var
FixingString, MiddleString, FixedString : string;
begin
if Target = NewString then begin
Result := Source;
end else begin
FixingString := Source;
MiddleString := ''; {do not localize}
FixedString := ''; {do not localize}
if Pos(Target, Source) > 0 then begin
repeat
MiddleString := Fetch(FixingString, Target);
FixedString := FixedString + MiddleString + NewString;
until (Pos(Target, FixingString) = 0) or (not ReplaceAll);
Result := FixedString + FixingString;
end else begin
Result := Source;
end;
end;
end;
function IsBig5(ch1, ch2:char) : boolean;
begin
// RLebeau 1/7/09: using Char() for #128-#255 because in D2009, the compiler
// may change characters >= #128 from their Ansi codepage value to their true
// Unicode codepoint value, depending on the codepage used for the source code.
// For instance, #128 may become #$20AC...
if (not (((ch1 >= Char(161)) and (ch1 <= Char(254))) or
((ch1 >= Char(142)) and (ch1 <= Char(160))) or
((ch1 >= Char(129)) and (ch1 <= Char(141)))) ) or
(not (((ch2 >= #64) and (ch2 <= #126)) or
((ch2 >= Char(161)) and (ch2 <= Char(254)))) ) then
begin
Result := False;
end else begin
Result := True;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink