idstackbsdbase.pas

网络控件适用于Delphi6

     const AOverlapped: Boolean = False): TIdStackSocketHandle; virtual; abstract;
    function WSTranslateSocketErrorMsg(const AErr: integer): string; virtual;
    function WSGetLastError: Integer; virtual; abstract;
    procedure WSGetSockOpt(ASocket: TIdStackSocketHandle; Alevel, AOptname: Integer; AOptval: PChar; var AOptlen: Integer); virtual; abstract;
    procedure SetBlocking(ASocket: TIdStackSocketHandle;
     const ABlocking: Boolean); virtual; abstract;
    function WouldBlock(const AResult: Integer): Boolean; virtual; abstract;
    function CheckForSocketError(const AResult: Integer): Integer; overload;
    function CheckForSocketError(const AResult: Integer;
     const AIgnore: array of Integer): Integer; overload;
    function NewSocketHandle(const ASocketType:TIdSocketType;
      const AProtocol: TIdSocketProtocol;
      const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION;
      const AOverlapped: Boolean = False)
     : TIdStackSocketHandle; override;
  end;

  EIdStackError = class (EIdException);
  EIdInvalidServiceName = class(EIdException);
  EIdStackInitializationFailed = class (EIdStackError);
  EIdStackSetSizeExceeded = class (EIdStackError);
  EIdIPVersionUnsupported = class (EIdStackError);

var
  GServeFileProc: TIdServeFile = nil;
  GBSDStack: TIdStackBSDBase = nil;

const
  IdIPFamily : array[TIdIPVersion] of Integer = (Id_PF_INET4, Id_PF_INET6);

implementation

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

{ TIdStackBSDBase }

function TIdStackBSDBase.TranslateTInAddrToString(var AInAddr;
  const AIPVersion: TIdIPVersion): string;
var
  i: integer;
begin
  case AIPVersion of
    Id_IPv4: begin
      with TIdIn4Addr(AInAddr).S_un_b do begin
        result := IntToStr(s_b1) + '.' + IntToStr(s_b2) + '.' + IntToStr(s_b3) + '.'    {Do not Localize}
         + IntToStr(s_b4);
      end;
    end;
    Id_IPv6: begin
      Result := '';
      for i := 0 to 7 do begin
        Result := Result + IntToHex(NetworkToHost(TIdIn6Addr(AInAddr).s6_addr16[i]),1)+':';
      end;
      SetLength(Result,Length(Result)-1);
    end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

procedure TIdStackBSDBase.TranslateStringToTInAddr(AIP: string;
  var AInAddr; const AIPVersion: TIdIPVersion);
var
  i: integer;
begin
  case AIPVersion of
    Id_IPv4: begin
      with TIdIn4Addr(AInAddr).S_un_b do begin
        s_b1 := StrToInt(Fetch(AIP, '.'));    {Do not Localize}
        s_b2 := StrToInt(Fetch(AIP, '.'));    {Do not Localize}
        s_b3 := StrToInt(Fetch(AIP, '.'));    {Do not Localize}
        s_b4 := StrToInt(Fetch(AIP, '.'));    {Do not Localize}
      end;
    end;
    Id_IPv6: begin
      AIP := MakeCanonicalIPv6Address(AIP);
      with TIdIn6Addr(AInAddr) do begin
        for i := 0 to 7 do begin
          s6_addr16[i] := HostToNetwork(StrToInt('$'+Fetch(AIP, ':')));    {Do not Localize}
        end;
      end;
    end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

procedure TIdStackBSDBase.RaiseLastSocketError;
begin
  RaiseSocketError(WSGetLastError);
end;

function TIdStackBSDBase.CheckForSocketError(const AResult: Integer): Integer;
begin
  if AResult = Id_SOCKET_ERROR then begin
    RaiseLastSocketError;
  end;
  Result := AResult;
end;

function TIdStackBSDBase.CheckForSocketError(const AResult: Integer;
  const AIgnore: array of integer): Integer;
var
  i: Integer;
  LLastError: Integer;
begin
  Result := 0;
  if AResult = Id_SOCKET_ERROR then begin
    LLastError := WSGetLastError;
    for i := Low(AIgnore) to High(AIgnore) do begin
      if LLastError = AIgnore[i] then begin
        Result := LLastError;
        Exit;
      end;
    end;
    RaiseSocketError(LLastError);
  end;
end;

function TIdStackBSDBase.NewSocketHandle(const ASocketType:TIdSocketType;
  const AProtocol: TIdSocketProtocol;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION;
  const AOverlapped: Boolean = False): TIdStackSocketHandle;
begin
  Result := CheckForSocketError(WSSocket(IdIPFamily[AIPVersion], ASocketType, AProtocol
   , AOverlapped));
end;

