idnetworkcalculator.pas

Indy控件的使用源代码

var
  LBuffer: Cardinal;
begin
  FNetworkMaskLength := Value;
  if Value > 0 then begin
    LBuffer := High(Cardinal) shl (32 - Value);
  end else begin
    LBuffer := 0;
  end;
  FNetworkMask.AsDoubleWord := LBuffer;
end;

procedure TIdNetworkCalculator.SetOnGenIPList(const Value: TNotifyEvent);
begin
  FOnGenIPList := Value;
end;

procedure TIdNetworkCalculator.SetOnChange(const Value: TNotifyEvent);
begin
  FOnChange := Value;
end;

function TIdNetworkCalculator.GetNetworkClassAsString: String;
begin
  Case FNetworkClass of
    ID_NET_CLASS_A:
      result := 'A';    {Do not Localize}
    ID_NET_CLASS_B:
      result := 'B';    {Do not Localize}
    ID_NET_CLASS_C:
      result := 'C';    {Do not Localize}
    ID_NET_CLASS_D:
      result := 'D';    {Do not Localize}
    ID_NET_CLASS_E:
      result := 'E';    {Do not Localize}
  end; // case
end;

function TIdNetworkCalculator.GetIsAddressRoutable: Boolean;
begin
  // RFC
  result := (NetworkAddress.Byte1 = 10) or
            ((NetworkAddress.Byte1 = 172) and (NetworkAddress.Byte2 in [16..31])) or
            ((NetworkAddress.Byte1 = 192) and (NetworkAddress.Byte2 = 168));
end;

{ TIpProperty }

procedure TIpProperty.Assign(Source: Tpersistent);
begin
  if Source is TIpProperty then
  with source as TIpProperty do
  begin
    Self.SetAll(Byte1, Byte2, Byte3, Byte4);
  end;    { with }
  if assigned( FOnChange ) then
    FOnChange( Self );
  inherited;
end;

function TIpProperty.GetByteArray(Index: cardinal): boolean;
begin
  result := FByteArray[index]
end;

procedure TIpProperty.SetAll(One, Two, Three, Four: Byte);
var
  i: Integer;
  InitialIP, IpStruct: TIpStruct;
begin
  // Set the individual bytes
  InitialIP := IP(FByte1, FByte2, FByte3, FByte4);
  FByte1 := One;
  FByte2 := Two;
  FByte3 := Three;
  FByte4 := Four;
  // Set the DWord Value
  IpStruct.Byte1 := Byte1;
  IpStruct.Byte2 := Byte2;
  IpStruct.Byte3 := Byte3;
  IpStruct.Byte4 := Byte4;
  FDoubleWordValue := IpStruct.FullAddr;
  // Set the bits array and the binary string
  SetLength(FAsBinaryString, 32);
  // Second, fill the array
  for i := 1 to 32 do
  begin
    FByteArray[i - 1] := ((FDoubleWordValue shl (i-1)) shr 31) = 1;
    if FByteArray[i - 1] then
      FAsBinaryString[i] := '1'    {Do not Localize}
    else
      FAsBinaryString[i] := '0';    {Do not Localize}
  end;
  // Set the string
  FAsString := Format('%d.%d.%d.%d', [FByte1, FByte2, FByte3, FByte4]);    {Do not Localize}
  IpStruct := IP(FByte1, FByte2, FByte3, FByte4);
  if IpStruct.FullAddr <> InitialIP.FullAddr then
  begin
    if assigned( FOnChange ) then
      FOnChange( self );
  end;
end;

procedure TIpProperty.SetAsBinaryString(const Value: String);
var
  IPStruct: TIPStruct;
  i: Integer;
begin
  if ReadOnly then
    exit;
  if Length(Value) <> 32 then
    raise EIdException.Create(RSNETCALCInvalidValueLength) // 'Invalid value length: Should be 32.'    {Do not Localize}
  else
  begin
    if not AnsiSameText( Value, FAsBinaryString) then
    begin
      IPStruct.FullAddr := 0;
      for i := 1 to 32 do
      begin
        if Value[i] <> '0' then    {Do not Localize}
          IPStruct.FullAddr := IPStruct.FullAddr + (1 shl (32 - i));
        SetAll(IPStruct.Byte1, IPStruct.Byte2, IPStruct.Byte3, IPStruct.Byte4);
     end;
    end;
  end;
end;

procedure TIpProperty.SetAsDoubleWord(const Value: Cardinal);
var
  IpStruct: TIpStruct;
begin
  if ReadOnly then
    exit;
  IpStruct.FullAddr := value;
  SetAll(IpStruct.Byte1, IpStruct.Byte2, IpStruct.Byte3, IpStruct.Byte4);
end;

procedure TIpProperty.SetAsString(const Value: String);
var
  IPStruct: TIPStruct;
