idstack.pas

网络控件适用于Delphi6

    // Properties
    //
    property HostName: string read FHostname;
    property LocalAddress: string read GetLocalAddress;
    property LocalAddresses: TIdStrings read GetLocalAddresses;
  end;

  TIdStackClass = class of TIdStack;

var
  GStack: TIdStack = nil;
  GSocketListClass: TIdSocketListClass;

// Procedures
  function IdStackFactory : TIdStack;
  procedure SetStackClass( AStackClass: TIdStackClass );

implementation

uses
  {$IFDEF LINUX}     IdStackLinux, {$ENDIF}
  {$IFDEF MSWINDOWS} IdStackWindows, {$ENDIF}
  {$IFDEF DOTNET}    IdStackDotNet, {$ENDIF}
  IdResourceStrings,
  SysUtils;

var
  GStackClass: TIdStackClass = nil;

procedure SetStackClass( AStackClass: TIdStackClass );
begin
  GStackClass := AStackClass;
end;

function IdStackFactory: TIdStack;
begin
  Result := GStackClass.Create;
  // GStackClass used to be public, but this factory has
  // replaced it so that the following line (which once
  // live in AfterConstruction, but this doesn't exist
  // in DotNet) will be run
  Result.FHostName := Result.ReadHostName;
end;

{ TIdSocketList }

constructor TIdSocketList.Create;
begin
  inherited Create;
  FLock := TIdCriticalSection.Create;
end;

class function TIdSocketList.CreateSocketList: TIdSocketList;
Begin
  Result := GSocketListClass.Create;
End;

destructor TIdSocketList.Destroy;
begin
  FreeAndNil(FLock);
  inherited;
end;

procedure TIdSocketList.Lock;
begin
  FLock.Acquire;
end;

class function TIdSocketList.Select(AReadList, AWriteList,
  AExceptList: TIdSocketList; const ATimeout: Integer): Boolean;
begin
  // C++ Builder cannot have abstract class functions thus we need this base
  Result := False;
end;

procedure TIdSocketList.Unlock;
begin
  FLock.Release;
end;

{ TIdStack }

constructor TIdStack.Create;
begin
  // Here for .net
  inherited;
end;

function TIdStack.IsIP(AIP: string): Boolean;
var
  i: Integer;
begin
//
//Result := Result and ((i > 0) and (i < 256));
//
  i := StrToIntDef(Fetch(AIP, '.'), -1);    {Do not Localize}
  Result := (i > -1) and (i < 256);
  i := StrToIntDef(Fetch(AIP, '.'), -1);    {Do not Localize}
  Result := Result and ((i > -1) and (i < 256));
  i := StrToIntDef(Fetch(AIP, '.'), -1);    {Do not Localize}
  Result := Result and ((i > -1) and (i < 256));
  i := StrToIntDef(Fetch(AIP, '.'), -1);    {Do not Localize}
  Result := Result and ((i > -1) and (i < 256)) and (AIP = '');
end;

function TIdStack.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;

class procedure TIdStack.Make;
begin
  EIdException.IfTrue(GStackClass = nil, RSStackClassUndefined);
  EIdException.IfTrue(GStack <> nil, RSStackAlreadyCreated);
  GStack := IdStackFactory;
end;

function TIdStack.ResolveHost(const AHost: string;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
begin
  if AIPVersion = Id_IPv4 then begin
    // Sometimes 95 forgets who localhost is
  if TextIsSame(AHost, 'LOCALHOST') then begin    {Do not Localize}
      Result := '127.0.0.1';    {Do not Localize}
    end else if IsIP(AHost) then begin
      Result := AHost;
    end else begin
      Result := HostByName(AHost, Id_IPv4);
    end;
  end else if AIPVersion = Id_IPv6 then begin
    result := MakeCanonicalIPv6Address(AHost);
    if result='' then begin
      Result := HostByName(AHost, Id_IPv6);
    end;
  end //else IPVersionUnsupported; // IPVersionUnsupported is introduced in
                                   // a decendant class, so we can't use it here,
                                   // TODO: move it to this class
end;

constructor EIdSocketError.CreateError(const AErr: Integer; const AMsg: string);
begin
  inherited Create(AMsg);
  FLastError := AErr;
end;

initialization
  GStackClass :=
   {$IFDEF LINUX}     TIdStackLinux;   {$ENDIF}
   {$IFDEF MSWINDOWS} TIdStackWindows; {$ENDIF}
   {$IFDEF DOTNET}    TIdStackDotNet;  {$ENDIF}
end.