fastertcp.pas

faster tcp companents delphi

    property    OnServerDenyStream: TNotifyEvent read FOnServerDenyStream write FOnServerDenyStream;
    property    OnServerDisconnectAll: TNotifyEvent read FOnServerDisconnectAll write FOnServerDisconnectAll;
    property    OnServerDisconnectYou: TNotifyEvent read FOnServerDisconnectYou write FOnServerDisconnectYou;
    property    OnServerKickYouOut: TNotifyEvent read FOnServerKickYouOut write FOnServerKickYouOut;
    property    OnServerNameInUse: TNotifyEvent read FOnServerNameInUse write FOnServerNameInUse;
    property    OnServerNeedMoreData: TNotifyEvent read FOnServerNeedMoreData write FOnServerNeedMoreData;
    property    OnServerNotLetIn: TNotifyEvent read FOnServerNotLetIn write FOnServerNotLetIn;
    property    OnServerPong: TNotifyEvent read FOnServerPong write FOnServerPong;
    property    OnServerReceivedStream: TNotifyEvent read FOnServerReceivedStream write FOnServerReceivedStream;
    property    OnServerStopReceivingStream: TNotifyEvent read FOnServerStopReceivingStream write FOnServerStopReceivingStream;
    property    OnServerStopSendingStream: TNotifyEvent read FOnServerStopSendingStream write FOnServerStopSendingStream;
    property    OnStreamReceived: TFasterTCPClientDataReceivedEvent read FOnStreamReceived write FOnStreamReceived;
    property    OnTimeOut: TNotifyEvent read FOnTimeOut write FOnTimeOut;
    property    OnUnknownPacketID: TFasterTCPClientUnknownIDEvent read FOnUnknownPacketID write FOnUnknownPacketID;
  end;

procedure Register;

implementation

uses SysUtils, Forms;

const
  PROTO_TCP = 'tcp';
{ -Those with =1 send data in their packets
  -ID:s are used on ProcessCommands.
  }
  ASK_MORE_DATA_ID =                    1;
  ASKING_TO_RECEIVE_DATA_ID =           2;                      // = 1
  BroadCast_STREAM_Packet_ID =          3;
  DATA_RECEIVE_DENIED_ID =              4;
  DATA_RECEIVE_OK_ID =                  5;                      // = 1
  DATA_RECEIVING_STOPPED_ID =           6;
  DATA_SENDING_STOPPED_ID =             7;
  MESSAGE_Packet_ID =                   8;
  PING_ID =                             9;
  PONG_ID =                             10; //See also the constant values defined in the beginning of the unit
  REGISTER_NAME_ROOM_ID =               11;                     // = 1
  SERVER_ASK_REGISTER_NAME_ROOM_ID =    12;
  SERVER_DISCONNECT_ALL_ID =            13;
  SERVER_DISCONNECT_YOU_ID =            14;
  SERVER_KICK_OUT_ID =                  15;
  SERVER_NAME_IN_USE_ID =               16;
  SERVER_NOT_LET_IN_ID =                17; //(client must still be in to get this and then disconnect)
  SERVER_REGISTER_OK_ID =               18;
  STREAM_Packet_ID =                    19;
  STREAM_RECEIVED_ID =                  20;
  HEADER_SIZE_OF_SIZE =                 4;
  HEADER_SIZE_OF_COMMAND =              4;
  HEADER_SIZE =                         8;
  Packet_SIZE =                         4096; //+ HEADER_SIZE, not used for anything in this version yet.
  //OF_CLASS_SERVER =                   1;
  //OF_CLASS_CLIENT =                   2;
  //OF_CLASS_SERVERCLIENT =             3;

{$IFNDEF D4}
type
  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: Char;
  end;

  SunW = packed record
    s_w1, s_w2: Word;
  end;

  in_addr = record
    case Integer of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: LongInt);
  end;
{$ENDIF}

{ Internal utilities }

Function ConvertToString(Stream: TMemoryStream): String;
begin
  SetLength(Result, Stream.Size);
  Stream.Read(Result[1], Stream.Size);
