Menu

#1 IdMXResolver Error

open
nobody
None
5
2002-02-08
2002-02-08
Anonymous
No

Source is ...

{******************************************************
*********
*
* Unit Name: IdMXResolver
* Component: TIdMXResolver
* Created : 2001-04-11
* Version : 1.0.0.0
* Purpose : MX Resolver

TIdMXResolver is a TIdDNSResolver descendant
that implements a resolver
for DNS (Domain Name Server) MX record queries
using the DNS protocol.
DNS is described in the Internet Standards
documents:

RFC 1034 Domain Names - Concepts and Facilities
RFC 1035 Domain Names - Implementation
and Specification
RFC 1591 Domain Name System Structure
and Delegation
RFC 1183 New DNS RR Definitions.
RFC 2181 Clarifications to the DNS
Specification.

* Required : Indy.
* Author : Riceball <teditor@mailroom.com>
* Copyright: 2001 by Riceball. All rights reserved.
* License : This project is subject to the Mozilla
Public License Version 1.1
(see the "License.txt"); you may not use
this project except in
compliance with the License. You may
obtain a copy of the License
at http://www.mozilla.org/MPL/

Software distributed under the License
is distributed on an "AS IS"
basis, WITHOUT WARRANTY OF ANY KIND,
either express or implied. See
the License for the specific language
governing rights and limitations
under the License.
* History :
*

*******************************************************
*********}
unit IdMXResolver;

{$I SmtpSrv.inc}

interface

uses
Classes,
IdGlobal,
IdDNSResolver,
IdException,
IdMXResolverCache;

resourcestring
RSDNSNoServerSpecified = 'No DNS Servers specified!';
RSDNSResolveFailed = 'DNS Resolver Failed.';

const
IDMAXRetry = 5;

type

TIdMXResolver = class(TIdDNSResolver)
protected
FDNSServers: TStringList;
FMaxRetry: Integer;
FMXServer: TIdMXServerItem;
FMXResolverCache: TIdMXResolverCache;

procedure SetDNSServers(aValue: TStringList);
procedure SetMXResolverCache(aValue:
TIdMXResolverCache);

procedure Notification(aComponent: TComponent;
Operation: TOperation);override;
public
constructor Create(aOwner: TComponent);override;
destructor Destroy;override;
function Resolve(const aDomain: string; const
ForceUpdate: Boolean = False): Boolean;

property RequestedRecords;
//the MX record query result.
property MXServer: TIdMXServerItem read FMXServer;
published
property DNSServers: TStringList read FDNSServers
write SetDNSServers;
//Error retry.
property MaxRetry: Integer read FMaxRetry write
FMaxRetry default IDMAXRetry;
property Cache: TIdMXResolverCache read
FMXResolverCache write SetMXResolverCache;
end;

{$ifdef WIN32}
{
Load Domain Name Servers from Win95 registry (if
have any) to a string list.
}
procedure LoadDNSServersFromReg(const aStrings:
TStrings);

//Pos begin from right.
function RPos(Ch: Char; S: string):Integer;
{$endif}

implementation

uses
{$ifdef WIN32}
Windows,
//Project JEDI Code Library (JCL)
//JclRegistry, //RegReadString
Registry,
{$endif}
{$ifdef debug}
DbugIntf,
{$endif}
SysUtils;

{$ifdef WIN32}
//Pos begin from right.
function RPos(Ch: Char; S: string):Integer;
Var
I:Integer;
Begin
i:=Length(S);
While ((i>0) and (s[i]<>ch)) Do Dec(i);
Result:=I;
End;

function RegReadString(RootKey: HKey; Key, Name:
string):String;
var
Reg:TRegistry;
begin
Result:='';
Reg:=TRegistry.Create;
try
Reg.RootKey:=RootKey;
if Reg.OpenKey(Key,True) then
result:=Reg.ReadString(Name);
finally
Reg.CloseKey;
Reg.Free;
end;
end;

