source: trunk/Packages/CoolWeb/Common/IpAddress.pas

unit IpAddress;

interface

uses
  Classes, SysUtils, Generics;

type
  { TDomainAddress }

  TDomainAddress = class(TPersistent)
  private
    function GetAsString: string;
    procedure SetAsString(const Value: string);
  public
    Levels: TListString;
    constructor Create;
    destructor Destroy; override;
    property AsString: string read GetAsString write SetAsString;
  end;

  TAddrClass = (acA, acB, acC, acD, acE);

  { TIpAddress }

  TIpAddress = class(TPersistent)
  private
    function GetAddrClass: TAddrClass;
    function GetAsCardinal: Cardinal;
    function GetAsString: string;
    function GetBroadcast: Boolean;
    procedure SetBroadcast(const Value: Boolean);
    procedure SetAsCardinal(const Value: Cardinal);
    procedure SetAsString(const Value: string);
  public
    Octets: array[0..3] of Byte;
    procedure Assign(Source: TPersistent); override;
    function IsAddressString(Value: string): Boolean;
    property AsCardinal: Cardinal read GetAsCardinal write SetAsCardinal;
    property AsString: string read GetAsString write SetAsString;
    property AddrClass: TAddrClass read GetAddrClass;
    property Broadcast: Boolean read GetBroadcast write SetBroadcast;
  end;

  THostAddressState = (asDomainName, asIpAddress);
  THostAddress = class(TPersistent)
  private
    function GetAsString: string;
    procedure SetAsString(const Value: string);
  public
    State: THostAddressState;
    DomainName: TDomainAddress;
    IpAddress: TIpAddress;
    constructor Create;
    destructor Destroy; override;
    property AsString: string read GetAsString write SetAsString;
  end;


implementation

resourcestring
  SStringToIPConversionError = 'String to IP address conversion error';

{ TIpAddress }

procedure TIpAddress.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Assigned(Source) then begin
    if Source is TIpAddress then begin
      for I := 0 to High(Octets) do
        Octets[I] := TIpAddress(Source).Octets[I];
    end else inherited;
  end else inherited;
end;

function TIpAddress.IsAddressString(Value: string): Boolean;
var
  Parts: TListString;
begin
  Result := True;
  try
    Parts := TListString.Create;
    Parts.Explode('.', Value);
    if Parts.Count = 4 then begin
      if (StrToInt(Parts[3]) < 0) or (StrToInt(Parts[3]) > 255) then Result := False;
      if (StrToInt(Parts[2]) < 0) or (StrToInt(Parts[2]) > 255) then Result := False;
      if (StrToInt(Parts[1]) < 0) or (StrToInt(Parts[1]) > 255) then Result := False;
      if (StrToInt(Parts[0]) < 0) or (StrToInt(Parts[0]) > 255) then Result := False;
    end else Result := False;
  finally
    Parts.Free;
  end;
end;

function TIpAddress.GetAddrClass: TAddrClass;
begin
  if (Octets[3] and $80) = 0 then Result := acA
  else begin
    if (Octets[3] and $40) = 0 then Result := acB
    else begin
      if (Octets[3] and $20) = 0 then Result := acC
      else begin
        if (Octets[3] and $10) = 0 then Result := acD
        else Result := acE;
      end;
    end;
  end;
end;

function TIpAddress.GetAsCardinal: Cardinal;
begin
  Result := Octets[0] or (Octets[1] shl 8) or (Octets[2] shl 16) or (Octets[3] shl 24);
end;

function TIpAddress.GetAsString: string;
begin
  Result := IntToStr(Octets[3]) + '.' + IntToStr(Octets[2]) + '.' +
    IntToStr(Octets[1]) + '.' + IntToStr(Octets[0]);
end;

function TIpAddress.GetBroadcast: Boolean;
begin
  Result := AsCardinal = High(Cardinal);
end;

procedure TIpAddress.SetAsCardinal(const Value: Cardinal);
begin
  Octets[0] := Byte(Value);
  Octets[1] := Byte(Value shr 8);
  Octets[2] := Byte(Value shr 16);
  Octets[3] := Byte(Value shr 24);
end;

procedure TIpAddress.SetAsString(const Value: string);
var
  Parts: TListString;
begin
  try
    Parts := TListString.Create;
    Parts.Explode('.', Value);
    try
//    if Length(Parts) = 4 then begin
      Octets[0] := StrToInt(Parts[3]);
      Octets[1] := StrToInt(Parts[2]);
      Octets[2] := StrToInt(Parts[1]);
      Octets[3] := StrToInt(Parts[0]);
//    end else raise EConvertError.Create('String to IP address conversion error');
    except
      raise EConvertError.Create(SStringToIPConversionError);
    end;
  finally
    Parts.Free;
  end;
end;

procedure TIpAddress.SetBroadcast(const Value: Boolean);
begin
  AsCardinal := High(Cardinal);
end;

{ TDomainAddress }

function TDomainAddress.GetAsString: string;
begin
  try
    Levels.Reverse;
    Result := Levels.Implode('.');
  finally
    Levels.Reverse;
  end;
end;

procedure TDomainAddress.SetAsString(const Value: string);
begin
  Levels.Explode('.', Value);
  Levels.Reverse;
end;

constructor TDomainAddress.Create;
begin
  Levels := TListString.Create;
end;

destructor TDomainAddress.Destroy;
begin
  FreeAndNil(Levels);
  inherited;
end;

{ THostAddress }

constructor THostAddress.Create;
begin
  DomainName := TDomainAddress.Create;
  IpAddress := TIpAddress.Create;
  State := asDomainName;
  DomainName.AsString := 'localhost';
end;

destructor THostAddress.Destroy;
begin
  FreeAndNil(DomainName);
  FreeAndNil(IpAddress);
  inherited;
end;

function THostAddress.GetAsString: string;
begin
  case State of
    asDomainName: Result := DomainName.AsString;
    asIpAddress: Result := IpAddress.AsString;
  end;
end;

procedure THostAddress.SetAsString(const Value: string);
begin
  if IpAddress.IsAddressString(Value) then begin
    State := asIpAddress;
    IpAddress.AsString := Value;
  end else begin
    State := asDomainName;
    DomainName.AsString := Value;
  end;
end;

end.