idstack.pas

Indy控件的使用源代码

function TIdStack.WSTranslateSocketErrorMsg(const AErr: integer): string;
begin
  Result := '';    {Do not Localize}
  case AErr of
    Id_WSAEINTR: Result           := RSStackEINTR;
    Id_WSAEBADF: Result           := RSStackEBADF;
    Id_WSAEACCES: Result          := RSStackEACCES;
    Id_WSAEFAULT: Result          := RSStackEFAULT;
    Id_WSAEINVAL: Result          := RSStackEINVAL;
    Id_WSAEMFILE: Result          := RSStackEMFILE;

    Id_WSAEWOULDBLOCK: Result     := RSStackEWOULDBLOCK;
    Id_WSAEINPROGRESS: Result     := RSStackEINPROGRESS;
    Id_WSAEALREADY: Result        := RSStackEALREADY;
    Id_WSAENOTSOCK: Result        := RSStackENOTSOCK;
    Id_WSAEDESTADDRREQ: Result    := RSStackEDESTADDRREQ;
    Id_WSAEMSGSIZE: Result        := RSStackEMSGSIZE;
    Id_WSAEPROTOTYPE: Result      := RSStackEPROTOTYPE;
    Id_WSAENOPROTOOPT: Result     := RSStackENOPROTOOPT;
    Id_WSAEPROTONOSUPPORT: Result := RSStackEPROTONOSUPPORT;
    Id_WSAESOCKTNOSUPPORT: Result := RSStackESOCKTNOSUPPORT;
    Id_WSAEOPNOTSUPP: Result      := RSStackEOPNOTSUPP;
    Id_WSAEPFNOSUPPORT: Result    := RSStackEPFNOSUPPORT;
    Id_WSAEAFNOSUPPORT: Result    := RSStackEAFNOSUPPORT;
    Id_WSAEADDRINUSE: Result      := RSStackEADDRINUSE;
    Id_WSAEADDRNOTAVAIL: Result   := RSStackEADDRNOTAVAIL;
    Id_WSAENETDOWN: Result        := RSStackENETDOWN;
    Id_WSAENETUNREACH: Result     := RSStackENETUNREACH;
    Id_WSAENETRESET: Result       := RSStackENETRESET;
    Id_WSAECONNABORTED: Result    := RSStackECONNABORTED;
    Id_WSAECONNRESET: Result      := RSStackECONNRESET;
    Id_WSAENOBUFS: Result         := RSStackENOBUFS;
    Id_WSAEISCONN: Result         := RSStackEISCONN;
    Id_WSAENOTCONN: Result        := RSStackENOTCONN;
    Id_WSAESHUTDOWN: Result       := RSStackESHUTDOWN;
    Id_WSAETOOMANYREFS: Result    := RSStackETOOMANYREFS;
    Id_WSAETIMEDOUT: Result       := RSStackETIMEDOUT;
    Id_WSAECONNREFUSED: Result    := RSStackECONNREFUSED;
    Id_WSAELOOP: Result           := RSStackELOOP;
    Id_WSAENAMETOOLONG: Result    := RSStackENAMETOOLONG;
    Id_WSAEHOSTDOWN: Result       := RSStackEHOSTDOWN;
    Id_WSAEHOSTUNREACH: Result    := RSStackEHOSTUNREACH;
    Id_WSAENOTEMPTY: Result       := RSStackENOTEMPTY;
  end;
  Result := Format(RSStackError, [AErr, Result]);
end;

function TIdStack.GetIPInfo(const AIP: string; VB1: PByte = nil;
  VB2: PByte = nil; VB3: PByte = nil; VB4: PByte = nil; VType: PIdIPType = nil;
  VClass: PIdIPClass = nil): Boolean;
var
  sTemp, s1, s2, s3, s4: string;
  b1, b2, b3, b4: Byte;
  LType: TIdIPType;
  LClass: TIdIPClass;
  i: Integer;
  w: Word;
  c: Cardinal;

  function ByteIsOk(const AByte: string; var VB: Byte): boolean;
  var
    i: Integer;
  begin
    i := StrToIntDef(AByte, -1);
    Result := (i > -1) and (i < 256);
    if Result then VB := Byte(i);
  end;

  function WordIsOk(const AWord: string; var VW: Word): boolean;
  var
    i: Integer;
  begin
    i := StrToIntDef(AWord, -1);
    Result := (i > -1) and (i < 65536);
    if Result then VW := Word(i);
  end;

  function TwentyFourBitValueIsOk(const AValue: string; var VI: Integer): boolean;
  var
    i: Integer;
  begin
    i := StrToIntDef(AValue, -1);
    Result := (i > -1) and (i < 16777216);
    if Result then VI := i;
  end;

  function LongIsOk(const ALong: string; var VC: Cardinal): boolean;
  var
    i: Int64;
  begin
    i := StrToInt64Def(ALong, -1);
    Result := (i > -1) and (i < 4294967296);
    if Result then VC := Cardinal(i);
  end;