end;

Function CreatePacket(Size, Command: LongInt; Data: Pointer): TFasterPacket;
begin
  Result.Size := Size + HEADER_SIZE;//Header size is added here already!
  Result.Command := Command;
  Result.Data := Data;
end;

function IPToStr(IP: LongInt): String;
var
  Addr: TInAddr;
begin
  Addr.S_addr := IP;
  Result := inet_ntoa(Addr);
end;

function StrToIP(Host: PChar): LongInt;
begin
  Result := inet_addr(Host)
end;

function PacketStreamToPacket( PacketStream, OutputStream: TMemoryStream ): TFasterHeader;
begin
  If PacketStream.Position + HEADER_SIZE <= PacketStream.Size then begin
    PacketStream.Read(Result.Size, HEADER_SIZE_OF_SIZE);
    PacketStream.Read(Result.Command, HEADER_SIZE_OF_COMMAND);
    OutputStream.Clear;
    If (Result.Size > HEADER_SIZE) and
       ( PacketStream.Position + Result.Size-HEADER_SIZE <= PacketStream.Size ) then
      OutputStream.CopyFrom( PacketStream, Result.Size-HEADER_SIZE);  //Reading data that is after header
      OutputStream.Seek(0, soFromBeginning);
  end else begin
    Result.Size := 0;
    Result.Command := 0;
  end;
end;

{-------------------------------------------------------------------------------------------}


{ TCustomFasterSocket }     {1}
constructor TCustomFasterSocket.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  FSocket := INVALID_SOCKET;
  WindowHandle := AllocateHWnd(WndProc);

  {$IFDEF DEBUGMODEON}
    FDebugInfo:= TStringList.Create;
  {$ENDIF}
end;

destructor TCustomFasterSocket.Destroy;
begin
  DeallocateHWnd(WindowHandle);

  {$IFDEF DEBUGMODEON}
    FDebugInfo.Free;
  {$ENDIF}

  inherited Destroy;
end;

function TCustomFasterSocket.ReceiveFrom(Const Socket: TSocket; Buffer: PChar; BufLength: LongInt; ReceiveCompletely: Boolean): LongInt;
var
  p: Pointer;
  DataAvail: LongInt;
begin
  Result := recv(Socket, Buffer^, BufLength, 0);  
  if Result = 0 then
    DoClose(Socket)
  else
  If Result = SOCKET_ERROR then
   begin
    SocketError(Socket, WSAGetLastError);
    Exit;
   end;

  If ReceiveCompletely then
   while Result < BufLength do
    begin
     If IoctlSocket(Socket, FIONREAD, DataAvail) = SOCKET_ERROR then
      begin
       SocketError(Socket, WSAGetLastError);
       Exit;
      end;
     If DataAvail = 0 then Continue;
     {$IFDEF DEBUGMODEON}
       DebugInfo.Add('##Trying to receive ' + IntToStr(BufLength - Result) +
         ' bytes, ' + IntToStr(DataAvail) + ' are available.');
     {$ENDIF}

     p := Pointer(LongInt(Buffer) + Result);
     DataAvail := recv(Socket, p^, BufLength - Result, 0);
     If DataAvail = SOCKET_ERROR then
      begin
       SocketError(Socket, WSAGetLastError);
       Exit;
      end;
     inc(Result, DataAvail);
    end;

end;  {2}

function  TCustomFasterSocket.ReceiveStreamFrom(Const Socket: TSocket; Stream: TMemoryStream; DataSize: LongInt; ReceiveCompletely: Boolean): Boolean;
var
  Buf: Pointer;
  Received: LongInt;
begin
  GetMem(Buf, DataSize);
  Result := false;
    //Was changed after version 1.03, streams can NOT be received in two or more parts
    //unless broken up by TCP/IP protocol and assembled by ReceiveFrom.
    //No idea why it does not work, as there shouldn't be anything restricting it.

    //Added separate packetsplitter in 1.05 to allow recovering from receiving 2 packets as one piece
    //( possibly when Server is processing stream/packet while Client is already sending 2 more,
    // thus ReceiveStreamFrom receives them as one piece after processing of first is complete)
  try
      //Buf contains all data that was able to be received.
    Received := ReceiveFrom(Socket, Buf, DataSize, True);
    If Received >= HEADER_SIZE then begin
      Stream.Write( Buf^, Received );
      Result := true;
    end else
      Raise Exception.Create('Error: No header was found in packet!');
  finally
    FreeMem(Buf);
  end;