Procedure LoadDNSServersFromReg(const aStrings:
TStrings);
Var
s, DomainNameServers: String;
I: Integer;
Begin
{Read the normal registry setting}
DomainNameServers := RegReadString
(HKEY_LOCAL_MACHINE,
'SYSTEM\CurrentControlSet\Services\TCPIP\Parameters
', 'NameServer');

{Read DHCP registry setting}
s := RegReadString(HKEY_LOCAL_MACHINE,
'SYSTEM\CurrentControlSet\Services\TCPIP\Parameters
', 'DhcpNameServer');
if s <> '' then
if DomainNameServers <> '' then
DomainNameServers := DomainNameServers + ' ' + s
else DomainNameServers := s;

{Read for windows9x registry setting}
s := RegReadString(HKEY_LOCAL_MACHINE,
'SYSTEM\CurrentControlSet\Services\VxD\MSTCP', 'Nam
eServer');
if s <> '' then
if DomainNameServers <> '' then
DomainNameServers := DomainNameServers + ' ' + s
else DomainNameServers := s;

if DomainNameServers <> '' then
While Length(DomainNameServers) > 0 do
Begin
I := Pos(#32, DomainNameServers);
If I = 0 then
I := Pos(',', DomainNameServers);
If I > 0 then
Begin
aStrings.Add(Copy(DomainNameServers, 1, I-1));
Delete(DomainNameServers, 1, I);
End
Else Begin
aStrings.Add(DomainNameServers);
DomainNameServers := '';
End;
End;
End;
{$endif}

{ TIdMXResolver }

constructor TIdMXResolver.Create(aOwner: TComponent);
begin
inherited;
FRequestedRecords := [cMX];
FMaxRetry := IDMAXRETRY;
FDNSServers := TStringList.Create;
FMXServer := TIdMXServerItem.Create(nil);
FDNSServers.Duplicates := dupIgnore;
end;

destructor TIdMXResolver.Destroy;
begin
FDNSServers.Free;
FMXServer.Free;
inherited;
end;

procedure TIdMXResolver.Notification(aComponent:
TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (aComponent =
FMXResolverCache) then
FMXResolverCache := nil;
inherited;
end;

function TIdMXResolver.Resolve(const aDomain: string;
const ForceUpdate: Boolean): Boolean;
var
ErrCount, i: integer;
MX: TIdMXItem;
//Success: Boolean;
begin
Result := False;
{$ifdef debug}
SendDebug('Resolve.....');
if Assigned(FMXResolverCache) then
begin
SendDebug('MXCache Assined.');
if FMXResolverCache.Active then
SendDebug('MXCache Active.');
end;
{$endif}
if not ForceUpdate and Assigned(FMXResolverCache)
and FMXResolverCache.Active then
begin
{$ifdef debug}
SendDebug('Find in Cache.');
{$endif}
i := FMXResolverCache.Find(aDomain);
if i <> -1 then
begin
FMXServer.Assign(FMXResolverCache.MXServerCache
[i]);
Result := True;
{$ifdef debug}
SendDebug('Found!');
{$endif}
exit;
end;
end;
{$ifdef debug}
SendDebug('Resolve in DNS Server.');
{$endif}
if Host <> '' then
begin
FDNSServers.Add(Host);
Host := '';
end;
if FDNSServers.Count <= 0 then
raise EIdDnsResolverError.Create
(RSDNSNoServerSpecified);

i := 0;
ErrCount := 0;
//Success := False;
while (i < FDNSServers.Count) and not Result do
begin
Host := FDNSServers[i];
try
inherited ResolveDomain(aDomain);
except
Inc(ErrCount);
if ErrCount >= FMaxRetry then
begin
//try another DNS Server
inc(i);
ErrCount := 0;
end;
Continue;
end;
Result := True;
break;
end;
if not Result then
raise EIdDnsResolverError.Create
(RSDNSResolveFailed);

FMXServer.HostName := aDomain;
FMXServer.MXServerList.Clear;
For i := 0 to DnsAnList.Count - 1 do
begin
if DnsAnList[i].aType = cMX then
begin
MX := FMXServer.MXServerList.Add;
MX.ServerName := DnsAnList[i].RData.MX.Exchange;
MX.Priority := DnsAnList
[i].RData.MX.Preference;
{if i < DnsArList.Count then
MX.IP := DnsArList
[i].Rdata.HostAddrStr;}
end;
end;

{$ifdef debug}
SendDebug('MX Svr Count:' + IntToStr
(FMXServer.MXServerList.Count));
{$endif}
if FMXServer.MXServerList.Count = 0 then
Result := False;

if Assigned(FMXResolverCache) and
FMXResolverCache.Active
and (FMXServer.MXServerList.Count > 0) then
begin
FMXResolverCache.Add(FMXServer);
{$ifdef debug}
SendDebug('MX Cache Count:' + IntToStr
(FMXResolverCache.Count));
SendDebug('New:' + FMXResolverCache
[FMXResolverCache.Count-1].HostName);
{$endif}
end;
end;

procedure TIdMXResolver.SetDNSServers(aValue:
TStringList);
begin
if aValue <> FDNSServers then
FDNSServers.Assign(aValue);
end;

procedure TIdMXResolver.SetMXResolverCache(aValue:
TIdMXResolverCache);
begin
if aValue <> FMXResolverCache then
begin
FMXResolverCache := aValue;
if Assigned(aValue) then
aValue.FreeNotification(Self);
end;
end;

end.

-----------------------------------------------------
Error is .......

[Error] IdMXResolver.pas(72):
Property 'RequestedRecords' does not exist in base
class

[Error] IdMXResolver.pas(180): Undeclared
identifier: 'FRequestedRecords'

[Error] IdMXResolver.pas(180): Undeclared
identifier: 'cMX'

[Error] IdMXResolver.pas(251): Undeclared
identifier: 'ResolveDomain'

[Error] IdMXResolver.pas(270): Undeclared
identifier: 'DnsAnList'

Discussion

  • Nobody/Anonymous

    Logged In: NO

    you need INDY 8 not 9

     
  • Nobody/Anonymous

    Logged In: NO

    If you change from Indy 9 to 8 others erros appear because
    Indy 8 don't units like IdAssignedNumbers and
    IdCoderMIME... I think it's impossible install this
    components on Delphi 6 withou code editing.

     

Log in to post a comment.

Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.