procedure TIdStackBSDBase.RaiseSocketError(AErr: integer);
begin
  (*
    RRRRR    EEEEEE   AAAA   DDDDD         MM     MM  EEEEEE    !!  !!  !!
    RR  RR   EE      AA  AA  DD  DD        MMMM MMMM  EE        !!  !!  !!
    RRRRR    EEEE    AAAAAA  DD   DD       MM MMM MM  EEEE      !!  !!  !!
    RR  RR   EE      AA  AA  DD  DD        MM     MM  EE
    RR   RR  EEEEEE  AA  AA  DDDDD         MM     MM  EEEEEE    ..  ..  ..

    Please read the note in the next comment.
  *)
  if AErr = Id_WSAENOTSOCK then begin
    // You can add this to your exception ignore list for easier debugging.
    // However please note that sometimes it is a true error. Your program
    // will still run correctly, but the debugger will not stop on it if you
    // list it in the ignore list. But for most times its fine to put it in
    // the ignore list, it only affects your debugging.
    raise EIdNotASocket.CreateError(AErr, WSTranslateSocketErrorMsg(AErr));
  end;
  (*
    It is normal to receive a 10038 exception (10038, NOT others!) here when
    *shutting down* (NOT at other times!) servers (NOT clients!).

    If you receive a 10038 exception here please see the FAQ at:
    http://www.IndyProject.org/

    If you insist upon requesting help via our email boxes on the 10038 error
    that is already answered in the FAQ and you are simply too slothful to
    search for your answer and ask your question in the public forums you may be
    publicly flogged, tarred and feathered and your name may be added to every
    chain letter / EMail in existence today."

    Otherwise, if you DID read the FAQ and have further questions, please feel
    free to ask using one of the methods (Carefullly note that these methods do
    not list email) listed on the Tech Support link at:
    http://www.IndyProject.org/

    RRRRR    EEEEEE   AAAA   DDDDD         MM     MM  EEEEEE    !!  !!  !!
    RR  RR   EE      AA  AA  DD  DD        MMMM MMMM  EE        !!  !!  !!
    RRRRR    EEEE    AAAAAA  DD   DD       MM MMM MM  EEEE      !!  !!  !!
    RR  RR   EE      AA  AA  DD  DD        MM     MM  EE
    RR   RR  EEEEEE  AA  AA  DDDDD         MM     MM  EEEEEE    ..  ..  ..
  *)
  raise EIdSocketError.CreateError(AErr, WSTranslateSocketErrorMsg(AErr));
end;

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

procedure TIdStackBSDBase.IPVersionUnsupported;
begin
  raise EIdIPVersionUnsupported.Create(RSIPVersionUnsupported);
end;

constructor TIdStackBSDBase.Create;
begin
  inherited;
  GBSDStack := Self;
end;

destructor TIdStackBSDBase.Destroy;
begin
  FreeAndNil(FLocalAddresses);
  inherited;
end;

function TIdStackBSDBase.CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean;
var LTmpSocket:TIdStackSocketHandle;
begin
  //TODO: Take out IFDEFs if the Linux version gives correct result under Windows...
{$IFDEF LINUX}
  LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Integer(Id_SOCK_STREAM), Id_IPPROTO_IP );
{$ELSE}
  LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Id_SOCK_STREAM, Id_IPPROTO_IP );
{$ENDIF}
  result:=LTmpSocket<>Id_INVALID_SOCKET;
  if LTmpSocket<>Id_INVALID_SOCKET then begin
    WSCloseSocket(LTmpSocket);
  end;
end;

function TIdStackBSDBase.Receive(ASocket: TIdStackSocketHandle;
 var VBuffer: TIdBytes): Integer;
begin
  Result := CheckForSocketError(WSRecv(ASocket, VBuffer[0], Length(VBuffer) , 0));
end;

function TIdStackBSDBase.Send(
  ASocket: TIdStackSocketHandle;
  const ABuffer: TIdBytes;
  AOffset: Integer = 0;
  ASize: Integer = -1
  ): Integer;
begin
  if ASize = -1 then begin
    ASize := Length(ABuffer) - AOffset;
  end;
  Result := WSSend(ASocket, PChar(@ABuffer[AOffset])^, ASize, 0);
end;

function TIdStackBSDBase.ReceiveFrom(ASocket: TIdStackSocketHandle;
  var VBuffer: TIdBytes; var VIP: string; var VPort: Integer;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION
  ): Integer;
begin
   Result :=  CheckForSocketError(RecvFrom(ASocket,VBuffer[0],Length(VBuffer),0,VIP,VPort));
end;

function TIdStackBSDBase.SendTo(ASocket: TIdStackSocketHandle;
  const ABuffer: TIdBytes; const AOffset: Integer; const AIP: string;
  const APort: integer;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer;
begin
   // must use pointer(ABuffer)^, can't use ABuffer[0], because ABuffer may have a 0 length
   WSSendTo(ASocket,pointer(ABuffer)^,Length(ABuffer),0,AIP,APort);
   Result := Length(ABuffer);
end;

end.