end;

function TCustomFasterSocket.SendBufferTo(Const Socket: TSocket; Buffer: Pointer; BufLength: LongInt): LongInt; // bytes sent
begin
  Result := 0;
  If (Socket <> INVALID_SOCKET) and (BufLength <> 0) then
   begin
    Result := WinSock.Send(Socket, Buffer^, BufLength, 0);
    If Result = SOCKET_ERROR then
      SocketError(Socket, WSAGetLastError);
   end;
end;

function TCustomFasterSocket.SendPacketTo(Socket: TSocket; Packet: TFasterPacket; AutoFreePointer: Boolean): LongInt;
Var TempBuf: Pointer;
    BufPointer: Pointer;
    SendDataSize: Integer;
begin
  GetMem(TempBuf,Packet.Size);
  BufPointer := TempBuf;
  SendDataSize := Packet.Size - HEADER_SIZE;
  Try
    System.Move( Packet.Size, BufPointer^, HEADER_SIZE_OF_SIZE );
    BufPointer := Pointer( Integer( BufPointer) + HEADER_SIZE_OF_SIZE );   
    System.Move( Packet.Command, BufPointer^, HEADER_SIZE_OF_COMMAND );
    BufPointer := Pointer( Integer( BufPointer) + HEADER_SIZE_OF_COMMAND );
    If SendDataSize > 0 then
      System.Move( Packet.Data^, BufPointer^, SendDataSize );
    If AutoFreePointer and (Packet.Data <> nil) then begin
      FreeMem(Packet.Data);
      Packet.Data := nil;
    end;
    Result := SendBufferTo(Socket,TempBuf,Packet.Size);
  Finally
    FreeMem(TempBuf);
  end;
end;

function  TCustomFasterSocket.SendStreamTo(Const Socket: TSocket; Client: TFasterTCPServerClient; Stream: TStream; Size: LongInt): LongInt; // returns N of bytes sent
var
  Buffer: Pointer;
  BufStream: TMemoryStream;
  TempHeaderData: LongInt;
begin
  Result := 0;
  If Socket <> INVALID_SOCKET then
   begin

    If Stream = nil then Exit;
      { allocate memory for swap buffer }
    Try
    {$WARNINGS OFF}
      If Stream.Size - Stream.Position < Size then
        Size := Stream.Size - Stream.Position;
    {$WARNINGS ON}
    Except Raise Exception.Create('Error, invalid stream while trying to send!'); end;
    If Size < 0 then
      Raise Exception.Create('Error while sending stream! Stream position is in the end of the stream!');
    GetMem(Buffer, Size + HEADER_SIZE);
    BufStream := TMemoryStream.Create;
    Try
      { filling the buffer from stream }
      TempHeaderData := Size + HEADER_SIZE;
      BufStream.Write(TempHeaderData,HEADER_SIZE_OF_SIZE);
      TempHeaderData := STREAM_Packet_ID;
      BufStream.Write(TempHeaderData,HEADER_SIZE_OF_COMMAND);
      BufStream.CopyFrom(Stream,Size);
      BufStream.Seek(0,soFromBeginning);
      BufStream.Read(Buffer^, BufStream.Size);

      { SENDING! }
      Result := WinSock.Send(Socket, Buffer^, BufStream.Size, 0);
      If Result = SOCKET_ERROR then { process the error If occurs }
        SocketError(Socket, WSAGetLastError) else

        Dec(Result,HEADER_SIZE); //Calculate the data that was sent (remove header size)

    finally
      { release memory taken for buffer }
      FreeMem(Buffer);
      BufStream.Free;
    end;
  end;
end;

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