begin
  Result := False;
  LType := Id_IPInvalid;
  LClass := Id_IPClassUnkn;

  sTemp := AIP;
  s1 := Fetch(sTemp, '.');    {Do not Localize}
  s2 := Fetch(sTemp, '.');    {Do not Localize}
  s3 := Fetch(sTemp, '.');    {Do not Localize}
  s4 := sTemp;

  if s2 = '' then
  begin
    // RL: 4/13/2003: this probably needs to be tweaked better
    if LongIsOk(s1, c) then
    begin
      b1 := (c and $FF000000) shr 24;
      b2 := (c and $00FF0000) shr 16;
      b3 := (c and $0000FF00) shr 8;
      b4 := (c and $000000FF);
      LType := Id_IPNumeric;
    end;
  end
  else if s3 = '' then
  begin
    // class A address
    if ByteIsOk(s1, b1) and TwentyFourBitValueIsOk(s2, i) then
    begin
      b2 := (i and $00FF0000) shr 16;
      b3 := (i and $0000FF00) shr 8;
      b4 := (i and $000000FF);
      LType := Id_IPDotted;
      LClass := Id_IPClassA;
    end
  end
  else if s4 = '' then
  begin
    // class B address
    if ByteIsOk(s1, b1) and ByteIsOk(s2, b2) and WordIsOk(s3, w) then
    begin
      b3 := (w and $FF00) shr 8;
      b4 := (w and $00FF);
      LType := Id_IPDotted;
      LClass := Id_IPClassB;
    end
  end
  else
  begin
    // class C-E address
    if ByteIsOk(s1, b1) and ByteIsOk(s2, b2) and
      ByteIsOk(s3, b3) and ByteIsOk(s4, b4) then
    begin
      LType := Id_IPDotted;
      Case b1 of
        0..127:   LClass := Id_IPClassA;
        128..191: LClass := Id_IPClassB;
        192..223: LClass := Id_IPClassC;
        224..239: LClass := Id_IPClassD;
      else
        LClass := Id_IPClassE;
      end
    end
  end;

  if LType <> Id_IPInvalid then
  begin
    if (VB1 <> nil) then begin
      VB1^ := b1;
    end;
    if (VB2 <> nil) then begin
      VB2^ := b2;
    end;
    if (VB3 <> nil) then begin
      VB3^ := b3;
    end;
    if (VB4 <> nil) then begin
      VB4^ := b4;
    end;
    Result := True;
  end;
  if (VType <> nil) then begin
    VType^ := LType;
  end;
  if (VClass <> nil) then begin
    VClass^ := LClass;
  end;
end;

function TIdStack.GetIPType(const AIP: string): TIdIPType;
begin
  GetIPInfo(AIP, nil, nil, nil, nil, @Result);
end;

function TIdStack.GetIPClass(const AIP: string): TIdIPClass;
begin
  GetIPInfo(AIP, nil, nil, nil, nil, nil, @Result);
end;

function TIdStack.IsIP(const AIP: string): boolean;
begin
  Result := not IPIsType(AIP, Id_IPInvalid);
end;

function TIdStack.IPIsType(const AIP: string; const AType: TIdIPType): boolean;
begin
  Result := GetIPType(AIP) = AType;
end;

function TIdStack.IPIsType(const AIP: string; const ATypes: array of TIdIPType): boolean;
var
  i: Integer;
  LType: TIdIPType;
begin
  Result := False;
  LType := GetIPType(AIP);
  for i := Low(ATypes) to High(ATypes) do begin
    if LType = ATypes[i] then begin
        Result := True;
        Break;
    end;
  end;
end;

function TIdStack.IPIsClass(const AIP: string; const AClass: TIdIPClass): boolean;
begin
  Result := GetIPClass(AIP) = AClass;
end;

function TIdStack.IPIsClass(const AIP: string; const AClasses: array of TIdIPClass): boolean;
var
  i: Integer;
  LClass: TIdIPClass;
begin
  Result := False;
  LClass := GetIPClass(AIP);
  for i := Low(AClasses) to High(AClasses) do begin
    if LClass = AClasses[i] then begin
        Result := True;
        Break;
    end;
  end;
end;

function TIdStack.IsDottedIP(const AIP: string): boolean;
begin
  Result := IPIsType(AIP, Id_IPDotted);
end;

function TIdStack.IsNumericIP(const AIP: string): boolean;
begin
  Result := IPIsType(AIP, Id_IPNumeric);
end;

destructor TIdStack.Destroy;
begin
  FLocalAddresses.Free;
  inherited;
end;

function TIdStack.StringToTInAddr(AIP: string): TIdInAddr;
begin
  TranslateStringToTInAddr(AIP, result);
end;


{ TIdSocketList }

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

end.