begin
  if ReadOnly then
    exit;
  IPStruct := StrToIP(value);
  SetAll(IPStruct.Byte1, IPStruct.Byte2, IPStruct.Byte3, IPStruct.Byte4);
end;

procedure TIpProperty.SetByteArray(Index: cardinal; const Value: boolean);
var
  IPStruct: TIpStruct;
begin
  if ReadOnly then
    exit;
  if FByteArray[Index] <> value then
  begin
    FByteArray[Index] := Value;
    IPStruct.FullAddr := FDoubleWordValue;

    if Value then
      IPStruct.FullAddr := IPStruct.FullAddr + (1 shl index)
    else
      IPStruct.FullAddr := IPStruct.FullAddr - (1 shl index);
    SetAll(IPStruct.Byte1, IPStruct.Byte2, IPStruct.Byte3, IPStruct.Byte4);
  end;
end;

procedure TIpProperty.SetByte4(const Value: Byte);
begin
  if ReadOnly then
    exit;
  if FByte4 <> value then
  begin
    FByte4 := Value;
    SetAll(FByte1, FByte2, FByte3, FByte4);
  end;
end;

procedure TIpProperty.SetByte1(const Value: byte);
begin
  if FByte1 <> value then
  begin
    FByte1 := Value;
    SetAll(FByte1, FByte2, FByte3, FByte4);
  end;
end;

procedure TIpProperty.SetByte3(const Value: Byte);
begin
  if FByte3 <> value then
  begin
    FByte3 := Value;
    SetAll(FByte1, FByte2, FByte3, FByte4);
  end;
end;

procedure TIpProperty.SetByte2(const Value: Byte);
begin
  if ReadOnly then
    exit;
  if FByte2 <> value then
  begin
    FByte2 := Value;
    SetAll(FByte1, FByte2, FByte3, FByte4);
  end;
end;

procedure TIpProperty.SetOnChange(const Value: TNotifyEvent);
begin
  FOnChange := Value;
end;

procedure TIpProperty.SetReadOnly(const Value: boolean);
begin
  FReadOnly := Value;
end;

function TIdNetworkCalculator.EndIP: String;
var
  IP: TIpStruct;
begin
  IP.FullAddr := NetworkAddress.AsDoubleWord AND NetworkMask.AsDoubleWord;
  Inc(IP.FullAddr, NumIP - 1);
  result := Format('%d.%d.%d.%d', [IP.Byte1, IP.Byte2, IP.Byte3, IP.Byte4]);    {Do not Localize}
end;

function TIdNetworkCalculator.NumIP: integer;
begin
  NumIP := 1 shl (32 - NetworkMaskLength);
end;

function TIdNetworkCalculator.StartIP: String;
var
  IP: TIpStruct;
begin
  IP.FullAddr := NetworkAddress.AsDoubleWord AND NetworkMask.AsDoubleWord;
  result := Format('%d.%d.%d.%d', [IP.Byte1, IP.Byte2, IP.Byte3, IP.Byte4]);    {Do not Localize}
end;

function TIpProperty.GetAddressType: TIdIPAddressType;
// based on http://www.ora.com/reference/dictionary/terms/I/IP_Address.htm
begin
  Result := IPInternetHost;

  case FByte1 of
       {localhost or local network}
    0 : if AsDoubleWord = 0 then
        begin
          Result := IPLocalHost;
        end
        else
        begin
          Result := IPLocalNetwork;
        end;
    {Private network allocations}
    10 : Result := IPPrivateNetwork;
    172 : if Byte2 = 16 then
          begin
            Result := IPPrivateNetwork;
          end;
    192 : if Byte2 = 68 then
          begin
            Result := IPPrivateNetwork;
          end
          else
          begin
            if (Byte2 = 0) and (Byte3 = 0) then
            begin
              Result := IPReserved;
            end;
          end;
    {loopback}
    127 : Result := IPLoopback;
    255 : if AsDoubleWord = $FFFFFFFF then
          begin
            Result := IPGlobalBroadcast;
          end
          else
          begin
            Result := IPFutureUse;
          end;
    {Reserved}
    128 : if Byte2 = 0 then
          begin
            Result := IPReserved;
          end;
    191 : if (Byte2 = 255) and (Byte3 = 255) then
          begin
             Result := IPReserved;
          end;
    223 : if (Byte2 = 255) and (Byte3 = 255) then
          begin
            Result := IPReserved;
          end;
  end;
  {Multicast}
  if (Byte1 >= 224) and (Byte1 <= 239) then
  begin
    Result := IPMulticast;
  end;
  {Future Use}
  if (Byte1 >= 240) and (Byte1 <= 254) then
  begin
    Result := IPFutureUse;
  end;
end;

end.