wsockets.pas

Winsock para comunica&ccedil &atilde o tcp Ip

  if ProtoEnt = nil then
    Exit;

  ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
  if ServEnt = nil then
    SockAddrIn.sin_port:= htons(StrToInt(Port))
  else
    SockAddrIn.sin_port:= ServEnt^.s_port;

  SockAddrIn.sin_addr.s_addr:= INADDR_BROADCAST;
  Result:= true;
end;

function TCustomWSocket.SockAddrInToName(SockAddrIn: TSockAddrIn): string;
var
  HostEnt: PHostEnt;
begin
  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
  if HostEnt <> nil then
    Result:= HostEnt.h_name;
end;

function TCustomWSocket.SockAddrInToAddress(SockAddrIn: TSockAddrIn): string;
begin
  Result:= inet_ntoa(SockAddrIn.sin_addr);
end;

function TCustomWSocket.SockAddrInToPort(SockAddrIn: TSockAddrIn): string;
begin
  Result:= IntToStr(ntohs(SockAddrIn.sin_port));
end;

function TCustomWSocket.SocketToName(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
  HostEnt: PHostEnt;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        begin
          HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
          if HostEnt <> nil then
            Result:= HostEnt.h_name;
        end;
    end;
end;

function TCustomWSocket.SocketToAddress(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= inet_ntoa(SockAddrIn.sin_addr);
    end;
end;

function TCustomWSocket.SocketToPort(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= IntToStr(ntohs(SockAddrIn.sin_port));
    end;
end;

function TCustomWSocket.PeerToName(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
  HostEnt: PHostEnt;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        begin
          HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
          if HostEnt <> nil then
            Result:= HostEnt.h_name;
        end;
    end;
end;

function TCustomWSocket.PeerToAddress(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= inet_ntoa(SockAddrIn.sin_addr);
    end;
end;

function TCustomWSocket.PeerToPort(Socket: TSocket): string;
var
  SockAddrIn: TSockAddrIn;
  Len: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      Len:= SizeOf(SockAddrIn);
      if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
        Result:= IntToStr(ntohs(SockAddrIn.sin_port));
    end;
end;

procedure TCustomWSocket.SocketClose(var Socket: TSocket; Handle: HWND);
var
  RC: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
      if WSAASyncSelect(Socket, Handle, WM_ASYNCSELECT, 0) <> 0 then
        begin
          SocketError(WSAGetLastError);
          Exit;
        end;

      if shutdown(Socket, 1) <> 0 then
        if WSAGetLastError <> WSAENOTCONN then
          begin
            SocketError(WSAGetLastError);
            Exit;
          end;

      repeat
        RC:= recv(Socket, FReadBuffer, SizeOf(TReadBuffer), 0);
      until (RC = 0) or (RC = SOCKET_ERROR);

      if closesocket(Socket) <> 0 then
        SocketError(WSAGetLastError)
      else
        Socket:= INVALID_SOCKET;
    end;
end;

function TCustomWSocket.SocketQueueSize(Socket: TSocket): longint;
var
  Size: longint;
begin
  Result:= 0;
  if ioctlsocket(Socket, FIONREAD, Size) <> 0 then
    SocketError(WSAGetLastError)
  else
    Result:= Size;
end;

procedure TCustomWSocket.SocketWrite(Socket: TSocket; Flag: integer; Data: string);
var
  TotSent, ToSend, Sent, ErrorLoop: integer;
begin
  if Data <> '' then
    begin
      ErrorLoop:= 0;
      TotSent:= 0;
      ToSend:= Length(Data);
      repeat
        Sent:= send(Socket, Data[TotSent+1], (ToSend-TotSent), Flag);
        if Sent = SOCKET_ERROR then
          begin
            Inc(ErrorLoop);
            if WSAGetLastError <> WSAEWOULDBLOCK then
              begin
                SocketError(WSAGetLastError);
                Exit;
              end;
          end
        else
          Inc(TotSent, Sent);
      until (TotSent >= ToSend) or (ErrorLoop > MAX_LOOP);
    end;
end;

function TCustomWSocket.SocketRead(Socket: TSocket; Flag: integer): string;
var
  Received: longint;
begin
  Result:= '';
  Received:= recv(Socket, FReadBuffer, SizeOf(TReadBuffer), Flag);
  if Received = SOCKET_ERROR then
    begin
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end
  else
    begin
      SetLength(Result, Received);
      Move(FReadBuffer, Result[1], Received);
    end;
end;

function TCustomWSocket.SocketWriteBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
begin
  Result:= send(Socket, Buffer^, Size, Flag);
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;

function TCustomWSocket.SocketReadBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
begin
  Result:= recv(Socket, Buffer^, Size, Flag);
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;

procedure TCustomWSocket.SocketWriteTo(Socket: TSocket; Flag: integer; Data: string; var SockAddrIn: TSockAddrIn);
var
  TotSent, ToSend, Sent, ErrorLoop: integer;
begin
  if Data <> '' then
    begin
      ErrorLoop:= 0;
      TotSent:= 0;
      ToSend:= Length(Data);
      repeat
        Sent:= sendto(Socket, Data[TotSent+1], (ToSend-TotSent), Flag, SockAddrIn, SizeOf(SockAddrIn));
        if Sent = SOCKET_ERROR then
          begin
            Inc(ErrorLoop);
            if WSAGetLastError <> WSAEWOULDBLOCK then
              begin
                SocketError(WSAGetLastError);
                Exit;
              end;
          end
        else
          Inc(TotSent, Sent);
      until (TotSent >= ToSend) or (ErrorLoop > MAX_LOOP);
    end;
end;

function TCustomWSocket.SocketReadFrom(Socket: TSocket; Flag: integer; var SockAddrIn: TSockAddrIn): string;
var
  Len: integer;
  Received: longint;
begin
  Len:= SizeOf(SockAddrIn);
  Received:= recvfrom(Socket, FReadBuffer, SizeOf(TReadBuffer), Flag, SockAddrIn, Len);
  if Received = SOCKET_ERROR then
    begin
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end
  else
    begin
      SetLength(Result, Received);
      Move(FReadBuffer, Result[1], Received);
    end;
end;

function TCustomWSocket.SocketWriteBufferTo(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn): integer;
begin
  Result:= sendto(Socket, Buffer^, Size, Flag, SockAddrIn, SizeOf(SockAddrIn));
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;

function TCustomWSocket.SocketReadBufferFrom(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn): integer;
var
  Len: integer;
begin
  Len:= SizeOf(SockAddrIn);
  Result:= recvfrom(Socket, Buffer^, Size, Flag, SockAddrIn, Len);
  if Result = SOCKET_ERROR then
    begin
      Result:= 0;
      if WSAGetLastError <> WSAEWOULDBLOCK then
        SocketError(WSAGetLastError);
    end;
end;

procedure TCustomWSocket.SocketError(Error: integer);
begin
  FLastError:= Error;
  if Assigned(FOnError) then
    FOnError(Self, FLastError, LastErrorDesc);
end;

function TCustomWSocket.LastErrorDesc: string;
begin
  case FLastError of
    WSAEINTR           : Result:= 'Interrupted system call';
    WSAEBADF           : Result:= 'Bad file number';
    WSAEACCES          : Result:= 'Permission denied';
    WSAEFAULT          : Result:= 'Bad address';
    WSAEINVAL          : Result:= 'Invalid argument';
    WSAEMFILE          : Result:= 'Too many open files';
    WSAEWOULDBLOCK     : Result:= 'Operation would block';
    WSAEINPROGRESS     : Result:= 'Operation now in progress';
    WSAEALREADY        : Result:= 'Operation already in progress';
    WSAENOTSOCK        : Result:= 'Socket operation on nonsocket';
    WSAEDESTADDRREQ    : Result:= 'Destination address required';
    WSAEMSGSIZE        : Result:= 'Message too long';
    WSAEPROTOTYPE      : Result:= 'Protocol wrong type for socket';
    WSAENOPROTOOPT     : Result:= 'Protocol not available';
    WSAEPROTONOSUPPORT : Result:= 'Protocol not supported';
    WSAESOCKTNOSUPPORT : Result:= 'Socket not supported';
    WSAEOPNOTSUPP      : Result:= 'Operation not supported on socket';
    WSAEPFNOSUPPORT    : Result:= 'Protocol family not supported';
    WSAEAFNOSUPPORT    : Result:= 'Address family not supported';
    WSAEADDRINUSE      : Result:= 'Address already in use';
    WSAEADDRNOTAVAIL   : Result:= 'Can''t assign requested address';
    WSAENETDOWN        : Result:= 'Network is down';
    WSAENETUNREACH     : Result:= 'Network is unreachable';
    WSAENETRESET       : Result:= 'Network dropped connection on reset';
    WSAECONNABORTED    : Result:= 'Software caused connection abort';
    WSAECONNRESET      : Result:= 'Connection reset by peer';
    WSAENOBUFS         : Result:= 'No buffer space available';
    WSAEISCONN         : Result:= 'Socket is already connected';
    WSAENOTCONN        : Result:= 'Socket is not connected';
    WSAESHUTDOWN       : Result:= 'Can''t send after socket shutdown';
    WSAETOOMANYREFS    : Result:= 'Too many references:can''t splice';
    WSAETIMEDOUT       : Result:= 'Connection timed out';
    WSAECONNREFUSED    : Result:= 'Connection refused';
    WSAELOOP           : Result:= 'Too many levels of symbolic links';
    WSAENAMETOOLONG    : Result:= 'File name is too long';
    WSAEHOSTDOWN       : Result:= 'Host is down';
    WSAEHOSTUNREACH    : Result:= 'No route to host';
    WSAENOTEMPTY       : Result:= 'Directory is not empty';
    WSAEPROCLIM        : Result:= 'Too many processes';
    WSAEUSERS          : Result:= 'Too many users';
    WSAEDQUOT          : Result:= 'Disk quota exceeded';
    WSAESTALE          : Result:= 'Stale NFS file handle';
    WSAEREMOTE         : Result:= 'Too many levels of remote in path';
    WSASYSNOTREADY     : Result:= 'Network subsystem is unusable';
    WSAVERNOTSUPPORTED : Result:= 'Winsock DLL cannot support this application';
    WSANOTINITIALISED  : Result:= 'Winsock not initialized';
    WSAHOST_NOT_FOUND  : Result:= 'Host not found';
    WSATRY_AGAIN       : Result:= 'Non authoritative - host not found';
    WSANO_RECOVERY     : Result:= 'Non recoverable error';
    WSANO_DATA         : Result:= 'Valid name, no data record of requested type'
  else
    Result:= 'Not a Winsock error';
  end;
end;

function TCustomWSocket.GetLocalHostAddress: string;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    begin
      HostEnt:= gethostbyname(szHostName);
      if HostEnt = nil then
        Result:= ''
      else
        begin
          SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
          Result:= inet_ntoa(SockAddrIn.sin_addr);
        end;
    end
  else
    SocketError(WSAGetLastError);
end;

function TCustomWSocket.GetLocalHostName: string;
var
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    Result:= szHostName
  else
    SocketError(WSAGetLastError);
end;

(**** TTCPClient Class ****)

constructor TTCPClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle:= AllocateHWnd(WndProc);
  FProtocol:= IPPROTO_TCP;
  FType:= SOCK_STREAM;
end;

destructor TTCPClient.Destroy;
begin
  Close;
  DeallocateHWnd(FHandle);
  inherited Destroy;
end;

procedure TTCPClient.OpenConnection(Socket: TSocket; Error: word);
var
  EventMask: longint;
begin
  if Error <> 0 then
    SocketError(Error)
  else
    begin
      EventMask:= FD_READ or FD_CLOSE;
      if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, EventMask) <> 0 then
        SocketError(WSAGetLastError)
      else
        begin
          if Assigned(FOnConnect) then
            FOnConnect(Self, Socket);
          FSocketState:= ssConnected;
        end;
    end;
end;

procedure TTCPClient.CloseConnection(Socket: TSocket; Error: word);
begin
  if Error = WSAENETDOWN then
    SocketError(Error)
  else
    begin
      if Assigned(FOnClose) then
        FOnClose(Self, Socket);
      Close;
    end;
end;

procedure TTCPClient.IncommingData(Socket: TSocket; Error: word);
begin
  if Error <> 0 then
    SocketError(Error)
  else
    if Assigned(FOnData) then
      FOnData(Self, Socket);
end;

procedure TTCPClient.WndProc(var AMsg: TMessage);
var
  Error: word;
begin
  with AMsg do
    case Msg of
      WM_ASYNCSELECT:
        begin
          if (FSocketState = ssClosed) then
            Exit;
          Error:= WSAGetSelectError(LParam);
          case WSAGetSelectEvent(LParam) of
            FD_READ   : IncommingData(WParam, Error);
            FD_CONNECT: OpenConnection(WParam, Error);
            FD_CLOSE  : CloseConnection(WParam, Error);
          else
            if Error <> 0 then
              SocketError(Error);
          end;
        end;
    else
      Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
    end;
end;

procedure TTCPClient.Open;
var
  SockAddrIn: TSockAddrIn;
  SockOpt: LongBool;
  EventMask: longint;
begin
  if (FSocketState <> ssClosed) then
    Exit;

  if not GetSockAddrIn(FHost, FPort, SockAddrIn) then
    Exit;

  FLocalSocket:= socket(PF_INET, FType, 0);
  if FLocalSocket = INVALID_SOCKET then
    begin
      SocketError(WSAGetLastError);
      Exit;
    end;

  EventMask:= (FD_CONNECT or FD_READ or FD_CLOSE);
  if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, EventMask) <> 0 then
    begin
      SocketError(WSAGetLastError);
      closesocket(FLocalSocket);
      Exit;
    end;

  SockOpt:= true; {Enable OOB Data inline}
  if setsockopt(FLocalSocket, SOL_SOCKET, SO_OOBINLINE, PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
    begin
      SocketError(WSAGetLastError);
      closesocket(FLocalSocket);
      Exit;
    end;

  if connect(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
    begin
      if WSAGetLastError <> WSAEWOULDBLOCK then
        begin
          SocketError(WSAGetLastError);
          closesocket(FLocalSocket);