mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 10:45:58 +02:00
+ Added resolve unit for WIndows/unix
This commit is contained in:
michael
parent
769c50ddea
commit
f8aee1b333
89
fcl/Makefile
89
fcl/Makefile
@ -1,8 +1,8 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/01/14]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2002/10/05]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos macosx
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx
|
||||
override PATH:=$(subst \,/,$(PATH))
|
||||
ifeq ($(findstring ;,$(PATH)),)
|
||||
inUnix=1
|
||||
@ -58,7 +58,7 @@ ifdef inUnix
|
||||
PATHSEP=/
|
||||
else
|
||||
PATHSEP:=$(subst /,\,/)
|
||||
ifdef inCygWin
|
||||
ifneq ($(findstring sh.exe,$(SHELL)),)
|
||||
PATHSEP=/
|
||||
endif
|
||||
endif
|
||||
@ -111,11 +111,38 @@ endif
|
||||
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
|
||||
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
|
||||
ifndef FPC_VERSION
|
||||
FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
|
||||
FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
|
||||
FPC_VERSION:=$(shell $(FPC) -iV)
|
||||
endif
|
||||
export FPC FPC_VERSION FPC_COMPILERINFO
|
||||
export FPC FPC_VERSION
|
||||
unexport CHECKDEPEND ALLDEPENDENCIES
|
||||
ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
|
||||
COMPILERINFO:=$(shell $(FPC) -iSP -iTP -iSO -iTO)
|
||||
ifndef CPU_SOURCE
|
||||
CPU_SOURCE:=$(word 1,$(COMPILERINFO))
|
||||
endif
|
||||
ifndef CPU_TARGET
|
||||
CPU_TARGET:=$(word 2,$(COMPILERINFO))
|
||||
endif
|
||||
ifndef OS_SOURCE
|
||||
OS_SOURCE:=$(word 3,$(COMPILERINFO))
|
||||
endif
|
||||
ifndef OS_TARGET
|
||||
OS_TARGET:=$(word 4,$(COMPILERINFO))
|
||||
endif
|
||||
else
|
||||
ifndef CPU_SOURCE
|
||||
CPU_SOURCE:=$(shell $(FPC) -iSP)
|
||||
endif
|
||||
ifndef CPU_TARGET
|
||||
CPU_TARGET:=$(shell $(FPC) -iTP)
|
||||
endif
|
||||
ifndef OS_SOURCE
|
||||
OS_SOURCE:=$(shell $(FPC) -iSO)
|
||||
endif
|
||||
ifndef OS_TARGET
|
||||
OS_TARGET:=$(shell $(FPC) -iTO)
|
||||
endif
|
||||
endif
|
||||
ifndef CPU_TARGET
|
||||
ifdef CPU_TARGET_DEFAULT
|
||||
CPU_TARGET=$(CPU_TARGET_DEFAULT)
|
||||
@ -126,24 +153,6 @@ ifdef OS_TARGET_DEFAULT
|
||||
OS_TARGET=$(OS_TARGET_DEFAULT)
|
||||
endif
|
||||
endif
|
||||
ifneq ($(words $(FPC_COMPILERINFO)),5)
|
||||
FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
|
||||
FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
|
||||
FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
|
||||
FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
|
||||
endif
|
||||
ifndef CPU_SOURCE
|
||||
CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
|
||||
endif
|
||||
ifndef CPU_TARGET
|
||||
CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
|
||||
endif
|
||||
ifndef OS_SOURCE
|
||||
OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
|
||||
endif
|
||||
ifndef OS_TARGET
|
||||
OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
|
||||
endif
|
||||
FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
|
||||
FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
|
||||
ifneq ($(FULL_TARGET),$(FULL_SOURCE))
|
||||
@ -208,10 +217,10 @@ override PACKAGE_VERSION=1.0.6
|
||||
override TARGET_DIRS+=xml db shedit
|
||||
override TARGET_UNITS+=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
override TARGET_UNITS+=process asyncio ssockets http
|
||||
override TARGET_UNITS+=process asyncio ssockets http resolve
|
||||
endif
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
override TARGET_UNITS+=process fileinfo
|
||||
override TARGET_UNITS+=process fileinfo resolve
|
||||
endif
|
||||
ifeq ($(OS_TARGET),freebsd)
|
||||
override TARGET_UNITS+=process asyncio ssockets http
|
||||
@ -222,7 +231,7 @@ endif
|
||||
ifeq ($(OS_TARGET),openbsd)
|
||||
override TARGET_UNITS+=process asyncio ssockets http
|
||||
endif
|
||||
override TARGET_RSTS+=classes ssockets cachecls
|
||||
override TARGET_RSTS+=classes ssockets cachecls resolve
|
||||
override TARGET_EXAMPLEDIRS+=tests
|
||||
override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
@ -591,15 +600,6 @@ FPCMADE=fpcmade.nw
|
||||
ZIPSUFFIX=nw
|
||||
EXEEXT=.nlm
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
PPUEXT=.ppu
|
||||
ASMEXT=.s
|
||||
OEXT=.o
|
||||
SMARTEXT=.sl
|
||||
STATICLIBEXT=.a
|
||||
EXEEXT=
|
||||
FPCMADE=fpcmade.mcc
|
||||
endif
|
||||
ifndef ECHO
|
||||
ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
|
||||
ifeq ($(ECHO),)
|
||||
@ -892,18 +892,6 @@ ifeq ($(OS_TARGET),wdosx)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_PASZLIB=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),palmos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_PASZLIB=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_PASZLIB=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macosx)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_PASZLIB=1
|
||||
endif
|
||||
ifdef REQUIRE_PACKAGES_RTL
|
||||
PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
|
||||
ifneq ($(PACKAGEDIR_RTL),)
|
||||
@ -1124,11 +1112,6 @@ override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
|
||||
override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
|
||||
endif
|
||||
endif
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(FPC_VERSION),1.0.6)
|
||||
override FPCOPTDEF+=HASUNIX
|
||||
endif
|
||||
endif
|
||||
ifdef GCCLIBDIR
|
||||
override FPCOPT+=-Fl$(GCCLIBDIR)
|
||||
endif
|
||||
|
||||
@ -23,9 +23,9 @@ units=classes contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream
|
||||
units_freebsd=process asyncio ssockets http
|
||||
units_netbsd=process asyncio ssockets http
|
||||
units_openbsd=process asyncio ssockets http
|
||||
units_linux=process asyncio ssockets http
|
||||
units_win32=process fileinfo
|
||||
rsts=classes ssockets cachecls
|
||||
units_linux=process asyncio ssockets http resolve
|
||||
units_win32=process fileinfo resolve
|
||||
rsts=classes ssockets cachecls resolve
|
||||
exampledirs=tests
|
||||
|
||||
[compiler]
|
||||
|
||||
647
fcl/inc/resolve.pp
Normal file
647
fcl/inc/resolve.pp
Normal file
@ -0,0 +1,647 @@
|
||||
{$MODE OBJFPC}
|
||||
{$H+}
|
||||
Unit resolve;
|
||||
|
||||
{ --------------------------------------------------------------------
|
||||
Unit for internet domain calls.
|
||||
Copyright (C) 2003 Michael Van Canneyt
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 1, or (at your option)
|
||||
any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
------------------------------------------------------------------- }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
Type
|
||||
THostAddr = array[1..4] of byte;
|
||||
PHostAddr = ^THostAddr;
|
||||
TNetAddr = THostAddr;
|
||||
PNetAddr = ^TNetAddr;
|
||||
|
||||
Const
|
||||
NoAddress : THostAddr = (0,0,0,0);
|
||||
NoNet : TNetAddr = (0,0,0,0);
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Axuliary routines
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
function HostAddrToStr (Entry : THostAddr) : String;
|
||||
function StrToHostAddr (IP : String) : THostAddr;
|
||||
function NetAddrToStr (Entry : TNetAddr) : String;
|
||||
function StrToNetAddr (IP : String) : TNetAddr;
|
||||
Function HostToNet (Host : ThostAddr) : ThostAddr;
|
||||
Function HostToNet (Host : Longint) : Longint;
|
||||
Function NetToHost (Net : Longint) : Longint;
|
||||
Function NetToHost (Net : TNetAddr) : TNetAddr;
|
||||
Function ShortHostToNet (Host : Word) : Word;
|
||||
Function ShortNetToHost (Net : Word) : Word;
|
||||
|
||||
Type
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
TResolver = Class (TComponent)
|
||||
Private
|
||||
FName : String;
|
||||
FAliases : TStringList;
|
||||
FRaiseOnError : Boolean;
|
||||
FLastError: Integer;
|
||||
Function GetAlias(Index : Integer) : STring;
|
||||
Function GetAliasCount : Integer;
|
||||
Function GetAliasSorted : Boolean;
|
||||
Procedure SetAliasSorted (Value : Boolean);
|
||||
Protected
|
||||
Procedure CheckOperation(Msg : String);
|
||||
Function NameLookup(Const S : String) : Boolean; virtual;
|
||||
Procedure SaveAliases(P : PPChar);
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
Procedure ClearData; virtual;
|
||||
Property ResolvedName : String Read FName;
|
||||
Property Aliases [Index : integer ] : string Read GetAlias;
|
||||
Property AliasCount : Integer read GetAliasCount;
|
||||
Property SortAliases : Boolean Read GetAliasSorted Write SetAliasSorted;
|
||||
Property RaiseOnError : Boolean Read FRaiseOnError Write FRAiseOnError;
|
||||
Property LastError : Integer Read FlastError;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
THostResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
THostResolver = Class(TResolver)
|
||||
Private
|
||||
FHostAddress : THostAddr;
|
||||
FAddressCount : Integer;
|
||||
FAddresses : PHostAddr;
|
||||
Function GetAddress (Index : Integer) : THostAddr;
|
||||
Function GetNetAddress (Index : Integer) : THostAddr;
|
||||
Function GetNetHostAddress : THostAddr;
|
||||
Function GetAsString : String;
|
||||
Procedure SaveHostEntry (Entry : Pointer);
|
||||
Public
|
||||
Procedure ClearData; Override;
|
||||
Function NameLookup(Const S : String) : Boolean; override;
|
||||
Function AddressLookup(Const S : String) : Boolean; virtual;
|
||||
Function AddressLookup(Const Address : THostAddr) : Boolean; virtual;
|
||||
Property HostAddress : THostAddr Read FHostAddress;
|
||||
Property NetHostAddress : THostAddr Read GetNetHostAddress;
|
||||
Property AddressAsString : String Read GetAsString;
|
||||
Property AddressCount : Integer Read FAddressCount ;
|
||||
Property Addresses [Index : Integer] : ThostAddr Read GetAddress;
|
||||
Property NetAddresses [Index : Integer] : ThostAddr Read GetNetAddress;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TNetResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
TNetResolver = Class(TResolver)
|
||||
Private
|
||||
FNetAddress : TNetAddr;
|
||||
FAddrType : Integer;
|
||||
Function GetAsString : String;
|
||||
Procedure SaveNetEntry(Entry : Pointer);
|
||||
Function GetNetAddress : TNetAddr;
|
||||
Public
|
||||
Procedure ClearData; override;
|
||||
Function NameLookup(Const S : String) : boolean; override;
|
||||
Function AddressLookup(Const S : String) : Boolean; virtual;
|
||||
Function AddressLookup(Const Address : TNetAddr) : Boolean; virtual;
|
||||
Property NetAddress : TNetAddr Read FNetAddress;
|
||||
Property NetNetAddress : TNetAddr Read GetNetAddress;
|
||||
Property AddressAsString : String Read GetAsString;
|
||||
Property AddressType : Integer Read FAddrType;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TServiceResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
TServiceResolver = Class(TResolver)
|
||||
private
|
||||
FProtocol : String;
|
||||
FPort : Integer;
|
||||
Procedure SaveServiceEntry(Entry : Pointer);
|
||||
Function GetNetPort : Integer ;
|
||||
public
|
||||
Procedure ClearData; override;
|
||||
Function NameLookup (Const S : String) : boolean; override;
|
||||
Function NameLookup (Const S,Proto : String) : Boolean;
|
||||
Function PortLookup (APort : Longint; Proto: string) : Boolean;
|
||||
Property Protocol : String Read FProtocol;
|
||||
Property Port : Integer Read FPort;
|
||||
Property NetPort : Integer Read GetNetPort;
|
||||
end;
|
||||
|
||||
Resourcestring
|
||||
SErrHostByName = 'Host by name';
|
||||
SErrHostByAddr = 'Host by address';
|
||||
SErrNetByName = 'Net by name';
|
||||
SErrServByName = 'Service by name';
|
||||
SErrServByPort = 'Service by port';
|
||||
|
||||
Implementation
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Include system dependent stuff.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
{$i resolve.inc}
|
||||
|
||||
function HostAddrToStr (Entry : THostAddr) : String;
|
||||
|
||||
Var Dummy : String[4];
|
||||
I : Longint;
|
||||
|
||||
begin
|
||||
HostAddrToStr:='';
|
||||
For I:=1 to 4 do
|
||||
begin
|
||||
Str(Entry[I],Dummy);
|
||||
HostAddrToStr:=HostAddrToStr+Dummy;
|
||||
If I<4 Then
|
||||
HostAddrToStr:=HostAddrToStr+'.';
|
||||
end;
|
||||
end;
|
||||
|
||||
function StrToHostAddr(IP : String) : THostAddr ;
|
||||
|
||||
Var
|
||||
Dummy : String;
|
||||
I : Longint;
|
||||
J : Integer;
|
||||
Temp : THostAddr;
|
||||
|
||||
begin
|
||||
Result:=NoAddress;
|
||||
For I:=1 to 4 do
|
||||
begin
|
||||
If I<4 Then
|
||||
begin
|
||||
J:=Pos('.',IP);
|
||||
If J=0 then
|
||||
exit;
|
||||
Dummy:=Copy(IP,1,J-1);
|
||||
Delete (IP,1,J);
|
||||
end
|
||||
else
|
||||
Dummy:=IP;
|
||||
Val (Dummy,Temp[I],J);
|
||||
If J<>0 then Exit;
|
||||
end;
|
||||
Result:=Temp;
|
||||
end;
|
||||
|
||||
function NetAddrToStr (Entry : TNetAddr) : String;
|
||||
|
||||
Var Dummy : String[4];
|
||||
I : Longint;
|
||||
|
||||
begin
|
||||
NetAddrToStr:='';
|
||||
For I:=4 downto 1 do
|
||||
begin
|
||||
Str(Entry[I],Dummy);
|
||||
NetAddrToStr:=NetAddrToStr+Dummy;
|
||||
If I>1 Then
|
||||
NetAddrToStr:=NetAddrToStr+'.';
|
||||
end;
|
||||
end;
|
||||
|
||||
function StrToNetAddr(IP : String) : TNetAddr;
|
||||
|
||||
begin
|
||||
StrToNetAddr:=TNetAddr(StrToHostAddr(IP));
|
||||
end;
|
||||
|
||||
Function HostToNet (Host : ThostAddr) : THostAddr;
|
||||
|
||||
begin
|
||||
Result[1]:=Host[4];
|
||||
Result[2]:=Host[3];
|
||||
Result[3]:=Host[2];
|
||||
Result[4]:=Host[1];
|
||||
end;
|
||||
|
||||
Function NetToHost (Net : TNetAddr) : TNetAddr;
|
||||
|
||||
begin
|
||||
Result[1]:=Net[4];
|
||||
Result[2]:=Net[3];
|
||||
Result[3]:=Net[2];
|
||||
Result[4]:=Net[1];
|
||||
end;
|
||||
|
||||
Function HostToNet (Host : Longint) : Longint;
|
||||
|
||||
begin
|
||||
Result:=Longint(HostToNet(THostAddr(host)));
|
||||
end;
|
||||
|
||||
Function NetToHost (Net : Longint) : Longint;
|
||||
|
||||
begin
|
||||
Result:=Longint(NetToHost(TNetAddr(Net)));
|
||||
end;
|
||||
|
||||
Function ShortHostToNet (Host : Word) : Word;
|
||||
|
||||
begin
|
||||
ShortHostToNet:=lo(host)*256+Hi(Host);
|
||||
end;
|
||||
|
||||
Function ShortNetToHost (Net : Word) : Word;
|
||||
|
||||
begin
|
||||
ShortNetToHost:=lo(Net)*256+Hi(Net);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Constructor TResolver.Create(AOwner : TComponent);
|
||||
|
||||
begin
|
||||
Inherited;
|
||||
FAliases:=TstringList.Create;
|
||||
end;
|
||||
|
||||
Destructor TResolver.Destroy;
|
||||
|
||||
begin
|
||||
ClearData;
|
||||
FAliases.Free;
|
||||
end;
|
||||
|
||||
Procedure TResolver.ClearData;
|
||||
|
||||
begin
|
||||
FName:='';
|
||||
FAliases.Clear;
|
||||
end;
|
||||
|
||||
Function TResolver.GetAlias(Index : Integer) : STring;
|
||||
|
||||
begin
|
||||
Result:=FAliases[Index];
|
||||
end;
|
||||
|
||||
Function TResolver.GetAliasCount : Integer;
|
||||
|
||||
begin
|
||||
Result:=FAliases.Count;
|
||||
end;
|
||||
|
||||
Function TResolver.GetAliasSorted : Boolean;
|
||||
|
||||
begin
|
||||
Result:=FAliases.Sorted;
|
||||
end;
|
||||
|
||||
Procedure TResolver.SetAliasSorted (Value : Boolean);
|
||||
|
||||
begin
|
||||
FAliases.Sorted:=Value;
|
||||
end;
|
||||
|
||||
Procedure TResolver.CheckOperation(Msg : String);
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
Function TResolver.NameLookup(Const S : String) : Boolean;
|
||||
|
||||
begin
|
||||
ClearData;
|
||||
FName:=S;
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
Procedure TResolver.SaveAliases(P : PPChar);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
If (P<>Nil) then
|
||||
begin
|
||||
I:=0;
|
||||
While P[I]<>Nil do
|
||||
begin
|
||||
FAliases.Add(StrPas(P[I]));
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
THostResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function THostResolver.GetAddress (Index : Integer) : THostAddr;
|
||||
|
||||
begin
|
||||
If (Index>=0) and (Index<FAddressCount) then
|
||||
Result:=FAddresses[Index];
|
||||
end;
|
||||
|
||||
Function THostResolver.GetAsString : String;
|
||||
|
||||
begin
|
||||
Result:=HostAddrToStr(FHostAddress);
|
||||
end;
|
||||
|
||||
Procedure THostResolver.ClearData;
|
||||
|
||||
begin
|
||||
Inherited;
|
||||
FHostAddress:=NoAddress;
|
||||
If FAddressCount<>0 Then
|
||||
FreeMem(FAddresses);
|
||||
FAddressCount:=0;
|
||||
FAddresses:=Nil;
|
||||
end;
|
||||
|
||||
Function THostResolver.AddressLookup(Const S : String) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=AddressLookup(StrToHostAddr(S));
|
||||
end;
|
||||
|
||||
Function THostResolver.NameLookup (Const S : String) : Boolean;
|
||||
|
||||
Var
|
||||
FHostEntry : PHostEntry;
|
||||
|
||||
begin
|
||||
Result:=Inherited NameLookup(S);
|
||||
If Result then
|
||||
begin
|
||||
FHostEntry:=GetHostByName(pchar(FName));
|
||||
Result:=FHostEntry<>Nil;
|
||||
If Result then
|
||||
SaveHostEntry(FHostEntry)
|
||||
else
|
||||
begin
|
||||
FLastError:=GetDNSError;
|
||||
CheckOperation(SErrHostByName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure THostResolver.SaveHostEntry(Entry : Pointer);
|
||||
|
||||
Var
|
||||
P : Pointer;
|
||||
I,Count : Integer;
|
||||
|
||||
begin
|
||||
With PHostEntry(Entry)^ do
|
||||
begin
|
||||
FName:=StrPas(H_Name);
|
||||
FAddressCount:=0;
|
||||
While H_Addr[FAddressCount]<>Nil do
|
||||
Inc(FAddressCount);
|
||||
If FAddressCount>0 then
|
||||
begin
|
||||
GetMem(FAddresses,FAddressCount*SizeOf(THostAddr));
|
||||
For I:=0 to FAddressCount-1 do
|
||||
FAddresses[I]:=PHostAddr(H_Addr[I])^;
|
||||
FHostAddress:=FAddresses[0];
|
||||
end;
|
||||
SaveAliases(H_Aliases);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function THostResolver.AddressLookup (Const Address: THostAddr) : Boolean;
|
||||
|
||||
Var
|
||||
FHostEntry : PHostEntry;
|
||||
|
||||
begin
|
||||
ClearData;
|
||||
FHostEntry:=GetHostByAddr(Pchar(@Address),SizeOf(Address),AF_INET);
|
||||
Result:=FHostEntry<>Nil;
|
||||
If Result then
|
||||
SaveHostEntry(FHostEntry)
|
||||
else
|
||||
begin
|
||||
FLastError:=GetDNSError;
|
||||
CheckOperation(SErrHostByAddr);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function THostResolver.GetNetAddress (Index : Integer) : THostAddr;
|
||||
|
||||
begin
|
||||
Result:=HostToNet(Addresses[Index]);
|
||||
end;
|
||||
|
||||
Function THostResolver.GetNetHostAddress : THostAddr;
|
||||
|
||||
begin
|
||||
Result:=HostToNet(FHostAddress);
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TNetResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Function TNetResolver.NameLookup (Const S : String) : Boolean;
|
||||
|
||||
Var
|
||||
FNetEntry : PNetEntry;
|
||||
|
||||
begin
|
||||
Result:=Inherited NameLookup(S);
|
||||
If Result then
|
||||
begin
|
||||
FNetEntry:=GetNetByName(pchar(S));
|
||||
Result:=FNetEntry<>Nil;
|
||||
If Result then
|
||||
SaveNetEntry(FNetEntry)
|
||||
else
|
||||
begin
|
||||
FLastError:=GetDNSError;
|
||||
Checkoperation(SErrNetByName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TNetResolver.SaveNetEntry(Entry : Pointer);
|
||||
|
||||
begin
|
||||
With PNetEntry(Entry)^ do
|
||||
begin
|
||||
FName:=StrPas(N_Name);
|
||||
FAddrType:=N_addrtype;
|
||||
FNetAddress:=NetToHost(TNetAddr(N_net));
|
||||
SaveAliases(N_Aliases);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TNetResolver.AddressLookup (Const Address: TNetAddr) : boolean;
|
||||
|
||||
Var
|
||||
FNetEntry : PNetEntry;
|
||||
|
||||
begin
|
||||
ClearData;
|
||||
{$ifndef win32}
|
||||
FNetEntry:=GetNetByAddr(Longint(HostToNet(Address)),AF_INET);
|
||||
{$else}
|
||||
FNetEntry:=Nil;
|
||||
{$endif}
|
||||
Result:=FNetEntry<>Nil;
|
||||
If Result then
|
||||
SaveNetEntry(FNetEntry)
|
||||
else
|
||||
begin
|
||||
FLastError:=GetDNSError;
|
||||
CheckOperation(SErrNetByName);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TNetResolver.AddressLookup(Const S : String) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=AddressLookup(StrToNetAddr(S));
|
||||
end;
|
||||
|
||||
|
||||
Function TNetResolver.GetAsString : String;
|
||||
|
||||
begin
|
||||
Result:=HostAddrToStr(FNetAddress);
|
||||
end;
|
||||
|
||||
Function TNetResolver.GetNetAddress : TNetAddr;
|
||||
|
||||
begin
|
||||
Result:=HostToNet(FNetAddress);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TNetResolver.ClearData;
|
||||
|
||||
begin
|
||||
Inherited;
|
||||
FNetAddress:=NoAddress;
|
||||
FAddrType:=0;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TServiceResolver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function TServiceResolver.NameLookup (Const S : String) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=NameLookup(S,'');
|
||||
end;
|
||||
|
||||
Function TServiceResolver.NameLookup (Const S,Proto : String) : Boolean;
|
||||
|
||||
Var
|
||||
FServiceEntry : PServEntry;
|
||||
|
||||
begin
|
||||
ClearData;
|
||||
FName:=S;
|
||||
FProtocol:=Proto;
|
||||
If (proto='') then
|
||||
FServiceEntry:=GetServByName(pchar(S),Nil)
|
||||
else
|
||||
FServiceEntry:=GetServByName(pchar(S),PChar(FProtocol));
|
||||
Result:=FServiceEntry<>Nil;
|
||||
If Result then
|
||||
SaveServiceEntry(FServiceEntry)
|
||||
else
|
||||
begin
|
||||
FLastError:=GetDNSError;
|
||||
CheckOperation(SErrServByName);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TServiceResolver.PortLookup (APort: Longint; Proto : String) : Boolean;
|
||||
|
||||
Var
|
||||
FServiceEntry : PServEntry;
|
||||
|
||||
begin
|
||||
ClearData;
|
||||
APort:=ShortHostToNet(APort);
|
||||
FProtoCol:=Proto;
|
||||
If (Proto='') then
|
||||
FServiceEntry:=GetServByPort(APort,Nil)
|
||||
else
|
||||
FServiceEntry:=GetServByPort(APort,pchar(Proto));
|
||||
Result:=FServiceEntry<>Nil;
|
||||
If Result then
|
||||
SaveServiceEntry(FServiceEntry)
|
||||
else
|
||||
begin
|
||||
FLastError:=GetDNSError;
|
||||
CheckOperation(SErrServByPort);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TServiceResolver.SaveServiceEntry(Entry : Pointer);
|
||||
|
||||
begin
|
||||
With PServEntry(Entry)^ do
|
||||
begin
|
||||
FName:=strpas(s_name);
|
||||
FPort:=ShortHostToNet(S_port);
|
||||
FProtocol:=strpas(s_proto);
|
||||
SaveAliases(S_aliases);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TServiceResolver.ClearData;
|
||||
|
||||
begin
|
||||
Inherited;
|
||||
FProtocol:='';
|
||||
FPort:=0;
|
||||
end;
|
||||
|
||||
Function TServiceResolver.GetNetPort : Integer;
|
||||
|
||||
begin
|
||||
Result:=ShortHostToNet(FPort);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2003-02-01 16:50:38 michael
|
||||
+ Added resolve unit for WIndows/unix
|
||||
|
||||
}
|
||||
78
fcl/unix/resolve.inc
Normal file
78
fcl/unix/resolve.inc
Normal file
@ -0,0 +1,78 @@
|
||||
{$ifdef win32}
|
||||
uses winsock;
|
||||
|
||||
Function GetDNSError : Longint;
|
||||
|
||||
begin
|
||||
GetDNSError:=0;
|
||||
end;
|
||||
{$else}
|
||||
const
|
||||
{ Net type }
|
||||
socklib = 'c';
|
||||
AF_INET = 2;
|
||||
|
||||
{ Error constants. Returned by LastError method of THost, TNet}
|
||||
|
||||
NETDB_INTERNAL= -1; { see errno }
|
||||
NETDB_SUCCESS = 0; { no problem }
|
||||
HOST_NOT_FOUND= 1; { Authoritative Answer Host not found }
|
||||
TRY_AGAIN = 2; { Non-Authoritive Host not found, or SERVERFAIL }
|
||||
NO_RECOVERY = 3; { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
|
||||
NO_DATA = 4; { Valid name, no data record of requested type }
|
||||
NO_ADDRESS = NO_DATA; { no address, look for MX record }
|
||||
|
||||
|
||||
Type
|
||||
|
||||
{ THostEnt Object }
|
||||
THostEnt = record
|
||||
H_Name : pchar; { Official name }
|
||||
H_Aliases : ppchar; { Null-terminated list of aliases}
|
||||
H_Addrtype : longint; { Host address type }
|
||||
H_length : longint; { Length of address }
|
||||
H_Addr : ppchar; { null-terminated list of adresses }
|
||||
end;
|
||||
PHostEntry = ^THostEnt;
|
||||
|
||||
{ TNetEnt object }
|
||||
TNetEnt = record
|
||||
N_Name : pchar; { Official name }
|
||||
N_Aliases : ppchar; { Nill-terminated alias list }
|
||||
N_AddrType : longint; { Net address type }
|
||||
N_net : Cardinal; { Network number }
|
||||
end;
|
||||
PNetEntry = ^TNetEnt;
|
||||
|
||||
TServEnt = record
|
||||
s_name : pchar; { Service name }
|
||||
s_aliases : ppchar; { Null-terminated alias list }
|
||||
s_port : longint; { Port number }
|
||||
s_proto : pchar; { Protocol to use }
|
||||
end;
|
||||
PServEntry = ^TServEnt;
|
||||
|
||||
{ C style calls, linked in from Libc }
|
||||
|
||||
function gethostent : PHostEntry; cdecl; external socklib;
|
||||
procedure sethostent (stayopen : longint); cdecl; external socklib;
|
||||
procedure endhostent; cdecl; external socklib;
|
||||
|
||||
function getnetent : PNetEntry; cdecl; external socklib;
|
||||
procedure setnetent ( Stayopen : Longint); cdecl; external socklib;
|
||||
procedure endnetent; cdecl; external socklib;
|
||||
|
||||
function getservent : PServEntry; cdecl; external socklib;
|
||||
procedure setservent (StayOpen : longint); cdecl; external socklib;
|
||||
procedure endservent; cdecl; external socklib;
|
||||
|
||||
function getnetbyaddr ( Net : Longint; nettype : Longint) : PNetEntry; cdecl; external socklib;
|
||||
function gethostbyname ( Name : Pchar) : PHostEntry; cdecl; external socklib;
|
||||
function gethostbyaddr ( Addr : PChar; Len : Longint; HType : Longint) : PHostentry ; cdecl; external socklib;
|
||||
function getnetbyname ( Name : pchar) : PNetEntry; cdecl; external socklib;
|
||||
function getservbyname (name : pchar ; protocol : pchar) : PServEntry; cdecl; external socklib;
|
||||
function getservbyport (port : longint; protocol : pchar) : PServEntry; cdecl; external socklib;
|
||||
|
||||
var
|
||||
GetDNSError : longint;external socklib name 'h_errno';
|
||||
{$endif}
|
||||
36
fcl/win32/resolve.inc
Normal file
36
fcl/win32/resolve.inc
Normal file
@ -0,0 +1,36 @@
|
||||
|
||||
uses winsock;
|
||||
|
||||
Type
|
||||
PHostEntry = PHostEnt;
|
||||
PNetEntry = PNetEnt;
|
||||
PServEntry = PServEnt;
|
||||
|
||||
Const
|
||||
DNSErr : Integer = 0;
|
||||
|
||||
function getnetbyname ( Name : pchar) : PNetEntry;
|
||||
|
||||
begin
|
||||
DNSErr:=-1;
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
function getnetbyaddr ( Net : Longint; nettype : Longint) : PNetEntry;
|
||||
|
||||
begin
|
||||
DNSErr:=-2;
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
Function GetDNSError : Longint;
|
||||
|
||||
begin
|
||||
If DNSErr<>0 then
|
||||
begin
|
||||
GetDNSError:=-DNSErr;
|
||||
DNSErr:=0;
|
||||
end
|
||||
else
|
||||
GetDNSError:=0; // Must get win32 error ?
|
||||
end;
|
||||
Loading…
Reference in New Issue
Block a user