www.pudn.com > indy10.0.52_source.rar > IdIPAddress.pas
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 52330: IdIPAddress.pas
{
{ Rev 1.9 28.09.2004 20:54:32 Andreas Hausladen
{ Removed unused functions that were moved to IdGlobal
}
{
Rev 1.8 6/11/2004 8:48:20 AM DSiders
Added "Do not Localize" comments.
}
{
Rev 1.7 5/19/2004 10:44:34 PM DSiders
Corrected spelling for TIdIPAddress.MakeAddressObject method.
}
{
{ Rev 1.6 14/04/2004 17:35:38 HHariri
{ Removed IP6 for BCB temporarily
}
{
{ Rev 1.5 2/11/2004 5:10:40 AM JPMugaas
{ Moved IPv6 address definition to System package.
}
{
{ Rev 1.4 2004.02.03 4:17:18 PM czhower
{ For unit name changes.
}
{
{ Rev 1.3 2/2/2004 12:22:24 PM JPMugaas
{ Now uses IdGlobal IPVersion Type. Added HToNBytes for things that need
{ to export into NetworkOrder for structures used in protocols.
}
{
{ Rev 1.2 1/3/2004 2:13:56 PM JPMugaas
{ Removed some empty function code that wasn't used.
{ Added some value comparison functions.
{ Added a function in the IPAddress object for comparing the value with another
{ IP address. Note that this comparison is useful as an IP address will take
{ several forms (especially common with IPv6).
{ Added a property for returning the IP address as a string which works for
{ both IPv4 and IPv6 addresses.
}
{
{ Rev 1.1 1/3/2004 1:03:14 PM JPMugaas
{ Removed Lo as it was not needed and is not safe in NET.
}
{
{ Rev 1.0 1/1/2004 4:00:18 PM JPMugaas
{ An object for handling both IPv4 and IPv6 addresses. This is a proposal with
{ some old code for conversions.
}
unit IdIPAddress;
interface
uses
Classes,
IdGlobal;
type
TIdIPAddress = class(TObject)
protected
FIPv4 : Cardinal;
FIPv6 : TIdIPv6Address;
FAddrType : TIdIPVersion;
class function IPv4MakeCardInRange(const AInt : Int64; const A256Power : Integer) : Cardinal;
//general conversion stuff
class function IPv6ToIdIPv6Address(const AIPAddress : String; var VErr : Boolean) : TIdIPv6Address;
class function IPv4ToCardinal(const AIPAddress : String; var VErr : Boolean) : Cardinal;
class function MakeCanonicalIPv6Address(const AAddr: string): string;
class function MakeCanonicalIPv4Address(const AAddr: string): string;
//property as String Get methods
function GetIPv4AsString : String;
function GetIPv6AsString : String;
function GetIPAddress : String;
public
function GetHToNBytes: TIdBytes;
public
constructor Create; virtual;
class function MakeAddressObject(const AIP : String) : TIdIPAddress;
function CompareAddress(const AIP : String; var Err : Boolean) : Integer;
property IPv4 : Cardinal read FIPv4 write FIPv4;
property IPv4AsString : String read GetIPv4AsString;
{$IFNDEF BCB}
property IPv6 : TIdIPv6Address read FIPv6 write FIPv6;
{$ENDIF}
property IPv6AsString : String read GetIPv6AsString;
property AddrType : TIdIPVersion read FAddrType write FAddrType;
property IPAsString : String read GetIPAddress;
property HToNBytes : TIdBytes read GetHToNBytes;
end;
implementation
uses SysUtils, IdStack;
//The power constants are for processing IP addresses
//They are powers of 255.
const POWER_1 = $000000FF;
POWER_2 = $0000FFFF;
POWER_3 = $00FFFFFF;
POWER_4 = $FFFFFFFF;
//IPv4 address conversion
//Much of this is based on http://www.pc-help.org/obscure.htm
function OctalToInt64(const AValue: string): Int64;
//swiped from:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=711
var
i: Integer;
begin
Result := 0;
for i := 1 to Length(AValue) do
begin
Result := Result * 8 + StrToInt(Copy(AValue, i, 1));
end;
end;
function CompareWord(const AWord1, AWord2 : Word) : Integer;
{
AWord1 > AWord2 > 0
AWord1 < AWord2 < 0
AWord1 = AWord2 = 0
}
begin
Result := 0;
if AWord1 > AWord2 then
begin
Result := 1;
end
else
begin
if AWord1 < AWord2 then
begin
Result := -1;
end;
end;
end;
function CompareCardinal(const ACard1, ACard2 : Cardinal) : Integer;
{
ACard1 > ACard2 > 0
ACard1 < ACard2 < 0
ACard1 = ACard2 = 0
}
begin
Result := 0;
if ACard1 > ACard2 then
begin
Result := 1;
end
else
begin
if ACard1 < ACard2 then
begin
Result := -1;
end;
end;
end;
{ TIdIPAddress }
function TIdIPAddress.CompareAddress(const AIP: String;
var Err: Boolean): Integer;
var LIP2 : TIdIPAddress;
i : Integer;
{
Note that the IP address in the object is S1.
S1 > S2 > 0
S1 < S2 < 0
S1 = S2 = 0
}
begin
Result := 0;
//LIP2 may be nil if the IP address is invalid
LIP2 := MakeAddressObject(AIP);
Err := not Assigned(LIP2);
if not Err then
begin
try
//we can't compare an IPv4 address with an IPv6 address
Err := FAddrType <> LIP2.FAddrType;
if not Err then
begin
if FAddrType = Id_IPv4 then
begin
Result := CompareCardinal(FIPv4,LIP2.FIPv4);
end
else
begin
for i := 0 to 7 do
begin
Result := CompareWord(FIPv6[i],LIP2.FIPv6[i]);
if Result <> 0 then
begin
Break;
end;
end;
end;
end;
finally
FreeAndNil(LIP2);
end;
end;
end;
constructor TIdIPAddress.Create;
begin
inherited Create;
FAddrType := Id_IPv4;
FIPv4 := 0; //'0.0.0.0'
end;
function TIdIPAddress.GetHToNBytes: TIdBytes;
var
i : Integer;
begin
SetLength(Result,0);
case Self.FAddrType of
Id_IPv4 :
begin
Result := ToBytes( GStack.HostToNetwork( FIPv4));
end;
Id_IPv6 :
begin
for i := 0 to 7 do begin
AppendBytes(Result, ToBytes(GStack.HostToNetwork(FIPv6[i]) ) );
end;
end;
end;
end;
function TIdIPAddress.GetIPAddress: String;
begin
if FAddrType = Id_IPv4 then
begin
Result := GetIPv4AsString;
end
else
begin
Result := GetIPv6AsString;
end;
end;
function TIdIPAddress.GetIPv4AsString: String;
begin
Result := '';
if FAddrType = Id_IPv4 then
begin
Result := IntToStr((FIPv4 shr 24) and $FF)+'.';
Result := Result + IntToStr((FIPv4 shr 16) and $FF)+'.';
Result := Result + IntToStr((FIPv4 shr 8) and $FF)+'.';
Result := Result + IntToStr(FIPv4 and $FF);
end;
end;
function TIdIPAddress.GetIPv6AsString: String;
var i:integer;
begin
Result := '';
if FAddrType = Id_IPv6 then
begin
Result := IntToHex(FIPv6[0], 4);
for i := 1 to 7 do begin
Result := Result + ':' + IntToHex(FIPv6[i], 4);
end;
end;
end;
class function TIdIPAddress.IPv4MakeCardInRange(const AInt: Int64;
const A256Power: Integer): Cardinal;
begin
case A256Power of
4 : Result := (AInt and POWER_4);
3 : Result := (AInt and POWER_3);
2 : Result := (AInt and POWER_2);
else
Result := (AInt and POWER_1);
end;
end;
class function TIdIPAddress.IPv4ToCardinal(const AIPAddress: String;
var VErr: Boolean): Cardinal;
var
LBuf, LBuf2 : String;
L256Power : Integer;
LParts : Integer; //how many parts should we process at a time
begin
// S.G. 11/8/2003: Added overflow checking disabling and change multiplys by SHLs.
// Locally disable overflow checking so we can safely use SHL and SHR
{$ifopt Q+} // detect previous setting
{$define _QPlusWasEnabled}
{$Q-}
{$endif}
VErr := True;
L256Power := 4;
LBuf2 := AIPAddress;
Result := 0;
repeat
LBuf := Fetch(LBuf2,'.');
if LBuf = '' then
begin
break;
end;
//We do things this way because we have to treat
//IP address parts differently than a whole number
//and sometimes, there can be missing periods.
if (LBuf2='') and (L256Power > 1) then
begin
LParts := L256Power;
Result := Result shl (L256Power SHL 3);
end
else
begin
LParts := 1;
result := result SHL 8;
end;
if (Copy(LBuf,1,2)=HEXPREFIX) then
begin
//this is a hexideciaml number
if IsHexidecimal(Copy(LBuf,3,MaxInt))=False then
begin
Exit;
end
else
begin
Result := Result + IPv4MakeCardInRange(StrToInt64Def(LBuf,0), LParts);
end;
end
else
begin
if IsNumeric(LBuf) then
begin
if (LBuf[1]='0') and IsOctal(LBuf) then
begin
//this is octal
Result := Result + IPv4MakeCardInRange(OctalToInt64(LBuf),LParts);
end
else
begin
//this must be a decimal
Result := Result + IPv4MakeCardInRange(StrToInt64Def(LBuf,0), LParts);
end;
end
else
begin
//There was an error meaning an invalid IP address
Exit;
end;
end;
Dec(L256Power);
until False;
VErr := False;
// Restore overflow checking
{$ifdef _QPlusWasEnabled} // detect previous setting
{$undef _QPlusWasEnabled}
{$Q-}
{$endif}
end;
class function TIdIPAddress.IPv6ToIdIPv6Address(const AIPAddress: String;
var VErr: Boolean): TIdIPv6Address;
var
LAddress:string;
i:integer;
begin
LAddress := MakeCanonicalIPv6Address(AIPAddress);
VErr := (LAddress='');
if not VErr then begin
for i := 0 to 7 do begin
Result[i]:=StrToInt('$'+fetch(LAddress,':'));
end;
end;
end;
class function TIdIPAddress.MakeAddressObject(
const AIP: String): TIdIPAddress;
var LErr : Boolean;
begin
Result := TIdIPAddress.Create;
Result.FIPv6 := Result.IPv6ToIdIPv6Address(AIP,LErr);
if LErr then
begin
Result.FIPv4 := Result.IPv4ToCardinal(AIP,LErr);
if LErr then
begin
//this is not a valid IPv4 address
FreeAndNil(Result);
end
else
begin
Result.FAddrType := Id_IPv4;
end;
end
else
begin
Result.FAddrType := Id_IPv6;
end;
end;
class function TIdIPAddress.MakeCanonicalIPv4Address(
const AAddr: string): string;
var LErr : Boolean;
LIP : Cardinal;
begin
LIP := IPv4ToDWord(AAddr,LErr);
if LErr then
begin
Result := '';
end
else
begin
Result := MakeDWordIntoIPv4Address(LIP);
end;
end;
class function TIdIPAddress.MakeCanonicalIPv6Address(
const AAddr: string): string;
// return an empty string if the address is invalid,
// for easy checking if its an address or not.
var
p, i: integer;
dots, colons: integer;
colonpos: array[1..8] of integer;
dotpos: array[1..3] of integer;
LAddr: string;
num: integer;
haddoublecolon: boolean;
fillzeros: integer;
begin
Result := ''; // error
LAddr := AAddr;
if Length(LAddr) = 0 then exit;
if LAddr[1] = ':' then begin
LAddr := '0'+LAddr;
end;
if LAddr[Length(LAddr)] = ':' then begin
LAddr := LAddr + '0';
end;
dots := 0;
colons := 0;
for p := 1 to Length(LAddr) do begin
case LAddr[p] of
'.' : begin
inc(dots);
if dots < 4 then begin
dotpos[dots] := p;
end else begin
exit; // error in address
end;
end;
':' : begin
inc(colons);
if colons < 8 then begin
colonpos[colons] := p;
end else begin
exit; // error in address
end;
end;
'a'..'f',
'A'..'F': if dots>0 then exit;
// allow only decimal stuff within dotted portion, ignore otherwise
'0'..'9': ; // do nothing
else exit; // error in address
end; // case
end; // for
if not (dots in [0,3]) then begin
exit; // you have to write 0 or 3 dots...
end;
if dots = 3 then begin
if not (colons in [2..6]) then begin
exit; // must not have 7 colons if we have dots
end;
if colonpos[colons] > dotpos[1] then begin
exit; // x:x:x.x:x:x is not valid
end;
end else begin
if not (colons in [2..7]) then begin
exit; // must at least have two colons
end;
end;
// now start :-)
num := StrToIntDef('$'+Copy(LAddr, 1, colonpos[1]-1), -1);
if (num<0) or (num>65535) then begin
exit; // huh? odd number...
end;
Result := IntToHex(num,1)+':';
haddoublecolon := false;
for p := 2 to colons do begin
if colonpos[p-1] = colonpos[p]-1 then begin
if haddoublecolon then begin
Result := '';
exit; // only a single double-dot allowed!
end;
haddoublecolon := true;
fillzeros := 8 - colons;
if dots>0 then dec(fillzeros,2);
for i := 1 to fillzeros do begin
Result := Result + '0:'; {do not localize}
end;
end else begin
num := StrToIntDef('$'+Copy(LAddr, colonpos[p-1]+1, colonpos[p]-colonpos[p-1]-1), -1);
if (num<0) or (num>65535) then begin
Result := '';
exit; // huh? odd number...
end;
Result := Result + IntToHex(num,1)+':';
end;
end; // end of colon separated part
if dots = 0 then begin
num := StrToIntDef('$'+Copy(LAddr, colonpos[colons]+1, MaxInt), -1);
if (num<0) or (num>65535) then begin
Result := '';
exit; // huh? odd number...
end;
Result := Result + IntToHex(num,1)+':';
end;
if dots > 0 then begin
num := StrToIntDef(Copy(LAddr, colonpos[colons]+1, dotpos[1]-colonpos[colons]-1),-1);
if (num < 0) or (num>255) then begin
Result := '';
exit;
end;
Result := Result + IntToHex(num, 2);
num := StrToIntDef(Copy(LAddr, dotpos[1]+1, dotpos[2]-dotpos[1]-1),-1);
if (num < 0) or (num>255) then begin
Result := '';
exit;
end;
Result := Result + IntToHex(num, 2)+':';
num := StrToIntDef(Copy(LAddr, dotpos[2]+1, dotpos[3]-dotpos[2]-1),-1);
if (num < 0) or (num>255) then begin
Result := '';
exit;
end;
Result := Result + IntToHex(num, 2);
num := StrToIntDef(Copy(LAddr, dotpos[3]+1, 3), -1);
if (num < 0) or (num>255) then begin
Result := '';
exit;
end;
Result := Result + IntToHex(num, 2)+':';
end;
SetLength(Result, Length(Result)-1);
end;
end.